TITLE	S$$UTL SYSTEM UTILITY ROUTINES
	SUBTTL	S$$EFI 'ENTRY.FUNCTION' INITIALIZATION ROUTINE

	ENTRY	S$$EFI
	EXTERN	S$$MFB,S$$KWD,S$$PBP,S$$FLP,S$$IPR,S$$CPF,S$$FLR
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
	XWD	STNO,PARBLK	; WHERE STNO IS THE STATEMENT # OF THE
CALL:	JSP	R11,S$$EFI	; 'ENTRY.FUNCTION' DECLARATION, PARBLK
	PROT DESCR	; IS THE PARAMETER BLOCK, AND PROT DESCR AND
	LABL DESCR	; LABL DESCR THE PROTOTYPE AND LABEL DESCRIP-
TORS. THE PROGRAM IS INITIALIZED IF NECESSARY, THE FUNCTION DEFINED AND
CALLING SEQUENCE MODIFIED TO APPEAR LIKE A NORMAL FUNCTION DEFINITION,
AND THE FUNCTION IS CALLED USING THE NEW DEFINITION/

S$$EFI:	PUSH	ES,1(R11)	; SAVE LABEL DESCR ON ES
	PUSH	ES,(R11)	; SAVE PROTOTYPE DESCR ON ES
	PUSH	SS,R3	; SAVE # OF ARGS
	PUSH	SS,S$$PBP	; SAVE PARBLK+1
	PUSH	SS,S$$KWD+2	; SAVE &STNO
	PUSH	SS,S$$FLP	; SAVE FAILPOINT
	PUSH	SS,R11	; SAVE LINK
	MOVE	R10,-2(R11)	; GET NEW &STNO,PARBLK
	HLRZM	R10,S$$KWD+2	; SET &STNO
	MOVEI	R9,1(R10)	; GET PARBLK+1
	MOVEM	R9,S$$PBP	; SET
	HRLI	R9,1B18+4	; FORM NEW WORD FOR CALLING SEQUENCE
	MOVEM	R9,-2(R11)	; AND STORE IT THERE
	SKIPL	(R10)	; HAS PROGRAM BEEN INITIALIZED?
	JSP	R11,S$$IPR	; NO, INITIALIZE IT
	HRROI	R10,EFIFAL	; SET UP DUMMY FAILPOINT
	MOVEM	R10,S$$FLP
	SETZ	R0,	; MAKE FUNCTION BLOCK, LOCAL VARS POSSIBLE,
	JSP	R11,S$$MFB	; BUT NO FUNCTION WORD
	POP	SS,R11	; RESTORE LINK
	MOVEM	R10,1(R11)	; SAVE FUNCTION DEFINITION
	MOVEM	R9,(R11)	; PARAMETERS IN CALLING SEQUENCE
	MOVEI	R10,S$$CPF	; GET 'CALL PROGRAMMER-DEFINED FUN'
	POP	SS,S$$FLP	; RESTORE FAILPOINT
	POP	SS,S$$KWD+2	; AND &STNO
	POP	SS,S$$PBP	; AND PARBLK+1
	POP	SS,R3	; AND # OF ARGS
	HRRM	R10,-1(R11)	; CHANGE CALLING SEQUENCE
	JRST	(R10)	; AND GO THERE
; FAILURE DURING FUNCTION DEFINITION
EFIFAL:	SUB	SS,[XWD 1,1]	; POP SS
	POP	SS,S$$FLP	; RESTORE FAILPOINT
	POP	SS,S$$KWD+2	; RESTORE &STNO
	POP	SS,S$$PBP	; RESTORE PARBLK+1
	JRST	S$$FLR	; AND FAIL
	PRGEND
	SUBTTL	S$$MFB MAKE FUNCTION BLOCK ROUTINE

	ENTRY	S$$MFB
	EXTERN	S$$GFP,S$$PGL,S$$LKV,S$$LKL,S$$LKF,S$$GNS,S$$SRT,S$$NRT
	EXTERN	S$$FRT,S$$MKS
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R11,S$$MFB	; WITH LABEL, THEN FUNCTION PROTOTYPE
PUSHED ONTO ES, AND FLAG IN R0 INDICATING FUNCTION TYPE (-1='ENTRY.FOR-
TRAN.FUNCTION',0='ENTRY.FUNCTION',1='DEFINE' FUNCTION). RETURNS XWD
-(NARG+NLV+1),ARGBLK IN R10, XWD STARTL,NLV+1 IN R9, AND, IF REQUIRED,
A FUNCTION WORD POINTER IN R8/

S$$MFB:	MOVEM	R0,FTPFLG	; SAVE FLAG
	JUMPLE	R0,.+2	; IS IT 'DEFINE'?
	SETZ	R0,	; YES, WANT LOCAL VARS ALSO
	HRRM	R11,MFBRET	; SAVE LINK
	MOVE	R1,(ES)	; GET PROTOTYPE
	TLNN	R1,^O770000	; IS IT STRING?
	JSP	R11,S$$GFP	; YES, GET FUNCTION PARAMETERS
	CFERR	6,S$$PGL	; NO, BAD PROTOTYPE
	MOVEM	R9,SAVNLV	; SAVE # OF LOCAL VARS
	MOVEI	R0,1(R10)	; GET NARG+NLV+2
	JSP	R6,S$$GNS	; GET ARGUMENT BLOCK
	MOVNI	R2,(R10)	; GET -(NARG+NLV+1)
	HRLI	R1,(R2)	; INTO LH OF R1
	MOVEM	R1,SAVABP	; SAVE XWD -(NARG+NLV+1),ARGBLK
	HRLZI	R11,-1(R10)	; NARG+NLV,0
	ADDI	R10,(R1)	; ARGBLK+NARG+NLV+1
	HRRM	R10,(R1)	; SAVE IN ARGBLK
	HRRI	R11,(R10)	; AND AS POINTER TO LAST ARG BLOCK ENTRY
VARLOP:	POP	ES,R1	; GET NEXT PREVIOUS SYMBOL
	JSP	R10,S$$LKV	; DO VARIABLE LOOKUP
	HRLZI	R3,3B23	; DEDICATED TYPE MASK
	AND	R3,(R2)	; GET DEDICATED TYPE
	LSH	R3,-12	; FORM XWD NAMPTR,DEDTYP
	LSHC	R2,-18
	MOVEM	R3,(R11)	; SAVE IN ARG BLOCK
	SUB	R11,[XWD 1,1]	; DECREMENT POINTER
	JUMPGE	R11,VARLOP	; LOOP IF ANY SYMBOLS LEFT
	ADD	ES,[XWD 1,1]	; PRESERVE FUNCTION SYMBOL
	MOVE	R1,(ES)	; GET IT
	SKIPLE	FTPFLG	; IS FUNCTION WORD WANTED?
	JSP	R10,S$$LKF	; YES, DO FUNCTION LOOKUP
	HRRM	R2,RSTFPT	; SAVE PTR TO FUNCTION WORD
	MOVE	R1,-2(ES)	; GET LABEL DESCR
	SETO	R0,	; MUST BE STRING
	JSP	R7,S$$MKS
	CFERR	6,S$$PGL
	SETZ	R0,	; GET CHAR COUNT OF LABEL
	HRRZ	R0,(R1)
	JUMPN	R0,.+2	; SKIP IF NON-NULL, OR
	MOVE	R1,(ES)	; USE FUNCTION SYMBOL
	JSP	R10,S$$LKL	; DO LABEL LOOKUP
	MOVE	R10,SAVABP	; GET XWD -(NARG+NLV+1),ARGBLK
	AOS	R9,SAVNLV	; GET XWD STARTL,NLV+1
	HRLI	R9,(R2)
	SUB	ES,[XWD 3,3]	; POP FUNC SYM, PROTOTYPE, LABEL OFF ES
RSTFPT:	MOVEI	R8,.-.	; GET FUNCTION WORD POINTER
MFBRET:	JRST	.-.	; RETURN
; STORAGE
FTPFLG:	S$$SRT	; TO FORCE LOADING OF NON-DUMMY 'RETURN', 'FRETURN',
SAVNLV:	S$$FRT	; AND 'NRETURN' IN CASE ONLY INDIRECT REFERENCES TO
SAVABP:	S$$NRT	; THEM ARE MADE
	PRGEND
	SUBTTL	S$$CPF CALL PROGRAMMER-DEFINED FUNCTION ROUTINE

	ENTRY	S$$CPF
	EXTERN	S$$PGL,S$$STP,S$$STB,S$$TMS,S$$KWD,S$$PBP,S$$FLP,S$$CPS
	EXTERN	S$$MKS,S$$MKI,S$$MKR,S$$TAC,S$$FLR
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
	XWD	,PARBLK+1	; WHERE PARBLK IS THE PARAMETER BLOCK
CALL:	JSP	R11,S$$CPF	; NLV IS THE # OF LOCAL VARIABLES, STARTL
	XWD	STARTL,NLV+1	; IS THE LOCATION OF THE STARTING LABEL
	XWD	-(NARG+NLV+1),ARGBLK	; WORD, NARG IS THE # OF FORMAL
ARGUMENTS, AND ARGBLK IS THE ARGUMENT BLOCK POINTER. EXPECTS RETURN
LINK IN S$$PGL, CALL MODE LINK IN R12, AND # OF ARGS IN R3, WITH ARGS
PUSHED ONTO ES/

S$$CPF:	HRL	R12,S$$PGL	; GET PROGRAM LINK
	PUSH	SS,R12	; SAVE , WITH R12, ON SS
	MOVN	R12,S$$STB	; SAVE CURRENT ES - BASE
	ADD	R12,ES	; IN CASE STACK OVERFLOWS AND CHANGES BASE
	MOVE	R10,(R11)	; GET STARTL,NLV+1
	HLRM	R10,STLABL	; SAVE PTR IN XCT INSTR
	MOVEI	R10,(R10)	; GET NLV+1
	SETZ	R0,	; NULL VALUES
	PUSH	ES,R0	; PUSH EXTRA VALUES ONTO ES
	SOJG	R10,.-1	; LOOP
	ADD	R12,S$$STB	; ADD BASE AND POINT TO FIRST
	MOVEI	R12,1(R12)	; VALUE ON ES BY SUTRACTING
	SUBI	R12,(R3)	; # OF ARGUMENTS
	MOVE	R8,-2(R11)	; SAVE NEW PARBLK+1
	MOVE	R11,1(R11)	; GET -(NARG+NLV+1),ARGBLK
	PUSH	SS,S$$FLP	; SAVE FAILPOINT
	PUSH	SS,S$$TMS	; SAVE STATEMENT START TIME ON SS
	MOVE	R1,S$$PBP	; GET OLD PARBLK+1
	HRL	R1,S$$KWD+2	; GET OLD &STNO
	PUSH	SS,R1	; SAVE THEM ON SS
	PUSH	SS,S$$STP-1	; SAVE SS PREVIOUS
	PUSH	SS,S$$STP	; SAVE ES PREVIOUS
	MOVEI	R1,CPFRET	; GET FUNCTION CALL RETURN LOC
	HRLI	R1,(R11)	; AND ARG BLOCK POINTER
	PUSH	SS,R1	; SAVE ON SS
	SETZ	R1,	; NULL VALUE FOR FUNCTION VAR
SAVLOP:	MOVE	R10,1(R11)	; GET NAMLOC,VARTYP OF NEXT VAR
	JRA	R10,.+1(R10)	; GET NAME DESCR, GO TO:
	JRST	SAVUND	; UNDEDICATED VAR
	JRST	SAVSTR	; DEDICATED STRING
	JRST	SAVINT	; DEDICATED INTEGER
	JRST	SAVREL	; OR DEDICATED REAL
SAVUND:	SETM	R2,(R10)	; GET OLD VALUE, WITHOUT INPUT
	MOVEM	R1,(R10)	; REPLACE WITH NEW VALUE, POSSIBLE OUTPUT
	MOVE	R1,R2
SAVCOM:	EXCH	R1,(R12)	; SAVE OLD VALUE ON ES AND GET NEXT VALUE
	AOBJP	R11,SAVFIN	; JUMP OUT IF NO MORE VARS
	AOJA	R12,SAVLOP	; OR BUMP ES POINTER AND LOOP
SAVSTR:	MOVE	R9,R1	; SAVE NEW VALUE
	MOVE	R1,(R10)	; GET OLD VALUE
	JSP	R7,S$$CPS	; MAKE A COPY
	EXCH	R1,R9	; EXCHANGE WITH NEW VALUE
	MOVE	R2,(R10)	; SET UP FOR STORING NEW VALUE
	HLRZ	R0,(R2)	; IN DEDICATED STRING, COMPUTE MAX CHARS AVAILA-
	SUBI	R0,1	; BLE
	IMULI	R0,5
	JSP	R7,S$$MKS	; STORE NEW VALUE
	CFERR	1,S$$PGL
	HRRM	R3,@(R10)	; SAVE CHAR COUNT
	MOVE	R1,R9	; GET COPY OF OLD VALUE
	JRST	SAVCOM	; GO SAVE ON ES
SAVINT:	JSP	R7,S$$MKI	; MAKE INTEGER FROM NEW VALUE
	CFERR	1,S$$PGL
	EXCH	R1,(R10)	; EXCHANGE WITH OLD VALUE
	TLO	R1,1B18	; MAKE DESCRIPTOR FROM OLD VALUE
	TLZ	R1,1B19
	JRST	SAVCOM	; GO SAVE ON ES
SAVREL:	JSP	R7,S$$MKR	; DITTO FOR REALS
	CFERR	1,S$$PGL
	EXCH	R1,(R10)
	LSH	R1,-2
	TLO	R1,3B19
	JRST	SAVCOM
SAVFIN:	MOVN	R1,S$$STB	; COMPUTE NEW ES PREVIOUS
	ADD	R1,ES	; FROM CURRENT ES
	MOVEM	R1,S$$STP	; SAVE
	MOVN	R1,S$$STB-1	; DITTO FOR SS
	ADD	R1,SS
	MOVEM	R1,S$$STP-1
	AOS	S$$KWD+3	; INCREMENT &FNCLEVEL
	HRRZM	R8,S$$PBP	; SAVE NEW PARBLK+1
	SETZM	S$$KWD+2	; ZERO &STNO
STLABL:	XCT	.-.	; EXECUTE LABEL WORD (JUMP TO STARTING LABEL)
; RETURN, FRETURN, AND NRETURN OF A PROGRAMMER-DEFINED FUNCTION
; EXPECTS 0, -1, OR 1 IN RH(R12) , RESPECTIVELY
CPFRET:	HLRZ	R11,1(SS)	; GET ARGBLK POINTER
	POP	SS,S$$STP	; RESTORE ES PREVIOUS
	POP	SS,S$$STP-1	; RESTORE SS PREVIOUS
	POP	SS,R1
	HLRZM	R1,S$$KWD+2	; RESTORE OLD &STNO
	HRRZM	R1,S$$PBP	; RESTORE OLD PARBLK+1
	POP	SS,S$$TMS	; RESTORE START TIME FOR OLD STNO
	POP	SS,S$$FLP	; RESTORE FAILPOINT POINTER
	POP	SS,R1	; GET OLD LINK,R12
	MOVEI	R12,(R12)	; CLEAR LH OF RETURN INDEX
	ADDI	R12,(R1)	; ADD OLD R12
	HLRZM	R1,S$$PGL	; RESTORE OLD PROGRAM LINK
	MOVE	R10,1(R11)	; GET NAMPTR,TYPE FOR FUNCTION VARIABLE
	JRA	R10,.+1(R10)	; GET NAME DESCR, AND SAVE VALUE FOR:
	JRST	FVLUND	; UNDEDICATED VARIABLE
	JRST	FVLSTR	; DEDICATED STRING
	JRST	FVLINT	; DEDICATED INTEGER
	JRST	FVLREL	; OR DEDICATED REAL
FVLSTR:	MOVE	R1,(R10)	; GET DESCRIPTOR
	JSP	R7,S$$CPS	; MAKE A COPY
	JRST	FVLCOM	; GO SAVE
FVLINT:	MOVE	R1,(R10)	; GET INTEGER
	TLO	R1,1B18	; MAKE DESCRIPTOR
	TLZ	R1,1B19
	JRST	FVLCOM	; GO SAVE
FVLREL:	MOVE	R1,(R10)	; DITTO FOR REAL
	LSH	R1,-2
	TLO	R1,3B19
	JRST	FVLCOM
FVLUND:	SETM	R1,(R10)	; GET DESCR (WITHOUT INPUT)
FVLCOM:	MOVEM	R1,S$$TAC	; SAVE IN TEMP AC
	HRRZ	R9,(R11)	; COMPUTE NARG+NLV+1
	SUBI	R9,(R11)
	MOVE	R11,(R11)	; POINTER TO BOTTOM OF ARGBLOCK
RSTLOP:	MOVE	R10,(R11)	; GET NEXT NAMPTR,TYPE
	POP	ES,R1	; POP CORRESPONDING SAVED VALUE OFF ES
	JRA	R10,.+1(R10)	; GET NAME DESCR AND RESTORE:
	JRST	RSTUND	; UNDEDICATED VARIABLE
	JRST	RSTSTR	; DEDICATED STRING
	JRST	RSTINT	; DEDICATED INTEGER
	JRST	RSTREL	; OR DEDICATED REAL
RSTSTR:	MOVE	R2,(R10)	; MOVE OLD STRING COPY INTO DEDICATED
	HRRZ	R0,(R1)	; STRING LOC
	JSP	R7,S$$MKS
	JFCL
	HRRM	R3,@(R10)	; SAVE CHAR COUNT
	JRST	RSTCOM	; GO LOOP
RSTINT:	LSH	R1,2	; GET INTEGER FROM DESCR
	ASH	R1,-2
	MOVEM	R1,(R10)	; SAVE IN DED LOC
	JRST	RSTCOM	; GO LOOP
RSTREL:	LSH	R1,2	; DITTO FOR REAL
	MOVEM	R1,(R10)
	JRST	RSTCOM
RSTUND:	SETAM	R1,(R10)	; SAVE DESCR IN LOC (BUT NO OUTPUT)
RSTCOM:	SOJLE	R9,RSTFIN	; JUMP OUT IF NO MORE VARS
	SOJA	R11,RSTLOP	; OR DECREMENT ARGBLK POINTER AND LOOP
RSTFIN:	SETZ	R1,
	EXCH	R1,S$$TAC	; GET FUNCTION VALUE
	TLNN	R12,-1	; SKIP IF INDEX WAS -1 (FRETURN)
	JRST	(R12)	; 'RETURN' OR 'NRETURN'
	JRST	S$$FLR	; 'FRETURN', FAIL
	PRGEND
	SUBTTL	S$$GFP GET FUNCTION PARAMETERS ROUTINE

	ENTRY	S$$GFP
	EXTERN	S$$BKT,S$$GRS
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R11,S$$GFP	; WITH PROTOTYPE ON ES, AND LOCAL VAR-
RIABLE FLAG (-1=NONE, 0=POSSIBLY) IN R0. RETURNS TO 0(R11) IF PROTOTYPE
IS BAD, OR TO 1(R11) WITH SYMBOLS PUSHED ONTO ES, SYMBOL COUNT IN R10,
AND, IF REQUIRED, LOCAL VARIABLE COUNT IN R9/

S$$GFP:	JRST	INIBKT	; INITIALIZE BREAK TABLES, THEN MODIFY THIS LOC
	SETZM	PROTCT	; INITIALIZE SYMBOL COUNT
	MOVE	R10,(ES)	; INITIALIZE CURSOR
	SETZ	R0,	; GET TOTAL CHAR COUNT
	HRRZ	R9,(R10)
	JSP	R8,GETSYM	; GET FIRST SYMBOL
	JRST	(R11)	; ERROR IF NO MORE CHARS
	CAIE	R7,"("	; IS NEXT CHAR OPEN PAREN?
	JRST	(R11)	; NO, ERROR
	JSP	R8,SPNBLN	; SPAN BLANKS
	JRST	(R11)	; ERROR IF NO MORE CHARS
	CAIN	R7,")"	; IS NEXT CHAR CLOSE PAREN?
	JRST	CLSPRN	; YES
VARLOP:	JSP	R8,GETSYM	; GET NEXT SYMBOL
	JRST	(R11)	; ERROR IF NO MORE CHARS
	MOVE	R8,PROTCT	; GET # OF SYMBOLS
	CAILE	R8,16	; < OR = 15 ARGS + FUNCTION?
	JRST	(R11)	; NO, BAD PROTOTYPE
	CAIE	R7," "	; IS NEXT CHAR BLANK OR TAB?
	CAIN	R7,^O11
	JSP	R8,SPNBLN	; YES, SPAN BLANKS
	JUMPL	R9,(R11)	; NO, OR IF OUT OF CHARS, ERROR
	CAIE	R7,","	; IS NEXT CHAR A COMMA?
	JRST	CLSCHK	; NO, CHECK FOR CLOSE PAREN
	JSP	R8,SPNBLN	; YES, SPAN BLANKS
	JRST	(R11)	; ERROR IF NO MORE CHARS
	JRST	VARLOP	; LOOP
CLSCHK:	CAIE	R7,")"	; IS NEXT CHAR CLOSE PAREN?
	JRST	(R11)	; NO, ERROR
CLSPRN:	JSP	R8,SPNBLN	; SPAN BLANKS AFTER ")"
	JRST	GFPEND	; FINISH UP IF NO MORE CHARS
	SKIPE	PROTFL	; WERE LOCAL VARS EXPECTED?
	JRST	(R11)	; NO, ERROR
LVRLOP:	AOS	PROTFL	; ADD 1 TO LOCAL VAR COUNT
	JSP	R8,GETSYM	; GET NEXT SYMBOL
	JRST	GFPEND	; FINISH UP IF NO MORE CHARS
	CAIE	R7," "	; IS NEXT CHAR BLANK OR TAB?
	CAIN	R7,^O11
	JSP	R8,SPNBLN	; YES, SPAN BLANKS
	JUMPL	R9,GFPEND	; NO, OR IF OUT OF CHARS, FINISH UP
	CAIE	R7,","	; IS NEXT CHAR A COMMA?
	JRST	(R11)	; NO, ERROR
	JSP	R8,SPNBLN	; YES, SPAN BLANKS
	JRST	(R11)	; ERROR IF NO MORE CHARS
	JRST	LVRLOP	; LOOP
GFPEND:	MOVE	R9,PROTFL	; GET LOCAL VAR COUNT
	MOVE	R10,PROTCT	; GET SYMBOL COUNT
	JRST	1(R11)	; RETURN
; INITIALIZE BREAK TABLES
INIBKT:	MOVE	R1,.+2	; GET 'MOVEM R0,PROTFL'
PROTFL:	MOVEM	R1,S$$GFP	; PLUG CALLING SEQUENCE
PROTCT:	MOVEM	R0,PROTFL	; SAVE R0
FRSTBL:	MOVEI	R0,1	; BIT MARK
	MOVEI	R1,R3	; PTR TO DUMMY FRSTBL IN R3-R6
	MOVE	R2,[XWD -26,"A"]	; UPPER CASE LETTERS
	SETZB	R3,R4	; CLEAR TABLE
RESTBL:	SETZB	R5,R6
	DPB	R0,S$$BKT(R2)	; MARK UPPER CASE BITS
	AOBJN	R2,.-1
	MOVE	R2,[XWD -26,^O141]	; LOWER CASE LETTERS
	DPB	R0,S$$BKT(R2)	; MARK LOWER CASE BITS
	AOBJN	R2,.-1
	MOVEI	R1,R7	; COPY INTO DUMMY RESTBL
	MOVE	R10,[XWD R3,R7]	; IN R7-R10
	BLT	R10,R10
	MOVE	R2,[XWD -10,"0"]	; DIGITS
	DPB	R0,S$$BKT(R2)	; MARK DIGIT BITS
	AOBJN	R2,.-1
	DPB	R0,S$$BKT+"."	; MARK DOT
	DPB	R0,S$$BKT+"-"	; MARK DASH
	MOVE	R0,[XWD R3,FRSTBL]	; MOVE TABLES INTO CORE
	BLT	R0,RESTBL+3
	JRST	S$$GFP+1	; CONTINUE
; SPAN BLANKS ROUTINE: JSP R8,SPNBLN ; AUTOMATICALLY SKIPS THE FIRST
; CHARACTER, AND THEN SKIPS OVER SUCCEEDING BLANKS AND TABS. RETURNS
; TO 0(R8) IF IT RUNS OUT OF CHARACTERS, OR TO 1(R8) WITH THE NEXT CHAR
; IN R7, AND THE CURSOR BACKED UP TO JUST IN FRONT OF IT
SPNBLN:	IBP	R10	; MOVE CURSOR 1 CHAR
	SUBI	R9,1	; FORWARD AUTOMATICALLY
SPNLOP:	MOVE	R6,R10	; SAVE CURSOR IN CASE OF BACKUP
	SOJL	R9,(R8)	; DECREMENT CHAR COUNT, LEAVE IF <0
	ILDB	R7,R10	; GET NEXT CHAR
	CAIE	R7," "	; IS IT BALNK OR TAB?
	CAIN	R7,^O11
	JRST	SPNLOP	; YES, LOOP
	MOVE	R10,R6	; NO, BACKUP CURSOR
	AOJA	R9,1(R8)	; AND RETURN
; GET SYMBOL ROUTINE: JSP R8,GETSYM ; PARSES SYMBOL, CREATES NEW STRING
; , PUSHES IT ONTO ES AND INCREMENTS PROTCT, AND RETURNS TO 0(R8) IF
; NO MORE CHARS, OR TO 1(R8) WITH NEXT CHAR IN R7, WITH CURSOR BACKED
; UP TO JUST IN FRONT OF IT. FAILS TO (R11) IF CAN'T FIND SYMBOL
GETSYM:	MOVEI	R0,1	; AT LEAST 1 CHAR
	MOVEI	R1,FRSTBL	; GET BREAK TABLE FOR LETTERS
	SOJL	R9,(R11)	; FAIL IF NO MORE CHARS
	ILDB	R7,R10	; GET CHAR
	LDB	R2,S$$BKT(R7)	; GET BREAK BIT
	JUMPE	R2,(R11)	; FAIL IF NOT LETTER
	PUSH	SS,R7	; PUSH CHAR ONTO SS
	MOVEI	R1,RESTBL	; GET BREAK TABLE FOR LETTERS, DIGITS,.,-
SYMLOP:	MOVE	R6,R10	; SAVE CURSOR IN CASE OF BACKUP
	SOJL	R9,SYMEND+2	; DECREMENT CHAR COUNT, QUIT IF <0
	ILDB	R7,R10	; GET CHAR
	LDB	R2,S$$BKT(R7)	; GET BREAK BIT
	JUMPE	R2,SYMEND	; QUIT IF NOT ON
	PUSH	SS,R7	; PUSH CHAR ONTO SS
	AOJA	R0,SYMLOP	; INCREMENT SYMBOL CHAR COUNT AND LOOP
SYMEND:	ADDI	R8,1	; RETURN TO 1(R8)
	MOVE	R10,R6	; BACKUP CURSOR
	ADDI	R9,1
	HRRM	R0,SAVCNT	; SAVE SYMBOL CHAR COUNT
	MUL	R0,[^F0.2B0]	; COMPUTE # WORDS NEEDED
	ADDI	R0,2
	JSP	R6,S$$GRS	; GET BLOCK FOR SYMBOL
	HRLI	R1,^O700	; FORM STRING DESCR
	PUSH	ES,R1	; SAVE ON ES
	AOS	PROTCT	; INCREMENT SYMBOL COUNT
SAVCNT:	MOVEI	R2,.-.	; GET SYMBOL CHAR COUNT
	HRRM	R2,(R1)	; SAVE IN STRING BLOCK
	HRLI	R2,(R2)	; FORM XWD NCHAR,NCHAR
	SUB	SS,R2	; RESTORE SS TO INITIAL VALUE
	MOVN	R2,R2	; FORM XWD -NCHAR,FIRST CHAR PTR
	HRRI	R2,(SS)
	AOBJN	R2,.+1
SYMCHR:	MOVE	R0,(R2)	; GET NEXT CHAR OFF SS
	IDPB	R0,R1	; PUT IN STRING
	AOBJN	R2,SYMCHR	; LOOP FOR EACH CHAR
	JRST	(R8)	; RETURN
	PRGEND
	SUBTTL	S$$NGS,S$$NGF STRING NEGATION ROUTINES

	ENTRY	S$$NGS,S$$NGF
	EXTERN	S$$STB,S$$STP,S$$FLR,S$$FLP
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R12,S$$NGS	; START NEGATION, FAILPT IS LOC TO GO TO
	FAILPT	; IF NEGATION ARG FAILS (AND NEGATION THUS SUCCEEDS)

CALL:	JRST	S$$NGF	; NEGATION FAILS (BECAUSE ARG SUCCEEDED)/

S$$NGS:	PUSH	SS,S$$FLP	; SAVE OLD FAILPOINT
	PUSH	SS,S$$STP-1	; SAVE SS PREVIOUS
	MOVN	R1,S$$STB	; COMPUTE NEW ES PREVIOUS
	ADD	R1,ES
	EXCH	R1,S$$STP	; EXCHANGE WITH OLD ES PREVIOUS
	PUSH	SS,R1	; SAVE OLD ES PREVIOUS
	PUSH	SS,(R12)	; SAVE FAILPOINT
	MOVN	R1,S$$STB-1	; COMPUTE NEW SS PREVIOUS
	ADD	R1,SS
	MOVEM	R1,S$$STP-1	; AND SAVE
	HRROI	R1,NEGFAL	; COMPUTE NEW FAILPOINT
	MOVEM	R1,S$$FLP	; SAVE
	JRST	1(R12)	; CONTINUE WITH ARGUMENT

NEGFAL:	MOVE	SS,S$$STB-1	; RESTORE SS
	ADD	SS,S$$STP-1
	POP	SS,R12	; GET FAILPOINT
	POP	SS,ES	; GET OLD ES PREVIOUS
	EXCH	ES,S$$STP	; EXCHANGE WITH CURRENT ES PREVIOUS
	ADD	ES,S$$STB	; UPDATE ES
	POP	SS,S$$STP-1	; RESTORE OLD SS PREVIOUS
	POP	SS,S$$FLP	; GET OLD FAILPOINT
	SETZ	R1,	; RESULT IS NULL
	JRST	(R12)	; SUCCEED TO FAILPOINT

S$$NGF:	SUB	SS,[XWD 1,1]	; THROW AWAY FAILPOINT
	POP	SS,S$$STP	; RESTORE ES PREVIOUS
	POP	SS,S$$STP-1	; RESTORE SS PREVIOUS
	POP	SS,S$$FLP	; RESTORE OLD FAILPOINT
	JRST	S$$FLR	; FAIL
	PRGEND
	SUBTTL	S$$ADD,S$$SUB,S$$MUL,S$$DIV DESCRIPTOR ARITHMETIC ROUTINES

	ENTRY	S$$ADD,S$$SUB,S$$MUL,S$$DIV
	EXTERN	S$$PGL,S$$STN,S$$ITR
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R12,S$$XXX	; WITH SECOND (RIGHT) ARG IN R1 AND
FIRST (LEFT) ARG ON ES, RETURNS RESULT IN R1 WITH ES POPED/

S$$ADD:	JSP	R11,ARITH	; ADD, INDEX=0
S$$SUB:	JSP	R11,ARITH	; SUBTRACT, INDEX=1
S$$MUL:	JSP	R11,ARITH	; MULTIPLY, INDEX=2
S$$DIV:	JSP	R11,ARITH	; DIVIDE, INDEX=3
ARITH:	SUBI	R11,S$$ADD+1
	MOVEM	R12,S$$PGL	; SAVE LINK
	SETZ	R2,	; GET DESCR TYPE
	ROTC	R1,2
	JRST	.+1(R2)	; CONVERT TO VALUE
	JSP	R7,S$$STN-1	; STRING, CONVERT TO INTEGER OR REAL
	CFERR	1,S$$PGL	; OTHER, OR FAILED STRING CONVERSION
	ASH	R1,-2	; INTEGER, RESTORE VALUE
	MOVEI	R10,(R2)	; REAL, OR SUCEEDED STRING CONV, SAVE TYPE
	MOVE	R9,R1	; SAVE VALUE
	POP	ES,R1	; GET LEFT HAND SIDE
	SETZ	R2,	; SIMILAR CONVERSION
	ROTC	R1,2
	JRST	.+1(R2)
	JSP	R7,S$$STN-1
	CFERR	1,S$$PGL
	ASH	R1,-2
	CAIE	R2,(R10)	; TYPES THE SAME?
	JRST	MIXMOD	; NO, MIXED MODE
	XCT	OPERAT(R11)	; YES, PERFORM OPERATION
MAKDSC:	JRST	.-1(R2)	; FORM DESCRIPTOR
	LSH	R1,2	; FOR INTEGER
	ROTC	R1,-2	; AND REAL
	JRST	(R12)	; RETURN
; OPERATION TABLE
OPERAT:	XCT	ADDOP-2(R2)
	XCT	SUBOP-2(R2)
	XCT	MULOP-2(R2)
	XCT	DIVOP-2(R2)

; MODE TABLES
ADDOP:	ADD	R1,R9
	FAD	R1,R9
SUBOP:	SUB	R1,R9
	FSB	R1,R9
MULOP:	IMUL	R1,R9
	FMP	R1,R9
DIVOP:	JSP	R4,[MOVEI	R3,(R2)
		    IDIV	R1,R9
		    MOVEI	R2,(R3)
		    JRST	(R4)]
	FDV	R1,R9

MIXMOD:	CAIE	R10,3	; IS RIGHT HAND SIDE REAL?
	EXCH	R1,R9	; NO, IS INTEGER, EXCHANGE WITH LHS
	JSP	R3,S$$ITR	; CONVERT ARG THAT IS INTEGER TO REAL
	CAIE	R10,3	; WERE SIDES EXCHANGED?
	EXCH	R1,R9	; YES, RE-EXCHANGE
	MOVEI	R2,3	; NOW BITH SIDES ARE REAL
	XCT	OPERAT(R11)	; PERFORM OPERATION
	ROTC	R1,-2	; FORM REAL DESCR
	JRST	(R12)	; RETURN
	PRGEND
	SUBTTL	S$$EXP DESCRIPTOR MODE EXPONENTIATION ROUTINE

	ENTRY	S$$EXP
	EXTERN	S$$PGL,S$$STN,S$$ITR,EXP1.0,EXP2.0,EXP3.0
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R12,S$$EXP	; WITH SECOND (RIGHT) ARG IN R1 AND
FIRST (LEFT) ARG ON ES, RETURNS RESULT IN R1 WITH ES POPPED/

S$$EXP:	MOVEM	R12,S$$PGL	; SAVE LINK
	SETZ	R2,	; GET DESCR TYPE
	ROTC	R1,2
	JRST	.+1(R2)	; CONVERT TO INTEGER OR REAL VALUE
	JSP	R7,S$$STN-1
	CFERR	1,S$$PGL
	ASH	R1,-2
	MOVEI	R10,(R2)	; SAVE TYPE AND VALUE OF RHS
	MOVE	R9,R1
	POP	ES,R1	; GET LHS
	SETZ	R2,	; LIKEWISE CONVERT
	ROTC	R1,2
	JRST	.+1(R2)
	JSP	R7,S$$STN-1
	CFERR	1,S$$PGL
	ASH	R1,-2
	CAIL	R2,(R10)	; IS IT INTEGER ** REAL?
	JRST	.+3	; NO
	JSP	R3,S$$ITR	; YES, MAKE IT REAL ** REAL
	MOVEI	R2,3
	MOVE	R0,R1	; GET ARGS INTO POSITION FOR FORTRAN LIBRARY
	MOVE	R1,R9	; CALL
	PUSHJ	SS,@EXPTBL-2(R2)	; EXECUTE PROPER EXPONENTIATION
	IORI	R2,(R10)	; FORM DOMINANT TYPE
	MOVE	R1,R0	; GET VAL INTO POSITION
	JRST	.-1(R2)	; AND MAKE DESCR
	LSH	R1,2	; INTEGER
	ROTC	R1,-2	; REAL
	JRST	(R12)	; RETURN

EXPTBL:	JRST	EXP1.0	; I ** I
	JRST	@EXPTB1-2(R10)	; R ** ?
EXPTB1:	JRST	EXP2.0	; R ** I
	JRST	EXP3.0	; R ** R
	PRGEND
	SUBTTL	S$$NEG DESCRIPTOR UNARY - ROUTINE

	ENTRY	S$$NEG
	EXTERN	S$$PGL,S$$STN
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R12,S$$NEG	; WITH DESCRIPTOR IN R1/

S$$NEG:	MOVEM	R12,S$$PGL	; SAVE LINK
	SETZ	R2,	; GET TYPE
	ROTC	R1,2
	JRST	.+1(R2)	; CONVERT TO INTEGER OR REAL VALUE
	JSP	R7,S$$STN-1	; STRING
	CFERR	1,S$$PGL	; OTHER, OR STRING CONV FAILED
	ASH	R1,-2	; INTEGER
	MOVN	R1,R1	; REAL, AND NEGATE
	JRST	.-1(R2)	; MAKE DESCR AGAIN
	LSH	R1,2	; INTEGER
	ROTC	R1,-2	; REAL
	JRST	(R12)	; RETURN
	PRGEND
	SUBTTL	S$$CNC CONCATENATION ROUTINE

	ENTRY	S$$CNC
	EXTERN	S$$PGL,S$$GRS,S$$MKS,S$$TAC,S$$MST,S$$PTS,S$$PTX
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R12,S$$CNC	; WHERE NCONC IS THE NUMBER OF ELEMENTS
	NCONC	; IN THE CONCATENATION, ALL BUT THE LAST PUSHED ONTO ES
AND THE LAST IN R1. IF ALL BUT ONE ELEMENT IS NULL-VALUED, THE RESULT
IS THAT ELEMENT. IF ALL NON-NULL ELEMENTS ARE EITHER STRINGS, INTEGERS,
OR REALS, THE RESULT IS THEIR CONCATENATED STRING. IF ALL NON-NULL
ELEMENTS ARE EITHER STRINGS, INTEGERS, REALS, OR PATTERNS, THE RESULT IS
THEIR CONCATENATED PATTERN. IF ANY ELEMENT IS NONE OF THESE, AND ANOTHER
NON-NULL ELEMENT EXISTS, IT IS A TYPE ERROR. THE RESULT DESCRIPTOR IS RE-
TURNED IN R1, WITH ES RESTORED TO ITS INITIAL STATE (NCONC-1 ELEMENTS
POPPED OFF)/

S$$CNC:	MOVEM	R12,S$$PGL	; SAVE PROG LINK
	PUSH	ES,R1	; SAVE LAST ELT
	MOVN	R11,(R12)	; FORM -(NCONC,NCONC)
	HRLI	R11,-1(R11)
	MOVE	R10,ES	; FORM RESET ES
	ADD	R10,R11
	MOVEM	R10,SAVNES	; AND SAVE
	HRRI	R11,(R10)	; FORM XWD -NCONC,PTR TO FIRST ELEMENT
	AOBJN	R11,.+1
	MOVEM	R11,SAVELP	; AND SAVE
	SETZ	R10,	; INITIALIZE ELEMENT COUNT=0
	SETZB	R9,R8	; INITIALIZE CHAR COUNT, SAVED ELT =0
; SEARCH LOOP, CHECK EACH ELEMENT ON ES
SRCHLP:	MOVE	R1,(R11)	; GET NEXT ELEMENT
	JUMPE	R1,GTNXTS	; SKIP OUT IF NULL
	JUMPL	R1,SRCNUM	; JUMP IF INTEGER OR REAL
	TLNE	R1,^O770000	; IS IT STRING?
	JRST	SRCPAT	; NO, TRY PATTERN
	HRRZ	R3,(R1)	; GET CHAR COUNT
	JUMPN	R3,SRCSTR	; JUMP IF NONZERO
	SETZM	(R11)	; OR MAKE ELEMENT NULL
	JRST	GTNXTS	; AND SKIP OUT
CNVNUM:	SETO	R0,	; MAKE STRING FROM INTEGER OR REAL
	JSP	R7,S$$MKS	; WILL ALLWAYS SKIP OVER NEXT INSTR
SRCSTR:	SKIPN	R8,R1	; SAVE DESCR IN R8 AND SKIP
	MOVEM	R1,(R11)	; SAVE NEW STRING AS ELT
	ADDI	R9,(R3)	; ADD CHARS TO TOTAL
	AOJA	R10,GTNXTS	; INCREMENT ELT COUNT AND LOOP
SRCNUM:	JUMPN	R10,CNVNUM	; IF ELT COUNT > 0, GO CONVERT TO STRING
	HRRM	R11,SAVNPT	; OR SAVE PTR TO ELT
NUMLOP:	AOBJP	R11,RETSAV+1	; POINT TO NEXT ELT OR FINISH
	MOVE	R8,(R11)	; GET NEXT ELT
	JUMPE	R8,NUMLOP	; LOOP IF NULL
	TLNE	R8,^O770000	; IS IT STRING?
	JRST	NUMCNV	; NO
	HRRZ	R3,(R8)	; YES, GET CHAR COUNT
	JUMPN	R3,NUMCNV	; DON'T JUMP IF 0
	SETZM	(R11)	; SET ELT TO NULL
	JRST	NUMLOP	; AND KEEP LOOPING
NUMCNV:	SETO	R0,	; CONVERT SAVED NUMBER TO STRING
	JSP	R7,S$$MKS
SAVNES:	BLOCK	1	; NEVER EXECUTED, USE FOR STORAGE
SAVNPT:	MOVEM	R1,.-.	; SAVE NEW STRING DESCR IN ELT LOC
	MOVEI	R9,(R3)	; INITIALIZE CHAR COUNT
	MOVE	R1,R8	; GET CURRENT DESCR
	AOJA	R10,SRCHLP+2	; INCREMENT ELT COUNT AND PROCEED
SRCPAT:	TLC	R1,1B20	; IS IT PATTERN?
	TLNN	R1,3B21
	AOBJP	R10,SAVELT	; YES, INCREMENT ELT COUNT, MARK AS PAT
	JUMPN	R10,SPCERR	; NO, ERROR IF ANOTHER NON-NULL ELEMENT
	TLC	R1,1B20	; RESTORE DESCR
SPCLOP:	AOBJP	R11,RETSAV+1	; POINT TO NEXT ELT OR FINISH
	MOVE	R8,(R11)	; GET NEXT ELT
	JUMPE	R8,SPCLOP	; LOOP IF NULL
	TLNE	R8,^O770000	; IS IT STRING?
SPCERR:	CFERR	1,S$$PGL	; NO, ERROR
	HRRZ	R3,(R8)	; GET # OF CHARS
	JUMPE	R3,SPCLOP	; LOOP IF 0
	CFERR	1,S$$PGL	; OR ERROR
SAVELT:	TLC	R1,1B20	; RESTORE DESCR
	MOVE	R8,R1	; SAVE LATEST ELEMENT
GTNXTS:	AOBJN	R11,SRCHLP	; POINT TO NEXT ELEMENT AND LOOP
; ELEMENT SEARCH IS OVER, FORM NEW STRING OR PATTERN
	CAIG	R10,1	; IS # ELTS >1 ?
	JRST	RETSAV	; NO, FINISH
	MOVE	R11,SAVELP	; YES, GET FIRST ELT POINTER
	CAIL	R10,^O777777	; IS PATTERN FLAG ON?
	JRST	MAKPAT	; YES, GO MAKE PATTERN
	MOVEI	R0,(R9)	; NO, STRING, COMPUTE # OF WORDS NEEDED
	MUL	R0,[^F0.2B0]
	ADDI	R0,2
	JSP	R6,S$$GRS	; GET BLOCK
	HRLI	R1,^O700	; FORM DESCR
	MOVE	R8,R1	; SAVE
	HRRM	R9,(R1)	; AND SAVE # OF CHARS IN STRING BLOCK
	MOVE	R7,[XWD STRCHR,CHRLOP]	; MOVE CHAR LOOP INTO R4-R7
	BLT	R7,CHRBOT
STRLOP:	MOVE	R2,(R11)	; GET NEXT ELT
	JUMPE	R2, STRBOT	; SKIP OUT IF NULL
	HRRZ	R3,(R2)	; GET CHAR COUNT
	JRST	CHRLOP	; START LOOP
STRCHR:	PHASE	4
CHRLOP:	ILDB	R0,R2	; R4: GET CHAR FROM ELT
	IDPB	R0,R1	; R5: PUT CHAR IN NEW STRING
	SOJG	R3,CHRLOP	; R6: LOOP
CHRBOT:	JRST	STRBOT	; R7: OR EXIT
	DEPHASE
STRBOT:	AOBJN	R11,STRLOP	; LOOP FOR EACH ELEMENT
RETSAV:	MOVE	R1,R8	; RESTORE RESULT DESCR
	MOVE	ES,SAVNES	; RESTORE POPPED ES
	JRST	1(R12)	; RETURN
; AT LEAST ONE ELEMENT IS A PATTERN, CREATE PATTERN ROUTINE AND DATA BLOCK
MAKPAT:	MOVEI	R0,1(R10)	; GET # ELTS + 1
	CAIG	R0,2	; IS # ELTS > 1?
	JRST	RETSAV	; NO, FINISH
	JSP	R6,S$$GRS	; GET DATA BLOCK
	HRLI	R1,3B20	; MAKE PATTERN DESCR
	MOVE	R8,R1	; SAVE
	HRLI	R1,^O700	; FAKE STRING DESCR AND SAVE
	MOVEM	R1,S$$TAC	; IN CASE OF GARBAGE COLLECTION
	LSH	R0,1	; GET 2*(#ELTS+1)
	JSP	R6,S$$GRS	; GET BLOCK FOR PATTERN ROUTINE
	ADDI	R1,1	; PTR TO FIRST INST
	HRRM	R1,(R8)	; SAVE POINTER TO ROUTINE IN DATA BLOCK
	MOVE	R9,[MOVE R1,1(DT)]	; INSTR. TO FETCH ELT FROM DATBLK
	MOVE	R7,[JSP R9,S$$MST]	; INSTR. IF STRING
	MOVE	R6,[JSP R9,S$$PTX]	; ISTR. IF PATTERN
	MOVEI	R10,1(R8)	; FIRST ELT PTR IN DATA BLOCK
PATLOP:	MOVE	R2,(R11)	; GET NEXT ELT
	JUMPE	R2,PATBOT	; SKIP OUT IF NULL
	TLNE	R2,^O770000	; IS IT STRING?
	JRST	PATELT	; NO, PATTERN
	MOVEM	R7,1(R1)	; YES, SAVE STRING MATCH INSTR
PATRET:	MOVEM	R2,(R10)	; SAVE ELT IN DATA BLOCK
	MOVEM	R9,(R1)	; SAVE ELT FETCH INSTR
	ADDI	R1,2	; NEXT INSTR LOC IN PATTERN ROUTINE
	ADDI	R9,1	; NEXT ELT FETCH INSTR
	ADDI	R10,1	; NEXT DATA BLOCK LOC
PATBOT:	AOBJN	R11,PATLOP	; LOOP FOR EACH ELT
	MOVE	R6,[JRST S$$PTS]	; LAST INSTR OF PATTERN ROUTINE
	MOVEM	R6,(R1)
	SETZM	S$$TAC	; CLEAR DUMMY STRING DESCR
	JRST	RETSAV	; FINISH
PATELT:	TLNE	R2,1B22	; IS SUBPAT RESTARTEABLE?
	TLO	R8,1B22	; YES, SET RESTARTEABLE BIT OF WHOLE PAT
	MOVEM	R6,1(R1)	; SAVE PAT MATCH INST
	JRST	PATRET	; REJOIN LOOP
; STORAGE
SAVELP:	BLOCK	1
	PRGEND
	SUBTTL	S$$IVN,S$$IVV INDIRECT VARIABLE NAME AND VALUE ROUTINES

	ENTRY	S$$IVN,S$$IVV
	EXTERN	S$$PGL,S$$LKV,S$$CPS
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R12,S$$IVN	; WITH KEY DESCRIPTOR IN R1, RETURNS
NAME DESCRIPTOR IN R1 (SAME AS KEY IF KEY IS NAME)

CALL:	JSP	R12,S$$IVV	; WITH KEY DESCRIPTOR IN R1, RETURNS
VALUE DESCRIPTOR IN R1 (DOES NO LOOKUP IF KEY IS NAME)/

S$$IVN:	JSP	R11,S$$IVV+1	; NAME, INDEX=0
S$$IVV:	JSP	R11,S$$IVV+1	; VALUE, INDEX=1
	SUBI	R11,S$$IVN+1
	SETZ	R2,	; GET DESCR TYPE
	ROTC	R1,4
	CAIE	R2,4	; IS IT NAME?
	JRST	INDLKP	; NO, DO LOOKUP
	ROTC	R1,-4	; RESTORE DESCR
INDCOM:	XCT	[JRST	(R12)
		 MOVE	R2,R1](R11)	; RETURN FOR NAME CALL
	MOVE	R1,(R2)	; GET VALUE
	TLNE	R2,1B22	; IS IT DEDICATED INTEGER OR REAL?
	JRST	DEDVAR	; YES
	TLNE	R2,1B23	; IS IT DEDICATED STRING?
	JSP	R7,S$$CPS	; YES, COPY
	JRST	(R12)	; RETURN VALUE
DEDVAR:	TLNN	R2,1B23	; IS IT DEDICATED REAL?
	JRST	MKIDSC	; NO, MAKE INT DESCR
	LSH	R1,-2	; MAKE REAL DESCR
	TLO	R1,3B19
	JRST	(R12)	; RETURN
MKIDSC:	TLZ	R1,1B19	; MAKE INTEGER DESCR
	TLO	R1,1B18
	JRST	(R12)	; RETURN
INDLKP:	MOVEM	R12,S$$PGL	; SAVE LINK
	ROTC	R1,-4	; RESTORE DESCR
	JSP	R10,S$$LKV	; DO LOOKUP
	MOVE	R1,(R2)	; GET NAME
	JRST	INDCOM	; RETURN OR GET VALUE
	PRGEND
	SUBTTL	S$$ILB INDIRECT LABEL FUNCTION

	ENTRY	S$$ILB
	EXTERN	S$$PGL,S$$LKL
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R12,S$$ILB	; WITH KEY DESCRIPTOR IN R1, EXECUTES
	VALUE LOCATION/

S$$ILB:	MOVEM	R12,S$$PGL	; SAVE PROG LINK
	JSP	R10,S$$LKL	; DO LOOKUP
	XCT	(R2)	; PERFORM GOTO
	PRGEND
	SUBTTL	S$$LKV,S$$LKL,S$$LKF VARIABLE, LABEL, AND FUNCTION LOOKUP
	ENTRY	S$$LKV,S$$LKL,S$$LKF
	EXTERN	S$$LKS,S$$PGL,S$$GLP,S$$GNS,S$$UDF
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R10,S$$LKV[S$$LKL,S$$LKF]	; WITH KEY DESCRIPTOR IN
	R1, RETURNS POINTER TO VALUE LOCATION IN R2/

S$$LKV:	JSP	R9,S$$LKF+1	; VARIABLE, INDEX = 0
S$$LKL:	JSP	R9,S$$LKF+1	; LABEL, INDEX = 1
S$$LKF:	JSP	R9,S$$LKF+1	; FUNCTION, INDEX = 2
	SUBI	R9,S$$LKL
	MOVEI	R0,(R9)	; GET TYPE
	TLO	R0,1B18	; FORM TYPE*2+1
	ROT	R0,-4	; IN BITS 0-4
	JSP	R8,S$$LKS	; DO LOOKUP
	JRST	(R10)	; FOUND
	XCT	NEWLKV(R9)	; NEW ENTRY, GET APPROPRIATE VALUE
NEWLKC:	MOVEM	R5,(R2)	; SAVE
	JRST	(R10)	; RETURN
NEWLKV:	JRST	.+3	; VARIABLE
	MOVE	R5,[UFERR 8,S$$PGL]	; LABEL
	MOVE	R5,[XWD 1B19,S$$UDF]	; FUNCTION
	HRRZ	R5,S$$GLP+1	; GET GLOBAL VARIABLE BLOCK
	HLRZ	R6,(R5)	; GET SIZE
	ANDI	R6,^O177777
	CAMG	R6,S$$GLP+2	; ROOM LEFT?
	JRST	NEWVBL	; NO, MAKE NEW BLOCK
	ADD	R5,S$$GLP+2	; YES, POINT TO NEXT AVAILABLE LOC
	AOS	S$$GLP+2	; INCREMENT LOC INDEX
NEWVBC:	TLO	R5,1B19	; FORM NAME DESCR
	JRST	NEWLKC	; GO BACK TO SEQUENCE
NEWVBL:	HRRM	R2,NEWVR2	; SAVE VALUE POINTER
	MOVEI	R0,P$GVXT	; GET GLOBAL VARIABLE BLOCK EXTENSION SIZE
	JSP	R6,S$$GNS	; GET NONRETURNABLE BLOCK
	MOVE	R2,S$$GLP+1	; GET VAR BLOCK LIST
	HRRM	R1,(R2)	; APPEND NEW BLOCK
	HRRI	R2,(R1)
	MOVEM	R2,S$$GLP+1
	MOVEI	R2,2	; NEW AVAIL INDEX
	MOVEM	R2,S$$GLP+2
NEWVR2:	MOVEI	R2,.-.	; RESTORE VALUE POINTER
	MOVEI	R5,1(R1)	; FORM POINTER TO VARIABLE LOC
	HRLI	R1,1(R1)	; SET INITIAL VALUES
	MOVEI	R3,P$GVXT-1(R1)	; OF VARIABLES IN NEW VAR BLOCK
	SETZM	1(R1)	; TO NULL
	HRRI	R1,2(R1)
	BLT	R1,(R3)
	JRST	NEWVBC	; FORM NAME AND GO BACK TO SEQUENCE
	PRGEND
	SUBTTL	S$$LKS INDIRECTION SYMBOL LOOKUP ROUTINE

	ENTRY	S$$LKS
	EXTERN	S$$MKS,S$$PGL,S$$PBP,S$$SY1,S$$SY2,S$$GLP,S$$TBM,S$$MNS
	RADIX	10
	SEARCH	S$$NDF

	COMMENT"
CALL:	JSP	R8,S$$LKS	; WITH TYPE/0,0 IN R0, KEY DESCRIPTOR
	IN R1. RETURNS TO 0(R8) IF FOUND, WITH POINTER TO VALUE LOC
	IN R2. RETURNS TO 1(R8) IF NEW ENTRY, WITH POINTER TO VALUE LOC
	IN R2, AND STRING VALUE OF KEY MADE NONRETURNABLE"

S$$LKS:	TLNN	R1,^O770000	; IS IT A STRING?
	JRST	.+5	; YES
	MOVN	R0,R0	; NO, TRY TO CREATE ONE
	JSP	R7,S$$MKS
	CFERR	1,S$$PGL	; NO GO
	MOVN	R0,R0	; RESTORE TYPE
	CAML	R0,[7B4]	; IS IT < TYPE 7?
	JRST	SPCLKS	; NO, SPECIAL
	ADD	R0,@S$$PBP	; ADD TABLE NUMBER TO LH
	HLRI	R0,	; AND ZERO RH
	JSP	R7,S$$SY1	; LOOKUP SYMBOL
	JRST	(R8)	; FOUND
	ADD	R0,[1B4]	; MAKE TYPE GLOBAL
	TLZ	R0,^O17777	; WITH TABLE # = 0
	JSP	R7,S$$SY2	; AND RETRY LOOKUP
	JRST	(R8)	; FOUND
MNELKS:	MOVE	R4,S$$GLP	; NOT FOUND, GET GLOBAL TABLE DESCR
	JSP	R7,S$$TBM	; MAKE NEW ENTRY
	HRRM	R2,RR2LKS	; SAVE VALUE POINTER
	JSP	R6,S$$MNS	; MAKE STRING BLOCK NONRETURNABLE
RR2LKS:	MOVEI	R2,.-.	; RESTORE VALUE POINTER
	JRST	1(R8)	; RETURN NEW ENTRY
SPCLKS:	JSP	R7,S$$SY1	; LOOKUP SYMBOL
	JRST	(R8)	; FOUND
	JRST	MNELKS	; NOT FOUND, MAKE NEW ENTRY
	PRGEND
	SUBTTL	S$$TBM NEW TABLE ENTRY FUNCTION

	ENTRY	S$$TBM
	EXTERN	S$$GNS,S$$GRS,S$$TA1,S$$GLP
	RADIX	10
	SEARCH	S$$NDF

	COMMENT"
CALL:	JSP	R7,S$$TBM	; WITH TYPE/NO.,MAJORKEY IN R0, KEY
	DESCRIPTOR IN R1, NEXT ENTRY POINTER IN R2, AND TABLE DESCRIPTOR
	IN R4. RETURNS POINTER TO VALUE LOC OF NEW ENTRY IN R2, WITH
	R0 AND R1 UNCHANGED"

S$$TBM:	MOVE	R3,1(R4)	; GET CURRENT SIZE AND POINTER
	CAML	R3,-1(R3)	; WITHIN CURRENT BLOCK?
	JRST	NEWEXT	; NO, GET NEW EXTENSION BLOCK
NEWEXR:	HLRZ	R5,R3	; GET CURRENT SIZE
	HRLI	R3,4(R5)	; ADD 4 LOCS
	MOVEM	R3,1(R4)	; UPDATE CURRENT SIZE, POINTER
	ADDI	R3,(R5)	; PTR TO NEW ENTRY
	MOVEM	R0,1(R3)	; SAVE TYPE/NO.,MAJORKEY
	MOVEM	R1,2(R3)	; SAVE KEY DESCR
	HLL	R2,(R2)	; FORM CHAIN WORD
	MOVEM	R2,(R3)	; AND SAVE
	HRLM	R3,(R2)	; SPLICE ENTRY INTO CHAIN
	MOVS	R2,R2
	HRRM	R3,(R2)
	MOVEI	R2,3(R3)	; FORM POINTER TO VALUE LOC
	JRST	(R7)	; AND RETURN
NEWEXT:	MOVEM	R0,SAVTMP	; SAVE R0,R2,R4, AND KEY DESCR
	MOVEM	R2,SAVTMP+1
	MOVEM	R4,SAVTMP+2
	MOVEM	R1,S$$TA1
	HRRZ	R0,(R4)	; GET EXTENSION BLOCK SIZE
	CAMN	R4,S$$GLP	; IS TABLE GLOBAL SYMBOL TABLE?
	JRST	TBMGNS	; YES, GET NONRETURNABLE BLOCK
	JSP	R6,S$$GRS	; NO, GET RETURNABLE BLOCK
TBMGNR:	MOVE	R4,SAVTMP+2	; RESTORE R4
	MOVE	R3,1(R4)	; GET LAST EXT POINTER
	HRRM	R1,-1(R3)	; SAVE EXTENSION POINTER TO NEW ONE
	SUBI	R0,2	; EXTENSION SIZE MAX
	HRLZM	R0,1(R1)	; SAVE IN NEW EXTENSION BLOCK
	MOVEI	R3,2(R1)	; FORM NEW EXTENSION POINTER
	SETZ	R1,
	EXCH	R1,S$$TA1	; RESTORE KEY DESCR
	MOVE	R2,SAVTMP+1	; RESTORE R2 AND R0
	MOVE	R0,SAVTMP
	JRST	NEWEXR	; RETURN TO SEQUENCE
TBMGNS:	JSP	R6,S$$GNS	; GET NONRETURNABLE BLOCK
	JRST	TBMGNR
; STORAGE
SAVTMP:	BLOCK	3
	PRGEND
	SUBTTL	S$$TMR 'TIMER' OPTION ROUTINES

	ENTRY	S$$STT,S$$TMF,S$$TMX,S$$TMO
	EXTERN	S$$STE,S$$KWD,S$$PBP,S$$TMS,S$$OUC,S$$OUT,S$$ITS
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
	STATEMENT TIMING
CALL:	JSP	R12,S$$STT	; FINISH TIMING ON LAST STATEMENT, START
	XWD	STNO,FAILPT	; TIMING ON NEW ONE, AND THEN GO TO
	S$$STE. DOES NOTHING IF TIMING IS NOT ACTIVE FOR CURRENT ROUTINE,
	OR DOES NOT FINISH TIMING ON LAST STATEMENT IF &STNO IS 0.

	FUNCTION RETURN TIMING
CALL:	JSP	R5,S$$TMF	; SIMILAR TO S$$STT, BUT CALLED FROM
	FUNCTION RETURN OR SYSTEM EXIT TO CLOSE OUT TIMING ON LAST &STNO.

	TIMER EXIT STATISTICS
CALL:	JSP	R7,S$$TMX	; WITH PROGRAM LIST IN R6, OUTPUTS TIMING
	STATISTICS FOR EACH PROGRAM BEING TIMED.

	PROGRAM TIMER STATISTICS
CALL:	JSP	R7,S$$TMO	; WITH PARBLK POINTER IN R6, TIMING
	BLOCK POINTER IN R5, OUTPUTS TIMING STATISTICS FOR PROGRAM
	SPECIFIED BY PARBLK POINTER, LEAVES R6 UNCHANGED/

; STATEMENT AND FUNCTION RETURN TIMING
S$$STT:	JSP	R4,TMRCOM	; STATEMENT TIMING, INDEX = 0
S$$TMF:	JSP	R4,TMRCOM	; RETURN TIMING, INDEX = 1
TMRCOM:	SUBI	R4,S$$STT+1
	HRRZ	R3,@S$$PBP	; GET TIMING BLOCK POINTER
	JUMPE	R3,TMRFIN(R4)	; SKIP OUT IF NO TIMING
	SETZ	R0,
	RUNTIM	R0,	; GET CURRENT RUNTIME
	MOVE	R1,S$$TMS	; GET PREVIOUS RUNTIME
	MOVEM	R0,S$$TMS	; SAVE CURRENT RUNTIME
	MOVE	R2,S$$KWD+2	; GET &STNO
	JUMPE	R2,TMRFIN(R4)	; SKIP OUT IF 0 (NO TIMING YET)
	SUB	R0,R1	; COMPUTE ELAPSED TIME FOR STATEMENT
	ADDM	R0,(R3)	; ADD TO TOTAL TIME
	HRLI	R0,1	; 1 MORE STATEMENT FOR COUNT
	ADDI	R3,(R2)	; TIMING BLOCK ENTRY FOR STATEMENT
	ADDM	R0,(R3)	; ADD 1,TIME TO TOTAL EXECUTION FOR STATEMENT
	JRST	TMRFIN(R4)	; EXIT
TMRFIN:	JRST	S$$STE	; STATEMENT TIMING EXIT
	JRST	(R5)	; RETURN TIMING EXIT
; TIMER EXIT STATISTICS
S$$TMX:	HRRM	R7,TMXFIN	; SAVE RETURN LINK
	HLRZ	R6,R6	; GET FIRST PROGRAM PARBLK
TMXLOP:	HRRZ	R5,1(R6)	; GET TIMING BLOCK POINTER
	JUMPE	R5,.+2	; SKIP IF 0
	JSP	R7,S$$TMO	; OTHERWISE OUTPUT STATISTICS
	HRRZ	R6,(R6)	; GET NEXT PARBLK POINTER
	JUMPN	R6,TMXLOP	; AND LOOP IF NONZERO
TMXFIN:	JRST	.-.	; OR RETURN
; PROGRAM TIMER STATISTICS
S$$TMO:	MOVE	R1,MSG1	; "////TIMING STATISTICS FOR "
	MOVEM	R1,@S$$OUC	; OUTPUT
	MOVE	R1,-1(R6)	; GET PROGRAM NAME STRING DESCR
	MOVEM	R1,@S$$OUT	; OUTPUT
	MOVE	R1,[POINT 7,MSG2S+5,27]	; INSERT IN TOTAL TIME MESSAGE
	HRRZ	R2,(R5)	; GET TOTAL TIME
	HRRM	R2,PERCNT	; SAVE IN PERCENT CALCULATION
	SETZM	MSG2S+6	; CLEAR CONVERSION AREA
	JSP	R4,S$$ITS	; CONVERT TO STRING
	MOVE	R1,MSG2	; "//  TOTAL TIME FOR PROGRAM = XXX MS."
	MOVEM	R1,@S$$OUT	; OUTPUT
	MOVE	R1,MSG3	; TIMING STATISTICS COLLUMN HEADER
	MOVEM	R1,@S$$OUT	; OUTPUT
	SETZM	STSTAT+3	; INITIALIZE STATEMENT #
	HLRZ	R1,(R5)	; SET UP LOOP POINTER FOR STATEMENT BLOCK
	ANDI	R1,^O177777
	MOVNI	R1,(R1)
	HRLI	R5,(R1)
	AOBJP	R5,(R7)	; START AT FIRST STATEMENT ENTRY
	HRLI	R7,(R6)	; SAVE PARBLK POINTER
TMOLP1:	AOS	STSTAT+3	; INCREMENT STATEMENT NUMBER
	MOVE	R1,(R5)	; GET COUNT,TIME
	HLRZM	R1,STSTAT+2	; SAVE COUNT
	HRRZM	R1,STSTAT+1	; SAVE TIME
	MOVEI	R2,100	; COMPUTE % OF TOTAL
	IMULI	R2,(R1)
PERCNT:	IDIVI	R2,.-.
	HRRZM	R2,STSTAT	; SAVE
	MOVE	R3,MSG4S	; BLANK OUT NUMERIC FIELDS
	MOVEM	R3,MSG4S+1
	MOVEM	R3,MSG4S+4
	MOVEM	R3,MSG4S+7
	MOVEM	R3,MSG4S+10
	MOVEI	R6,3	; 4 STATISTICS LOOP
TMOLP2:	MOVE	R1,STPOIN(R6)	; GET BYTE POINTER FOR STATISTIC
	MOVE	R2,STSTAT(R6)	; GET STATISTIC
	JSP	R4,S$$ITS	; CONVERT TO STRING IN MESSAGE
	SOJGE	R6,TMOLP2	; LOOP FOR EACH STATISTIC
	MOVE	R1,MSG4	; GET STATISTICS LINE
	MOVEM	R1,@S$$OUT	; OUTPUT
	AOBJN	R5,TMOLP1	; LOOP FOR EACH STATEMENT
	HLRZ	R6,R7	; RESTORE PARBLK POINTER
	JRST	(R7)	; RETURN
; STORAGE
MSG1:	POINT	7,.+1,35
	BYTE	(2)2(16)7(18)27
	BYTE	(7)^O12,^O12,^O12,^O12,"*"
	ASCII/TIMING STATISTICS FOR /
MSG2:	POINT	7,.+1,35
	BYTE	(2)2(16)9(18)39
MSG2S:	BYTE	(7)^O12,^O12," "," ","T"
	ASCII/OTAL TIME FOR PROGRAM =        MS./
MSG3:	POINT	7,.+1,35
	BYTE	(2)2(16)13(18)62
	BYTE	(7)^O12,^O12," ","S","T"
	ASCII/ATEMENT   # OF EXECUTIONS   TIME IN MS. /
	ASCII/  % OF TOTAL TIME/
MSG4:	POINT	7,.+1,35
	BYTE	(2)2(16)12(18)55
MSG4S:	REPEAT	11,<	ASCII/     />
STPOIN:	POINT	7,MSG4S+10
	POINT	7,MSG4S+7
	POINT	7,MSG4S+4
	POINT	7,MSG4S+1
STSTAT:	BLOCK	4
	PRGEND
	SUBTTL	S$$STE STATEMENT ENTRY ROUTINE

	ENTRY	S$$STE
	EXTERN	S$$KWD,S$$FLP,S$$ITS,S$$SST,S$$PBP,S$$OUT
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R12,S$$STE	; WHERE STNO IS THE STATEMENT NUMBER
	XWD	STNO,FAILPT	; AND FAILPT IS THE STATEMENT FAILPOINT
	&LASTNO IS SET TO &STNO,&STNO IS SET TO STNO, &STCOUNT IS INCRE-
MENTED AND TESTED AGAINST &STLIMIT, AND THE FAILPOINT POINTER IS SET.
IF &STNTRACE IS NOT 0, A STATEMENT TRACE MESSAGE IS OUTPUT/

S$$STE:	MOVE	R1,(R12)	; GET STNO, FAILPT
	HRRZM	R1,S$$FLP	; SET FAILPOINT
	HLRZ	R1,R1	; GET STNO
	EXCH	R1,S$$KWD+2	; UPDATE &STNO, GET OLD &STNO
	MOVEM	R1,S$$KWD+1	; SAVE AS NEW &LASTNO
	AOS	R1,S$$KWD+4	; INCREMENT &STCOUNT
	CAML	R1,S$$KWD+13	; IS IT < &STLIMIT
	UFERR	6,R12	; NO, ERROR
	SKIPN	S$$KWD+11	; IS &STNTRACE ON?
	JRST	1(R12)	; NO, RETURN
	SETZM	TRCMSG+5	; INITIALIZE TRACE MESSAGE
	SETZM	TRCMSG+7
	SETZM	TRCMSG+8
	SETZM	TRCMSG+11
	SETZM	TRCMSG+12
	MOVE	R1,[POINT 7,TRCMSG+5]	; EDIT IN &STNO
	MOVE	R2,S$$KWD+2
	JSP	R4,S$$ITS
	MOVE	R1,S$$PBP	; EDIT IN PROGRAM NAME
	MOVE	R1,-2(R1)
	HRRZ	R2,(R1)
	CAILE	R2,10
	MOVEI	R2,10
	MOVE	R3,[POINT 7,TRCMSG+7]
	ILDB	R0,R1
	IDPB	R0,R3
	SOJG	R2,.-2
	MOVE	R1,[POINT 7,TRCMSG+11]	; EDIT IN TIME
	SETZ	R2,
	RUNTIM	R2,
	SUB	R2,S$$SST
	JSP	R4,S$$ITS
	MOVE	R1,MSGDSC	; OUTPUT TRACE MESSAGE
	MOVEM	R1,@S$$OUT
	JRST	1(R12)	; RETURN
; STORAGE
MSGDSC:	POINT	7,.+1,35
	BYTE	(2)2(16)14(18)65
TRCMSG:	ASCII/*STNTRACE*  OF STATEMENT /
	BLOCK	1
	ASCII/ IN  /
	BLOCK	2
	ASCII/ AT TIME= /
	BLOCK	2
	PRGEND
	SUBTTL	S$$CPS COPY STRING ROUTINE

	ENTRY	S$$CPS
	EXTERN	S$$GRS,S$$TA1
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R7,S$$CPS	; WITH STRING DESCRIPTOR IN R1, RETURNS
	NEW STRING DESCRIPTOR IN R1/

S$$CPS:	JUMPE	R1,(R7)	; RETURN IF NULL
	HRRZ	R2,(R1)	; GET CHAR COUNT
	JUMPN	R2,.+3	; IS IT 0?
	SETZ	R1,	; YES, SET TO NULL VALUE
	JRST	(R7)	; AND RETURN
	MUL	R2,[^F0.2B0]	; COMPUTE NUMBER OF WORDS NEEDED
	MOVEI	R0,2(R2)
	MOVEM	R1,S$$TA1	; SAVE OLD DESCR
	JSP	R6,S$$GRS	; GET BLOCK FOR NEW STRING
	HRLI	R1,^O700	; FORM STRING DESCR
	MOVE	R2,R1	; FORM BLT WORD
	HRL	R2,S$$TA1
	HRRZ	R3,@S$$TA1	; TRANSFER CHAR COUNT
	HRRM	R3,(R2)
	MOVE	R3,R0	; FORM END ADDR FOR BLT
	ADDI	R3,-1(R2)
	AOBJP	R2,.+1	; START BLT ON SECOND WORD OF BLOCKS
	BLT	R2,(R3)
	SETZM	S$$TA1
	JRST	(R7)	; RETURN
	PRGEND
	SUBTTL	S$$GNP GET NEXT NUMERICAL PARAMETER ROUTINE

	ENTRY	S$$GNP
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R4,S$$GNP	; WITH BYTE POINTER IN R1, BYTE COUNT
	IN R3. PROCESSES SIGNED INTEGER INCLUDING DELIMITER AND RETURNS
	TO 1(R4) WITH INTEGER VALUE IN R2 AND DELIMITER IN R0, OR RE-
	TURNS TO 0(R4) IF DELIMITER IS NOT FOUND, WITH INTEGER IN R2/

S$$GNP:	SETZ	R2,	; INITIAL INTEGER VALUE
	SOJL	R3,(R4)	; RETURN IF NO MORE CHARS
	HLLI	R4,	; INITIAL SIGN IS +
	ILDB	R0,R1	; GET FIRST CHAR
	CAIE	R0,"-"	; IS IT A - SIGN?
	JRST	TRYPLS	; NO, TRY PLUS
	HRLI	R4,-1	; SET SIGN TO -
	JRST	NXTDIG	; GO INTO LOOP
TRYPLS:	CAIN	R0,"+"	; IS IT A + SIGN
	JRST	NXTDIG	; YES, GO INTO LOOP
DIGLOP:	CAIL	R0,"0"	; IS IT A DIGIT?
	CAILE	R0,"9"
	AOJA	R4,GNPFIN	; NO, DELIMITER FOUND
	SUBI	R0,"0"	; GET INTEGER DIGIT
	IMULI	R2,10	; TOT = TOT*10+DIGIT
	ADD	R2,R0
NXTDIG:	SOJL	R3,GNPFIN	; QUIT IF NO MORE CHARS
	ILDB	R0,R1	; GET NEXT CHAR
	JRST	DIGLOP	; AND LOOP
GNPFIN:	JUMPGE	R4,(R4)	; RETURN IF + VALUE
	MOVN	R2,R2	; OR NEGATE
	JRST	(R4)	; AND RETURN
	PRGEND
	SUBTTL	S$$ASG ASSIGNMENT ROUTINE

	ENTRY	S$$ASG
	EXTERN	S$$DSG,S$$PGL
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R9,S$$ASG	; WITH VALUE IN R1 AND NAME DESCRIPTOR
	ON ES, DOES NORMAL OR DEDICATED ASSIGNMENT/

S$$ASG:	MOVEM	R9,S$$PGL	; SAVE PROGRAM LINK
	POP	ES,R8	; GET NAME OFF ES
	TLNE	R8,3B23	; ARE DEDICATED BITS ON?
	JRST	S$$DSG	; YES, DEDICATED ASSIGNMENT
	MOVEM	R1,(R8)	; NO, NORMAL ASSIGNMENT (POSSIBLE OUTPUT)
	JRST	(R9)	; RETURN
	PRGEND
	SUBTTL	S$$MVS MOVE STRING ROUTINE

	ENTRY	S$$MVS
	RADIX	10
	SEARCH	S$$NDF

	P$BRKE=8	; BREAK EVEN POINT OF REGISTER LOOP

	COMMENT/
CALL:	JSP	R7,S$$MVS	; WITH OBJECT BYTE POINTER IN R1, SOURCE
BYTE POINTER IN R2, AND CHARACTER COUNT (>0) IN R3/

S$$MVS:	CAIL	R3,P$BRKE	; FEWER CHARS THAN BREAK EVEN POINT?
	JRST	MOVLOP	; NO, MOVE LOOP INTO FAST REGISTERS
CHRLP1:	ILDB	R0,R2	; GET CHAR FROM SOURCE
	IDPB	R0,R1	; PUT CHAR IN OBJECT
	SOJG	R3,CHRLP1	; LOOP
	JRST	(R7)	; OR RETURN
MOVLOP:	HLL	R7,S$$MVS+1	; INSERT JRST IN LH OF R7
	MOVE	R6,[XWD CHRLOP,CHRLP2]	; MOVE LOOP INTO R4-R6
	BLT	R6,CHRLPE
	JRST	CHRLP2	; START LOOP
CHRLOP:	PHASE	4
CHRLP2:	ILDB	R0,R2	; R4: GET CHAR
	IDPB	R0,R1	; R5: PUT CHAR
CHRLPE:	SOJG	R3,CHRLP2	; R6: LOOP
	DEPHASE
	PRGEND
	SUBTTL	S$$EQS STRING EQUALITY TEST ROUTINE

	ENTRY	S$$EQS
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R5,S$$EQS	; WITH STRING DESCRIPTORS IN R1 AND R2,
	RETURNS TO 0(R5) IF EQUAL AND 1(R5) IF NOT EQUAL/

S$$EQS:	CAMN	R1,R2	; ARE DESCRIPTORS EQUAL?
	JRST	(R5)	; YES, STRINGS MUST BE EQUAL
	SETZ	R0,	; ZERO R0 INCASE DESCR IS 0 (POINTS TO R0)
	HRRZ	R3,(R2)	; GET FIRST CHAR COUNT, INCLUDING NULL OR ZERO
	HRRZ	R0,(R1)	; GET SECOND CHAR COUNT, INCLUDING NULL OR ZERO
	CAIE	R0,(R3)	; ARE COUNTS EQUAL?
	JRST	1(R5)	; NO, STRINGS UNEQUAL
	JUMPE	R0,(R5)	; STRINGS EQUAL IF 0 CHAR
	CAIG	R0,5	; <6 CHARS?
	JRST	CHRLOP	; YES, DO CHAR LOOP
	MUL	R3,POINT2	; NO, COMPUTE # WORDS
	ROT	R4,4	; AND # OF REM CHARS
	MOVE	R4,REMTBL(R4)
	HRRM	R4,GETREM	; SAVE REM CHARS
	TLC	R1,^B1001B27	; SET BYTE PTRS
	TLC	R2,^B1001B27	; FOR 35-BIT BYTES
WRDLOP:	ILDB	R0,R1	; GET WORD FROM FIRST
	ILDB	R4,R2	; GET WORD FROM SECOND
	CAME	R0,R4	; EQUAL?
	JRST	1(R5)	; NO, STRINGS UNEQUAL
	SOJG	R3,WRDLOP	; LOOP FOR EACH WORD
	TLC	R1,^B1001B27	; SET BYTE PTRS
	TLC	R2,^B1001B27	; BACK TO 7-BIT BYTES
GETREM:	MOVEI	R3,.-.	; GET REM CHARS
CHRLOP:	ILDB	R0,R1	; GET CHAR FROM FIRST
	ILDB	R4,R2	; GET CHAR FROM SECOND
	CAIE	R0,(R4)	; EQUAL?
	JRST	1(R5)	; NO, STRINGS UNEQUAL
	SOJG	R3,CHRLOP	; LOOP FOR EACH CHAR
	JRST	(R5)	; STRINGS EQUAL IF ALL CHARS MATCH
; STORAGE
	REMTBL=.-1	; REM=0, IMPOSSIBLE
	1	; REM=1, 1 CHAR REM
POINT2:	^O63146300000	; REM=2, IMPOSSIBLE, USE SPACE
	2	; REM=3, 2 CHAR REM
	3	; REM=4, 3 CHAR REM
	0	; REM=5, IMPOSSIBLE
	4	; REM=6, 4 CHAR REM
	5	; REM=7, 5 CHAR REM
	PRGEND
	SUBTTL	S$$SRT,S$$NRT,S$$FRT 'RETURN','NRETURN','FRETURN' LABELS

	ENTRY	S$$SRT,S$$NRT,S$$FRT
	EXTERN	S$$KWD,S$$RTP,S$$TMF,S$$PGL
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JRST	S$$SRT[S$$NRT,S$$FRT]	; RESULT OF JUMP TO 'RETURN',
'NRETURN', OR 'FRETURN' LABELS/

S$$FRT:	JSP	R12,S$$NRT+1	; 'FRETURN', INDEX=-1
S$$SRT:	JSP	R12,S$$NRT+1	; 'RETURN', INDEX=0
S$$NRT:	JSP	R12,S$$NRT+1	; 'NRETURN', INDEX=1
	SUBI	R12,S$$NRT
	SOSGE	S$$KWD+3	; DECREMENT &FNCLEVEL
	UFERR	2,S$$PGL	; RETURN FROM 0 LEVEL
	MOVE	R1,@RTNTYP(R12)	; GET RETURN TYPE
	MOVEM	R1,S$$KWD+6	; SAVE IN &RTNTYPE
	JSP	R5,S$$TMF	; FINISH TIMING ON LAST STATEMENT
	POPJ	SS,	; GO TO APPROPRIATE FUNCTION RETURN ROUTINE
; STORAGE
	S$$RTP+4	; POINTS TO 'FRETURN' DESCRIPTOR
RTNTYP:	S$$RTP	; POINTS TO 'RETURN' DESCRIPTOR
	S$$RTP+8	; POINTS TO 'NRETURN' DESCRIPTOR
	PRGEND
	SUBTTL	S$$BGT BAD GOTO ERROR EXIT

	ENTRY	S$$BGT
	EXTERN	S$$PGL
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JRST	S$$BGT	; CALLED BY FAILPOINT ROUTINE DURING GOTO EVA
LUATION/

S$$BGT:	UFERR	3,S$$PGL	; FAILURE DURING GOTO EVALUATION
	PRGEND
	SUBTTL	S$$NFE FAILURE UNDER 'NOFAIL' ERROR EXIT

	ENTRY	S$$NFE
	EXTERN	S$$PGL
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JRST	S$$NFE	; CALLED BY FAILPOINT ROUTINE/

S$$NFE:	UFERR	13,S$$PGL	; FAILURE UNDER 'NOFAIL'
	PRGEND
	SUBTTL	S$$UDF UNDEFINED FUNCTION ERROR EXIT

	ENTRY	S$$UDF
	EXTERN	S$$PGL
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JRST	S$$UDF	; CALLED BY FCALV OR FCALN/

S$$UDF:	CFERR	5,S$$PGL	; UNDEFINED FUNCTION CALL
	PRGEND
	SUBTTL	S$$CPE COMPILATION ERROR EXIT

	ENTRY	S$$CPE
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	JSP	R12,S$$CPE	; EXECUTION OF STATEMENT WITH COMPI-
LATION ERROR/

S$$CPE:	UFERR	12,R12
	END