.TITLE	ARITHMETIC EXPRESSION COMPILER
/
/  19 FEB 74 (JAF,JAS) WORK ON ARITHMETIC STATEMENT FUNCTIONS
/   8 FEB 74 (JAF) IMPLEMENT ARITHMETIC STATEMENT FUNCTIONS
/  23 JUN 73 (PDH) ADD NEW ERRORS & EXPLANATIONS
/
/EXPRES - ROUTINE FOR COMPILING ARITHMETIC
/STATEMENTS.  ENTERED BY
/
/	LAW	CONTROL SWITCHES
/	JMS	EXPRES
/	.DSA	EXIT FOR TERMINATING COMMA
/	.DSA	EXIT FOR TERMINATING EQUALS SIGN
/	.DSA	EXIT FOR END OF STATEMENT
/	.DSA	EXIT FOR TERMINATING BRACKET
/
/
	.GLOBL	EXPRES,MODGET,OFFSET,TEMPS,SPOT2,AD2,CLEW2,CLRACC,CLRSUB
	.GLOBL	ACCSW,TEMPA2,PLXPIK,HIDCON
	.GLOBL	DTABLE,DTNEXT,SEARCH,FUNSW
	.GLOBL	GETCHI,VANTED,VANT1,SIGNER,WDSIZE
	.GLOBL	OTABLE,OTNEXT,CHIEND,CHINXT,ERRORS,ERRCP2
	.GLOBL	FLTFLG,INTAB,EQUVSW,FUNSW
	.GLOBL	TBPOSN,G.MOVE,EXCBIT,ARGCHN,SHOVE,PUNCH
	.GLOBL	GETOTB,DRESS,CLUES,OPCODE
	.GLOBL	OETAB,TWOT
	.GLOBL	OPLACE,CALCP,TBADDR,G.INIT
	.GLOBL	INTRSC,ARGCNT
	.GLOBL	ASFNUM,ASFOFF
	.GLOBL	START,TRACSW,LOCCNT,BASE3
	.GLOBL	INDEX,G.SCAN,PTABLE
/
EXPRES	XX
	AND	(17777	/REMOVE LAW BITS
	DAC	EXPSWT	/CONTROL BITS
	AND	(ASFBIT		/CHECK IF POSSIBLE ARITH. ST. FUNCTION
	SZA
	JMP	ISASF		/YES.
	LAC	CALCP		/NO.  REMOVE ASF TRAP DOORS.
	DAC	CALCPX
	DZM	ASFSET
/
ISASF	LAC*	CHIEND	/SET STARTING ADDRESSES
	DAC	VPL	/FOR WORK TABLES
	LAC*	DTABLE	/VPL - VARIABLE TABLE
	DAC	OPIT	/OPIT - OPERATOR TABLE
	LAC	(STES	/STPL - BRACKET LEVELS
	DAC	STPL	/SBINP-CONSTANT SUBSCRIPTS
	LAC	(SBINS+1
	DAC	SBINP
/
	DZM	ACCSW	/NOTHING IN ACC
	DZM	HELPER	/NOTHING HALF DEFINED
	DZM	WCOMSW	/NOT AT COMMA
	DZM	STES	/AT BASIC ARITH LEVEL
	DZM	NXSW	/ALLOW VARIABLE NAME
/
	LAC	(STATST
	JMS	OPPUT	/INSERT START OF LINE IN OP TABLE
	LAC	(ENDST	/IS THERE AN EXPRESSION
	SAD*	CHINXT
	JMP	ERAA0	/NO. ERROR, NULL EXPRESSION,MISSING CONSTANT
			/ VARIABLE, OR EXPRESSION
	JMP	LOK3	/YES
/
LOOK	JMS*	GETCHI	/GO GET NEXT CHARACTER
LOOK2	LAC	STPL
	TAD	LOOKER	/GO BACK IN LEVEL TABLE IF PREV CHAR  )
	DAC	STPL
LOK3	DZM	LOOKER	/RESET SO DON'T GO BACK NEXT TIME
	LAC	WCOMSW
	SMA!CLA!CMA		/NEW SUBSCRIPT? -1 TO AC
	JMP	DOT1	/NO
/
	DZM	WCOMSW	/CLEAR SWITCH
	TAD	SBINP	/GET ACC. FOR CONST. SUBSCRIPTS
	DAC	SBINP
	SAD	STPL	/IS TABLE FULL
	JMP	ERCP3	/YES
	DZM*	SBINP	/ZERO OUT BIN
/
DOT1	LAW	-AA
	TAD*	CHINXT
	SPA		/OPERATOR OR VARIABLE?
	JMP	LOOK3	/OPERATOR
	LAC	NXSW
	SZA		/
	JMP	ERAA1	/TWO VARIABLES IN ROW. ILLEGAL SYNTAX
	LAC	(AMPER
	SAD*	CHINXT	/ IS NEXT CHARACTER '&'
	JMP	STNBER	/ YES. MUST BE A STATEMENT NUMBER IN A CALL
	CLA		/ NO.
	JMS*	SEARCH	/PICK UP VARIABLE NAME OR CONSTANT
/
/MUST CHECK FOR SINGLE INTEGER AND COMPLEX
/CONSTANTS AS THEY ARE SPECIAL (UNPLEASANT) CASES.
/
	LAC*	FLTFLG	/GET MODE BITS
	SAD	(CONBIT+SINTGM
	JMP	INTEGR	/IT IS SINGLE INTEGER CONST.
	SAD	(CONBIT+REALM
	JMP	PLXCHK	/REAL CONSTANT, CHECK FOR COMPLEX
	SAD	(CONBIT+DBLEM
	JMP	PLXCHK	/DOUBLE CONSTANT, CHECK FOR COMPLEX
	AND	(CONBIT	/ TEST FOR LOGIC,CHARACTER
	SZA		/ AND TWO WORD INTEGER
	JMP	CALCAL	/ IT WAS
/
/HAVING EL'MATED SINGLE INTEGER CONSTANTS, & CHECKED FOR CHARACTER,REAL
/COMPLEX CONSTANTS, THE ITEM MAY BE CHECKED AGAINST
/THE SYMBOL TABLE.
/
	LAC	(VARIAB	/ SIGNIFIES WE ARE PASSING VARIABLE
	JMS*	CALCPX	/GO CHECK SYM. TABLE
	LAC*	TBPOSN	/CHASE DOWN A
	DAC	TBPOS	/LEVEL OF INDIRECT ADDRESS
	LAC	(1
	SAD*	INTAB
	JMP	L2	/WAS IN TABLE (INCLUDES DIMENSIONED VARIABLES)
	SAD*	EQUVSW
	JMP	L2	/WE'RE IN EQUIVALENCE
	SAD*	FUNSW	/WAS THERE A (
	JMP	L3	/ NEW FUNCTION NAME
	LAW	CALLSW	/ ARE WE IN A CALL STATEMENT
	AND	EXPSWT	/ CALLSW SET FOR PROCESSING SUBROUTINE NAME ONLY
	SZA
	JMP	SETFUN	/YES. NEW FUNCTION
	LAC*	TBPOS
	AND	(XTERNL	/IS THIS AN EXTERNAL ITEM
	SNA
	JMP	L2	/NO. NEW VARIABLE
/
SETFUN	LAW	-1
	TAD*	OPLACE	/INSERT ADDRESS OF
	DAC	SPOT	/FUNCTION NAME
	LAW	-2
	TAD	TBPOS	/SECOND WORD OF OTABLE
	XOR	(FROTB*100000	/ENTRY
	DAC*	SPOT
	JMS*	INTRSC
	XOR	(FUNBIT	/ RECORD PRESENCE
	JMS*	SHOVE
/
L2	LAW	DFNSW	/SHOULD ITEM BE DEFINED
	AND	EXPSWT
	SNA
	JMP	L2C	/NO
	ISZ	HELPER	/MARK AS POSSIBLE DEFINE
	XOR	EXPSWT	/REMOVE DEFINE BIT
	DAC	EXPSWT
	LAC	TBPOS	/SAVE ADDRESS OF VARIABLE
	DAC	GLORK	/FOR DEFINING LATER (MAYBE)
	JMP	L2A
/
/ FOUND AN '&' PROCESS THE STATEMENT NUMBER
STNBER	JMS*	GETCHI
	LAC	(INTGRS
	JMS*	SEARCH	/ PICK UP INTEGER STATEMENT
	LAC	(STNUM
	JMS*	CALCP	/ INSERT IN SYMBOL TABLE
	LAC	(STATNB
	DAC*	FLTFLG	/ MARK AS STATEMENT NUMBER
	LAC	(TRAN.
	JMP	L2X
/ MARKS VARIABLE AS USED
/
L2C	LAC	(USED
L2X	JMS*	SHOVE
L2A	LAC*	TBADDR	/PICK UP OBJECT TIME ADDRESS
	TAD	ASFSET		/ADD ASF OFFSET IF PRESENT
L2B	ISZ	VPL
	DAC*	VPL	/ADD TO V - TABLE
	ISZ	VPL
	JMS	CFUL	/CHECK IF TABLE OVERFLOW
	LAC*	FLTFLG
	DAC*	VPL	/ADD MODE BITS TO TABLE
	AND	(CONBIT!STATNB
	SZA
	JMP	FREE	/CONSTANTS AND STATEMENT NUMBERS
/
	LAC	(FORMAL!FUNBIT!DIMBIT!NOFUN
	AND*	TBPOS	/IS THIS FORMAL PARA, FUNCTION OR DIM
	SNA
	JMP	FREE	/SIMPLE VARIABLE
	SAD	(FORMAL!NOFUN
	JMP	L9A	/SIMPLE FORMAL PARAMETER
	SAD	(FUNBIT
	JMP	L4	/FUNCTION NAME
	SAD	(FORMAL!FUNBIT
	JMP	L4	/FORMAL PARAMETER USED AS FUNCTION NAME
	SAD	(FORMAL
	JMP	L8	/UNUSED FORMAL PARAMETER
	SAD	(DIMBIT!FORMAL
	SKP		/ DIMENSIONED FORMAL PARMETER
	JMP	L10	/ DIMENSIONED VARIABLE
/
/ DIMENSIONED VARIABLE AS ARGUMENT OF CALL
	LAC*	VPL
	XOR	(FORMAL	/ MARK AS FORMAL
	DAC*	VPL
/
/ IT IS A DIMENSIONED VARIABLE
/
L10	LAC	(SUBS*2
	JMS	FUNON	/CHECK IF FOLLOWED BY (
/
/MUST BE ARGUMENT OF CALL OR I/O
/
	LAC	(DIMMEN	/INDICATE ARRAY NAME
LXX	XOR*	VPL
	DAC*	VPL
	JMP	FREE
/
/FUNCTION NAME AS ARGUMENT OF CALL
/
L5	LAC*	TBPOS
	AND	(XTERNL!FORMAL	/WAS IT EXTERNAL OR FORMAL
			/PARAMETER
	SNA
	JMP	ERAA6	/ILLEGAL USE OF FUNCTION
	LAC	(FUNCAL	/INDICATE FUNCTION NAME
	JMP	LXX
/
/ CHECK IF FUNCTION FOLLOWED BY '('
FUNON	XX
	XOR*	FUNSW	/LAST BIT WAS ZERO
	CLL!RAR		/FUNSW NOW IN LINK
	SNL!CLL
	JMP*	FUNON	/NAME NOT FOLLOWED BY (
	DAC*	CHINXT	/CHANGE ( TO F( OR S(
/ CLEAR ACC IF FUNCTION CALL
	XOR	(STORE*M\FUNS
	SAD	(STORE*M
	JMS	TEMPAC	/ NOTE L=0 FROM ABOVE
FREE	LAC	(PVAR
	JMS	OPPUT
	JMP	NXT1
/
/FORMAL PARAMETER - MUST DECIDE IF VARIABLE OR
/FUNCTION NAME
/
L8	LAW	CALLSW	/CHECK IF USED AS
	AND	EXPSWT
	TAD*	FUNSW	/A FUNCTION NAME
	SNA
	JMP	L9	/NO
	LAC	(FUNBIT	/INDICATE FUNCTION
	JMS*	SHOVE
/
/  FUNCTION NAME
/
L4	LAC	(FUNS*2
	JMS	FUNON	/CHECK FOR (
	LAW	CALLSW	/ THE ONLY PLACE A FUNCTION MAY APPEAR WITHOUT
	AND	EXPSWT	/ A '(' IS AS AN ARGUMENT!
	SNA
	JMP	L5	/MUST BE AN ARGUMENT
/
/SEEMS TO BE A NO ARGUMENT CALL
/
	XOR	EXPSWT	/ REMOVE CALLSW BIT SO
	DAC	EXPSWT	/ THAT ONLY 1 CALL POSSIBLE
	LAC	(PVAR
	JMS	OPPUT	/ FUDGE UP A NO-ARGUMENT
	DZM	COUNT	/ FUNCTION CALL AND GO
	JMP	FUNTIE	/ COMPILE IT
/
/ FORMAL PARMETER MUST BE VARIABLE
/
L9	LAC	(NOFUN	/ MARK AS A VARIABLE
	JMS*	SHOVE
L9A	LAC	(FORMAL
	JMP	LXX
/
L3	LAW	LHSSW	/CHECK IF ON LEFT HAND
	AND	EXPSWT	/SIDE OF ARITH STATEMENT
	SNA
	JMP	SETFUN	/NO
	LAC*	OPIT
	SAD	(STATST	/IS IT FIRST ITEM
	SKP
	JMP	SETFUN	/NO
/
/EITHER ARITHMETIC STATEMENT FUNCTION OR ERROR
/
	LAC*	START		/CHECK IF ANY EXECUTABLE CODE HAS
	CMA			/BEEN COMPILED
	TAD*	LOCCNT
	TAD*	TRACSW
	SAD	(1
	JMP	LEGASF		/NO.  ASF IS LEGAL.
/
INTEGR	LAC*	STPL	/ CHECK IF WE ARE AT SUBSCRIPT LEVEL
	XOR	(400000
	SZA
	JMP	CALCAL	/ NOT SUBCRIPTING, ENTER INTEGER IN SYMBOL TABLE
	LAC	(CONBIT
	DAC*	FLTFLG	/ MARK AS SPECIAL INTEGER CONSTANT
	LAC*	VANTED	/PICK UP INTEGER
	JMP	L2B
/
/HAVE REAL OR DOUBLE CONSTANT, CHECK FOR COMPLEX
/
PLXCHK	LAC*	CHINXT
	SAD	(COMMA	/IS NEXT CHARACTER COMMA
	SKP!CLL!CML		/YES MAY BE COMPLEX
	JMP	CALCAL	/NO. IT IS NOT COMPLEX
/
/CHECK IF PRECEDING CHARACTERS ARE ( (+ (-
/LINK HAS BEEN SET TO 1 FOR POSSIBLE MINUS SIGN
/
	LAC*	OPIT	/GET PREVIOUS OPERATOR
	SAD	(MINUS
	JMP	MAY	/ODDS OF COMPLEX IMPROVING
	CLL		/INDICATE POSITIVE CONST.
	SAD	(PLUS
	JMP	MAY
	SAD	(OPEN
	JMP	ISPLX	/IT IS COMPLEX!
CALCAL	LAC	(CONST	/ INSERT CONSTANT INTO SYMBOL TABLE
	JMS*	CALCP
	JMP	L2A
/
MAY	LAC	(1	/GET SECOND LAST
	JMS	OPGET	/OPERATOR (DOES NOT CHANGE LINK)
	SAD	(OPEN
	SKP!CLA!RAL		/IT IS COMPLEX. SIGN TO AC17
	JMP	CALCAL	/IT IS NOT COMPLEX
	ISZ	OPIT	/THROW AWAY +- SIGN
/
	XOR*	VANTED	/AND CHANGE SIGN
	DAC*	VANTED	/OF CONSTANT IF IT WAS -
ISPLX	JMS	PLXPIK	/ PICK UP THE REST OF COMPLEX CONSTANT
	JMP	CALCAL	/ STORE IT AWAY.
/
/
/ SUBROUTINE TO PICK UP IMAGINARY PART OF COMPLEX CONSTANT
PLXPIK	XX
	JMS*	GETCHI	/ THROW AWAY COMMA
/
/ MOVE CONSTANT OUT OF VANTED & GO
/COLLECT ANOTHER CONSTANT
/
	LAW	-4	/SAVE CONSTANT
	JMS*	G.MOVE
	TAD	VANTED
	TAD	(WANTED
	LAC*	FLTFLG	/ SAVE MODE SO SEARCH DOES'T CLOBBER IT
	DAC	MODSAV
	LAW	CONSTN!SIGNER
	JMS*	SEARCH	/GET SECOND CONST.
	LAC	MODSAV
	SAD*	FLTFLG	/CHECK THAT MODES MATCH
	SKP!CLL!CML		/SET LINKS =4 WORDS FOR LATER
	JMP	ERAB0	/THEY DON'T. ERROR
	SAD	(CONBIT+REALM
	JMP	SIGPLX
	SAD	(CONBIT!DBLEM
	SKP
	JMP	ERAB0
	LAC	(CONBIT+DCMPXM	/LEAVE LINK =4 WORDS
PLXTE2	DAC*	FLTFLG	/SET MODE INDICATOR
	CLA		/EST START LOCATION
	RTL		/ 0 OR 2 TO AC
	TAD	(WANTED+2	/OF IMAG IN WANTED
	DAC	X4	/STORE IN X4
/
/
	LAW	-4	/SPLICE
	JMS*	G.MOVE	/CONSTANTS
	TAD	VANTED	/TOGETHER
	TAD	X4
	LAW	-10	/PUT	 ( 8 DEC. )
	JMS*	G.MOVE	/CONSTANT
	TAD	(WANTED	/IN
	TAD	VANTED	/VANTED
	LAC*	CHINXT	/CHECK THAT )
	SAD	(CLOSE	/FOLLOWS CONSTANT
	JMP*	PLXPIK	/OK. THERE IS ONE.
/
/  ****ERROR AB1 - COMPLEX CONSTANT NOT TERMINATED WITH A ')'
/
ERAB1	JMS*	ERRORS
	.SIXBT	'AB1'
/
SIGPLX	DZM	WANTED+6	/REMOVE THE GARBAGE
	DZM	WANTED+7
	CLL		/CLEAR LINK=2 WORDS
	LAC	(CONBIT+CMPLXM
	JMP	PLXTE2
/
/COME HERE WHEN OPERATOR FOUND. CONVERT OPERATOR
/TO ARITHMETIC FORM, AND BRANCH TO CORRECT
/ROUTINE FOR THE OPERATOR.
/
LOOK3	DZM	NXSW	/ INDICATE NEXT ITEM MAY BE VARIABLE
	LAC*	CHINXT	/ GET OPERATOR
	DAC	OPER1	/SAVE FOR LATER
	SAD	(FUNS
	JMP	IOA	/FUNCTION(
	SAD	(SUBS
	JMP	I1SNB	/SUBSCRIPTED VARIABLE
	SAD	(OPEN
	JMP	IO	/ (
	SAD	(CLOSE
	JMP	REMIT	/ )
	SAD	(COMMA
	JMP	COMMAS	/ ,
	JMP	LOOK4	/ +,-,*,/,.AND.,ETC, = , END-OF-STATEMENT
/
/
/
I1SNB	LAC*	VPL	/ IF FORMAL VARIABLE MARK AS SO
	AND	(FORMAL
	SZA
	LAC	(040000
	XOR	(400000	/ MARK AS SUBSCRIPT (
	DAC	WCOMSW	/SET SWITCH TO SET UP SUBSCRIPT BIN
	JMP	IOB
/
IOA	LAW	CALLSW	/FUNCTION ( FOUND
	AND	EXPSWT
	SNA		/IS IT A CALL
	JMP	IOBA	/NO
IOA1	LAC	EXPSWT	/YES
	AND	(777777\CALLSW	/ PERMIT ONLY ONE CALL
	DAC	EXPSWT
	LAC	(300000	/SET FOR START OF CALL
	JMP	IOB
IOBA	LAC*	VPL	/ INDICATE RESULT WILL BE IN ACCUMULATOR
	XOR	(INACC	/ AFTER FUNCTION EVALUATION
	DAC*	VPL
	LAC	(100000	/ INDICATE FUNCTION
	JMP	IOB
/
IO	CLA		/ ( FOUND
IOB	ISZ	STPL	/STEP TO NEXT ARITH LEVEL
	DAC*	STPL	/AND INDICATE TYPE
	LAC	STPL
	SAD	(SBINP
	JMP	ERCP5	/CHECK FOR TABLE OVERFLOW
	JMP	LOOK4
/
/
/
COMMAS	LAC*	STPL	/COMMA FOUND
	DAC	WCOMSW	/SAVE SUBSCRIPT INDICATOR
	JMP	LOOK1
/
REMIT	LAW	-1	/ ) FOUND. PREPARE TO STEP
	DAC	LOOKER	/DOWN STES.
LOOK1	LAW	-PVAR	/GET LAST OPERATOR. IT
	TAD*	OPIT	/MUST BE VARIABLE BEFORE , OR )
	SMA!SZA
	JMP	ERAA2
/
LOOK4	LAC	OPER1	/PUT OPER1 IN OP. TABLE
	JMS	OPPUT
LOOK5	LAC	(1	/GET PREVIOUS OPERATOR
	JMS	OPGET
	TAD	(-PVAR	/IS IT A VARIABLE INDICATOR
	SMA!SZA!CLL
	JMP	TWOOP	/NO. TWO SUCCESSIVE OPERATORS
/
/LOOK UP CLUE DIGIT IN OPTAB
/
	LAC	OPER	/GET +V OR -V
	TAD*	OPIT	/ADD 2*FILE INDEX
	TAD*	OPIT
	MUL
ROWLEN=COMMA-NVAR+1
	.DSA	ROWLEN	/LENGTH OF ROW
	LAC	(2
	JMS	OPGET	/ROW INDEX
	LACQ
	TAD	OPER	/ADD ROW INDEX/
GLOP=2*SUBS+NVAR*ROWLEN+NVAR
	TAD	(-GLOP	/ADJUSTMENT
	JMS	OPA
	TAD	OETAB	/SELECT CLUE DIGIT
PARTER	TAD	(JMP* OPDSA
	DAC	.+1
	XX		/N-WAY PART ON CLUE DIGIT
/
/TWO OPERATORS WITH NO VARIABLE BETWEEN. FIRST
/OPERATOR DEFINES ROW IN TWOT, SECOND DEFINES
TWOOP	LAC*	OPIT
	MUL
ROWLEN=COMMA-STATST+1
	.DSA	ROWLEN	/LENGTH OF ROW
	LACQ
	TAD	OPER
GLOP=OPEN*ROWLEN+STATST
	TAD	(-GLOP
	JMS	OPA
	TAD	TWOT	/ADDRESS OF TWO OPERATOR CLUE TABLE
	JMP	PARTER
/
OPDSA	.DSA	ERAA3	/  0
	.DSA	XP1	/  1 ( +V )
	.DSA	XP2	/  2 ( -V )
	.DSA	XP3	/  3 -^ -V F
	.DSA	XP4	/  4 -^ +V F
	.DSA	XP5	/  5 ^ -V F
	.DSA	XP6	/  6 ^ +V F
	.DSA	XP7	/  7 / -V F
	.DSA	XP8	/  8 / +V F
	.DSA	XP9	/  9 * -V F
	.DSA	XP10	/ 10 * -V L
	.DSA	XP11	/ 11 * +V F
	.DSA	XP12	/ 12 * +V L
	.DSA	XP13	/ 13 -V +V F
	.DSA	XP14	/ 14 -V +V L
	.DSA	XP15	/ 15 +V -V F
	.DSA	XP16	/ 16 +V -V L
	.DSA	XP17	/ 17 +V +V L,-V -V L
	.DSA	XP18	/ 18 +V +V F,-V -V F
	.DSA	REL1	/ 19 < -V F
	.DSA	REL2	/ 20 GE -V F
	.DSA	REL3	/ 21 < +V F
	.DSA	REL4	/ 22 GE +V F
	.DSA	REL5	/ 23 > -V F
	.DSA	REL6	/ 24 LE -V F
	.DSA	REL7	/ 25 > +V F
	.DSA	REL8	/ 26 LE +V F
	.DSA	REL9	/ 27 EQ +V F
	.DSA	REL10	/ 28 NE +V F
	.DSA	REL11	/ 29 EQ -V F
	.DSA	REL12	/ 30 NE -V F
	.DSA	LOGC8	/ 31 AND -V F
	.DSA	LOGC7	/ 32 AND -V L
	.DSA	LOGC6	/ 33 AND +V F
	.DSA	LOGC5	/ 34 AND +V L
	.DSA	LOGC4	/ 35 OR -V F
	.DSA	LOGC3	/ 36 OR -V L
	.DSA	LOGC2	/ 37 OR +V F
	.DSA	LOGC1	/ 38 OR +V L
	.DSA	XP39	/ 39 + -V F,- +V F
	.DSA	XP40	/ 40 + +V F,- -V F
	.DSA	XP41	/ 41 NOT -V F
	.DSA	XP42	/ 42 NOT +V F
	.DSA	XP43	/ 43 F(-V, S(-V,  ,-V, F(-V) S(-V),-V)
	.DSA	XP44	/ 44 F(+V, S(+V, ,+V,
	.DSA	XP45	/ 45 F(+V) S(+V) ,+V)
	.DSA	SCRIPT	/ 46   , )   S( )
	.DSA	ENDS	/ 47 -- END OF LINE
	.DSA	ERAA3	/ 48 SHOULD NEVER OCCUR
	.DSA	LOOK	/ 49 LEGAL, NOT YET COMPILEABLE
	.DSA	XP50	/ 50 -V  END OF LINE
			/
/
/THIS ROUTINE SELECTS THE N-TH BYTE OUT OF A
/TABLE. THREE BYTES PER WORD ENTRY
/
/	LAC	(N
/	JMS	OPA
/	TAD	(TABLE ADDRESS          / IF LOCAL
/	TAD	TABLE ADDRESS         / IF GLOBL
/	NEXT	INSTRUCTION
/
/ IT LEAVES THE SELECTED BYTE IN THE AC
/
OPA	XX
	IDIV!GS
	.DSA	3	/THREE BYTES PER WORD
	RTR		/IF L=1, NO SHIFT REQUIRED
	DAC	WORK1	/ADJUSTED REMAINDER
	LACQ
	XCT*	OPA	/CALC. POSITION IN CLUE TABLE
	DAC	WORK2
	LAC*	WORK2	/GET CLUE BYTES
	SZL!CLL
	JMP	.+5	/RIGHT HAND BYTE
	LRS	6	/SHIFT RIGHT ONE BYTE
	XOR	WORK1	/IF BIT 0 IS 1, OK
	SMA
	LRS	6	/SHIFT RIGHT ONE BYTE
	AND	(77	/AT LAST! CLUE DIGIT
	ISZ	OPA	/GET RETURN ADDRESS
	JMP*	OPA
/
/ ENTER HERE FOR (+V)
/
XP1	ISZ	OPIT	/DELETE )
	LAC*	OPIT	/PICK UP VARIABLE CODE
	ISZ	OPIT	/STEP TO (
	DAC*	OPIT	/INSERT VARIABLE CODE
NXTCK	JMS*	GETCHI	/GET NEXT SYMBOL
NXT1	LAW	1
	DAC	NXSW	/FORCE IT TO BE OPERATOR
	JMP	LOOK2
/
/ ENTER HERE FOR ( -V )
/
XP2	ISZ	OPIT	/REMOVE  )
	JMS*	GETCHI	/GET NEXT SYMBOL
	SAD	(ARROW
	JMP	MATE2	/IT IS ^
	LAC*	OPIT
MATE3	ISZ	OPIT
	DAC*	OPIT	/REPLACE ( BY VARIABLE
	JMP	NXT1
/
MATE2	LAC	(NARROW	/CONVERT TO -^
	DAC*	CHINXT
	LAC	(PVAR	/-V REPLACED BY +V
	JMP	MATE3
/
/ * +V L
/
XP12	LAW	EXTRA!LOGILL!CHRILL
	SKP
/ * +V F
/
XP11	LAW	TOACC!EXTRA!LOGILL!CHRILL
FIVEB	JMS	GENRAT
	.DSA	MULT*M+MULT
/
/ * -V L
/
XP10	LAW	COMP!EXTRA!LOGILL!CHRILL
	JMP	FIVEB
/
/ * -V F
/
XP9	LAW	TOACC!COMP!EXTRA!LOGILL!CHRILL
	JMP	FIVEB
/
/ / +V F
/
XP8	LAW	TOACC!EXTRA!LOGILL!CHRILL
	SKP
/
/ / -V F
/
XP7	LAW	TOACC!COMP!EXTRA!LOGILL!CHRILL
	JMS	GENRAT
	.DSA	DIVV*M+RDIV
/
/ ^ +V F
/
XP6	LAW	TOACC!EXTRA!LOGILL!CHRILL
	JMS	GENRAT
	.DSA	EXP*M+REXP
/
/ ^ -V F
/
XP5	LAW	TOACC!EXTRA!LOGILL!CHRILL
	JMS	GENRAT
	.DSA	EXPN*M+REXPN
/
/ -^ +V F
/
XP4	LAW	TOACC!EXTRA!LOGILL!CHRILL
	JMS	GENRAT
	.DSA	NEXP*M+RNEXP
/
/ -^ -V F
/
XP3	LAW	TOACC!EXTRA!LOGILL!CHRILL
	JMS	GENRAT
	.DSA	NEXPN*M+RNEXPN
/
/
/ +V +V F  OR -V -V F
/
XP18	LAW	TOACC!SUBCHK!LOGILL!CHRILL
	SKP
/
/ +V +V L  OR -V -V L
/
XP17	LAW	SUBCHK!LOGILL!CHRILL
	JMS	GENRAT
	.DSA	ADDD*M+ADDD
/
/ COMPILE +V -V L IF NECESSARY
/
XP16	LAW	SUBCHK!LOGILL!CHRILL
	SKP
/
/ COMPILE  +V -V F
/
XP15	LAW	TOACC!SUBCHK!LOGILL!CHRILL
	JMS	GENRAT
	.DSA	SUB*M+RSUB
/
/ COMPILE  -V +V L	IF NECESSARY
/
XP14	LAW	DPVAR!SUBCHK!LOGILL!CHRILL
	SKP
/
/ COMPILE  -V  +V  F
/
XP13	LAW	DPVAR!TOACC!SUBCHK!LOGILL!CHRILL
	JMS	GENRAT
	.DSA	RSUB*M+SUB
/
/THIS SECTION COMPILES THE LOGICAL
/OPERATIONS   .AND.  AND   .OR.
/
/
/   .OR.	 +V  L
/
LOGC1	LAW	TWOVAR!DPVAR!EXTRA!CPXILL!RELILL!INTILL!CHRILL
	SKP
/
/  .OR.  +V  F
/
LOGC2	LAW	TWOVAR!TOACC!DPVAR!EXTRA!CPXILL!RELILL!INTILL!CHRILL
	JMS	GENRAT
	.DSA	ORE*M+ORE
	.DSA	RORN*M+ORN
/
/  .OR.  -V  L
/
LOGC3	LAW	TWOVAR!EXTRA!CPXILL!RELILL!INTILL!CHRILL
	SKP
/
/  .OR.  -V  F
/
LOGC4	LAW	TWOVAR!TOACC!EXTRA!CPXILL!RELILL!INTILL!CHRILL
	JMS	GENRAT
	.DSA	ORN*M+RORN
	.DSA	ANDD*M+ANDD
/
/   .AND.   +V  L
/
LOGC5	LAW	TWOVAR!EXTRA!CPXILL!RELILL!INTILL!CHRILL
	SKP
/
/  .AND.	+V  F
/
LOGC6	LAW	TWOVAR!TOACC!EXTRA!CPXILL!RELILL!INTILL!CHRILL
	JMS	GENRAT
	.DSA	ANDD*M+ANDD
	.DSA	ORN*M+RORN
/
/   .AND	-V   L
/
LOGC7	LAW	TWOVAR!DNVAR!EXTRA!CPXILL!RELILL!INTILL!CHRILL
	SKP
/
/   .AND	-V   F
/
LOGC8	LAW	TWOVAR!DNVAR!TOACC!EXTRA!CPXILL!RELILL!INTILL!CHRILL
	JMS	GENRAT
	.DSA	RORN*M+ORN
	.DSA	ORE*M+ORE
/
/THIS SECTION OF THE COMPILER HANDLES
/THE RELATIONAL OPERATORS
/   .GT. ,.LT.  .GE.  .LE.  .EQ.  .NE.
/USING ENTRIES TO SIX SUBROUTINES
/
/  GT   FOR   A.GT.B
/  LT   FOR   A.LT.B
/  GTN  FOR   A.GT.-B
/  LTN  FOR   A.LT.-B
/  EQL   FOR   A.EQ.B
/  EQLN  FOR   A.EQ.-B
/  ALL OTHER COMBINATIONS OF OPERATORS
/AND NEGATIVE VARIABLES CAN BE
/REDUCED TO ONE OF THESE BY ALLOWING
/COMPLEMENTED RESULTS TO BE GENERATED
/FOR THE LE, GE, AND NE OPERATORS.
/
/
/  < -V F
/
REL1	LAW	TWOVAR!RELATN!TOACC!DPVAR!EXTRA!CPXILL!LOGILL
	SKP
/
/  .GE.  -V  F
/
REL2	LAW	TWOVAR!RELATN!TOACC!DNVAR!EXTRA!CPXILL!LOGILL
	JMS	GENRAT
	.DSA	LTN*M+LTN
	.DSA	GT*M+LT
/
/  <  +V	F
/
REL3	LAW	TWOVAR!RELATN!TOACC!DPVAR!EXTRA!CPXILL!LOGILL
	SKP
/
/  .GE.	+V   F
/
REL4	LAW	TWOVAR!RELATN!TOACC!DNVAR!EXTRA!CPXILL!LOGILL
	JMS	GENRAT
	.DSA	LT*M+GT
	.DSA	GTN*M+GTN
/
/  >  -V	F
/
REL5	LAW	TWOVAR!RELATN!TOACC!DPVAR!EXTRA!CPXILL!LOGILL
	SKP
/
/  .LE.  -V  F
/
REL6	LAW	TWOVAR!RELATN!TOACC!DNVAR!EXTRA!CPXILL!LOGILL
	JMS	GENRAT
	.DSA	GTN*M+GTN
	.DSA	LT*M+GT
/
/	>	+V	F
/
REL7	LAW	TWOVAR!RELATN!TOACC!DPVAR!EXTRA!CPXILL!LOGILL
	SKP
/
/	.LE.	+V	F
/
REL8	LAW	TWOVAR!RELATN!TOACC!DNVAR!EXTRA!CPXILL!LOGILL
	JMS	GENRAT
	.DSA	GT*M+LT
	.DSA	LTN*M+LTN
/
/	.EQ.	+V	F
/
REL9	LAW	TWOVAR!RELATN!TOACC!DPVAR!EXTRA!LOGILL
	SKP
/
/	.NE.	+V	F
/
REL10	LAW	TWOVAR!RELATN!TOACC!DNVAR!EXTRA!LOGILL
	JMS	GENRAT
	.DSA	EQL*M+EQL
	.DSA	EQLN*M+EQLN
/
/	.EQ.	-V	F
/
REL11	LAW	TWOVAR!RELATN!TOACC!DPVAR!EXTRA!LOGILL
	SKP
/
/	.NE.	-V	F
REL12	LAW	TWOVAR!RELATN!TOACC!DNVAR!EXTRA!LOGILL
	JMS	GENRAT
	.DSA	EQLN*M+EQLN
	.DSA	EQL*M+EQL
/
/  THIS SECTION REDUCES THE EXPRESSIONS
/
/    +	-V  L	TO	-V  L  (XP39)
/    -	+V  L	TO	-V  L  (XP39)
/    +	+V  L	TO	+V  L  (XP40)
/    -	-V  L	TO	+V  L  (XP40)
/  .NOT.	-V  L	TO	+V  L  (XP41)
/  .NOT.	+V  L	TO	-V  L  (XP42)
/
/  PROVIDED THE MODE OF THE VARIABLE IS COMPATABLE
/  WITH THE LEADING ARITHMETIC OPERATOR
/
XP39	LAW	DNVAR!LOGILL
	JMP	ATE
/
XP40	LAW	DPVAR!LOGILL
	JMP	ATE
/
XP41	LAW	DPVAR!CPXILL!RELILL!INTILL!CHRILL
	SKP
/
XP42	LAW	DNVAR!CPXILL!RELILL!INTILL!CHRILL
ATE	AND	(17777	/ REMOVE LAW BITS
	DAC	OPS	/ SAVE IN OPS
	LAC*	VPL	/ GET CLUE BITS
	JMS	CHKMOD	/ CHECK THE MODES
ELIM1	LAC*	OPIT	/GO DELETE THE +V OR -V
	JMP	ELIMAT	/AND OVERWRITE THE +,-,.NOT.
/
/  COMPILE -V , ENDST
/
XP50	LAC	(INVERT	/ INDICATE THE RESULT NEEDS
	XOR*	VPL	/ COMPLEMENTING
	DAC*	VPL	/ NOW LEAVE
/
/ INSERT FINAL RESULT INTO AD2
/
ENDS	LAC*	VPL
	DAC	AD2+1	/ CLUE BITS
	LAW	-1
	TAD	VPL
	DAC	AD2
	LAC*	AD2
	DAC	AD2	/ OTABLE ADDRESS
/
/ CHECK IF IT WAS A SIMPLE VARIABLE AND SHOULD BE DEFINED
/
	LAC	HELPER	/ CHECKS IF DEFINITION 
	SNA		/ WAS REQUESTED
	JMP	END2	/ NO
	LAC	AD2+1
	AND	(INACC!CONBIT!INVERT	/ CHECK IF CONSTANT
	SZA		/ OR EXPRESSION
	JMP	END3
	LAC*	GLORK
	AND	(777777\DEFIND	/ INSERT DEFIND BIT
	XOR	(DEFIND	/ INTO SYMBOL TABLE
	DAC*	GLORK
/
/  ROUTINE FOR EVALUATING PROPER EXIT OUT OF EXPRES
/
/  EXIT1  TERMINATING ,
/  EXIT2       "      =
/  EXIT3       "      ;
/  EXIT4       "      )
/
END2	LAW	-COMMA
	TAD*	OPIT
	TAD	EXPRES
	DAC	EXPRES
	LAC*	EXPRES
	DAC	EXPRES
	LAW	NOSTEP
	AND	EXPSWT
	SNA		/ TO STEP OR NOT TO STEP PAST TERMINATOR
	JMS*	GETCHI	/ DO IT.
	JMP*	EXPRES
/
/ THIS SECTION CHECKS IF AN EXPRESSION OR CONSTANT IS PERMISSABLE
END3	SAD	(CONBIT
	JMP	END4	/ IT IS A CONSTANT
	LAW	EXPILL
	AND	EXPSWT	/ CHECK THAT EXPRESSIONS ARE PERMISSIBLE
	SNA
	JMP	END2
/
/  ****ERROR AB5 - EXPRESSION WHERE VARIABLE OR CONSTANT IS REQUIRED
/
ERAB5	JMS*	ERRORS
	.SIXBT	'AB5'	/ ILLEGAL EXPRESSION
/
END4	LAW	CONILL
	AND	EXPSWT	/CHECK THAT CONSTANTS ARE PERMISSIBLE
	SNA
	JMP	END2
/
/  ****ERROR AB4 - CONSTANT WHERE VARIABLE OR EXPRESSION IS REQUIRED
/
ERAB4	JMS*	ERRORS
	.SIXBT	'AB4'	/ILLEGAL CONSTANT
/  THIS SECTION GENERATES THE COMPILED INSTRUCTIONS
/
GENRAT	XX
	JMS	COLECT	/GO GET VARIABLES
	LAW	TWOVAR
	AND	OPS	/THERE IS AN
	SNA		/OPCODE CHANGE IF
	JMP	.+5	/SECOND LAST VARIABLE
	LAC	(3	/IS NEGATIVE, ADJUST
	JMS	OPGET	/THE OPCODE POINTER
	SAD	(NVAR
	ISZ	GENRAT
/
	LAC	AD1+1	/IS AD1 IN ACC
	AND	(INACC
	SNA
	JMP	NUMTWO	/NO
	LAC	AD2	/YES
	DAC*	DRESS	/ADDRESS
	LAC	AD2+1
	DAC*	CLUES	/CLUE BITS
	LAC*	GENRAT
GENRT2	AND	(770000
	DAC*	OPCODE	/OPERATION CODE
	JMS*	 PUNCH	/WRITE IT OUT
/
/ "MODTAB" TABLE LOOKUP
/ ASSIGN MODE (AD1),MODE (AD2) TO OTHER ( I ), J SUCH
/ THAT I>J
/
	JMS	MODGET
	DAC	J	/ASSUME "OTHER" LARGER
	LMQ		/SAVE THIS IN CASE WRONG
	CMA!CLL!CML
	TAD	OTHER	/IF "OTHER" > J, L_0
	LAC	OTHER
	SNL!CLL!CML	/SET L=1 FOR MULS
	JMP	.+4
	DAC	J	/REVERSE INITIAL
	LACQ		/ASSUMPTION
	DAC	OTHER
	LAW	-32	/-25 (DEC) IN 1'S COMPLEMENT
	ADD	J	/L STAYS 1
	MULS		/L=1 => -J*(J-31+1)
J	XX
	LACQ
	CLL!RAR		/DIVIDE BY 2
	TAD	OTHER
	TAD	(-15	/(I-13)+J(25-J)/2 (DECIMAL)
/
/  DATA IS PACKED 3 PER WORD IN TABLE
/
	JMS	OPA	/PULL OUT THE RIGHT WORD
	TAD	(MODTAB
/
	SNA
	JMP	ERAA9	/ILLEGAL MIXED MODE
	XOR	(INACC	/STORE MODE IN
	DAC*	VPLB	/STRING
/
	LAW	RELATN	/FOR RELATIONAL OPERATORS
	AND	OPS	/MUST INSERT LOGIC
	SNA
	JMP	.+3
	LAC	(INACC+LOGICM
	DAC*	VPLB
/
	LAC	VPLB
	DAC	VPL	/RESET LIST POINTER
	DAC	ACCSW	/RECORD ACC. POSITION
/
	LAW	EXTRA	/CHECK IF ONE OR TWO
	AND	OPS	/OP CODES ARE TO BE DELETED
	SNA
	JMP	ELIM1	/ONE ONLY
	LAC*	OPIT	/TWO PLEASE
	ISZ	OPIT
ELIMAT	ISZ	OPIT
	DAC*	OPIT
/
/  THE FOLLOWING SECTON SETS THE STATE (NEG. OR POS.)
/  OF THE LAST VARIABLE TO THE DESIRED STATE, AS
/  EXPRESSED BY THE FOLLOWING CONTROL BITS:
/
/	DNVAR - SET STATE NEGATIVE
/	COMP  - COMPLEMEMT STATE
/	DPVAR = DNVAR & COMP
/	M=10,000
/
CLRTIE	LAC	(1
	JMS	OPGET	/POINT AT LAST VARIABLE
	LAW	DNVAR
	AND	OPS	/SHOULD IT BE MADE NEG.
	SNA
	JMP	.+3	/NO
	LAC	(NVAR	/YES
	DAC*	OPADR	/DO SO
	LAW	COMP
	AND	OPS	/SHOULD IT BE COMPLEMENTED
	SNA
	JMP	LOOK5	/NO
	LAC	(PVAR	/YES
	SAD*	OPADR	/IS IT +V
	LAC	(NVAR	/YES.  CONVERT IT TO -V
	DAC*	OPADR	/STORE COMPLEMENTED VARIABLE
	JMP	LOOK5
/
NUMTWO	LAC	AD1	/AD2 IN ACC
	DAC*	DRESS	/ADDRESS
	LAC	AD1+1
	DAC*	CLUES	/CLUE BITS
	LAC*	GENRAT
	ALS	14	/GET REVERSED OPERATION
	JMP	GENRT2
/
/  MODE CONTROL TABLE - UPPER TRIANGLE 12*12 MATRIX - 3 ITEMS/WORD
/     N=100
MODTAB	.DSA	LOGICM*N+0*N+0
	.DSA	0
	.DSA	0
	.DSA	CHARM
	.DSA	SINTGM*N+DINTGM*N+UNKNOW
	.DSA	REALM*N+DBLEM*N+NINTM
	.DSA	DNINTM*N+CMPLXM*N+UCMPXM
	.DSA	DCMPXM*N+CHARM*N+DINTGM
	.DSA	UNKNOW*N+REALM*N+DBLEM
	.DSA	NINTM*N+DNINTM*N+CMPLXM
	.DSA	UCMPXM*N+DCMPXM*N+CHARM
	.DSA	UNKNOW*N+NINTM*N+DNINTM
	.DSA	NINTM*N+DNINTM*N+UCMPXM
	.DSA	UCMPXM*N+DCMPXM*N+CHARM
	.DSA	REALM*N+DBLEM*N+NINTM
	.DSA	DNINTM*N+CMPLXM*N+UCMPXM
	.DSA	DCMPXM*N+CHARM*N+DBLEM
	.DSA	DNINTM*N+DNINTM*N+DCMPXM
	.DSA	DCMPXM*N+DCMPXM*N+CHARM
	.DSA	NINTM*N+DNINTM*N+UCMPXM
	.DSA	UCMPXM*N+DCMPXM*N+CHARM
	.DSA	DNINTM*N+DCMPXM*N+DCMPXM
	.DSA	DCMPXM*N+CHARM*N+CMPLXM
	.DSA	UCMPXM*N+DCMPXM*N+0
	.DSA	UCMPXM*N+DCMPXM*N+0
	.DSA	DCMPXM*N+0*N+CHARM
/
/
/
/
/  THE COMPILING OF FUNCTION CALLS & SUBSCRIPTS
/
/  F( -V ,  OR  S( -V ,  OR  , -V ,
/  F( -V )  OR  S( -V )  OR  , -V )
/
XP43	JMS	FUNSUB	/GET CLUE BITS
	XOR	(TOACC!DPVAR	/CLEAR ACC & FORCE ARG. TO ACC
	JMS	COLECT
	JMS	CLEAR	/GET +V AND GO TO LOOK5
	JMP	CLRTIE
/
/  F( +V ,  OR  S( +V ,  OR  , +V ,
/
XP44	JMS	FLUSH
	JMP	LOOK
/
/ F(+V)  S( +V )  OR  , +V )
/
XP45	JMS	FLUSH
/
/  MUST NOW DECIDE IF SUBPROGRAM CALL OR SUBSCRIPT
/
	LAC*	STPL	/TEST ARITH LEVEL
	SPA!CLL		/SET L=0 FOR JMS TEMPAC
	JMP	SCRIPT	/IT IS SUBSCRIPTING
/
/ COMPILE A SUBPROGRAM CALL
/
	LAC	(STORE*M
	JMS	TEMPAC
	LAC	(COMMA	/PREPARE TO COUNT ARGS
	DZM	COUNT
	ISZ	OPIT	/DELETE ) OR ,
	ISZ	OPIT	/DELETE +V
	ISZ	COUNT	/COUNT VARIABLE
	SAD*	OPIT	/IS OPERATOR A COMMA
	JMP	.-4	/YES
	ISZ	OPIT	/ DELETE THE F(
	JMS*	GETCHI
/
FUNTIE	LAC	COUNT
	DAC	ARGDUM	/ SAVE COUNT OF ARGUMENTS
	CMA!CLL!CML
	DAC	STEPER	/-COUNT-1 IN 2'S COMPLEMENT
	RAL		/-2*COUNT-1 IN 2'S COMPLEMENT
	TAD	VPL
	DAC	VPL	/ADDRESS OF SUBPROGRAM REFERENCE
/
	LAC*	VPL
	DAC*	DRESS	/SUBPROGRAM ADDRESS
	DAC	NAMFN
	ISZ	VPL
	LAC	VPL
	DAC	ACCSW	/INDICATE ACC IN USE(FUNCTIONS). DOES NO HARM ON CALL
	DAC*	(AVPL	/ POINTER TO ARGUMENTS; AUTO-INDEX
	LAC*	DTNEXT	/ FREE SPOT IN DTABLE
	DAC	DTNXT
	DAC*	(AUTOX	/ POINTER TO FREE AREA
	TAD	COUNT
	TAD	(2
	CMA
	TAD*	OTNEXT
	SPA		/ IF NEGATIVE DTABLE WILL CLASH WITH OTABLE
ERCP2	JMP*	ERRCP2		/ANNOUNCE ERROR FROM WITHIN 'WATRAN'
/
	DZM*	CLUES
	LAC	(CALL*M	/ COMPILE FIRST WORD OF FUNCTION CALL
	DAC*	OPCODE	/FUNCTION CALL
	JMS*	PUNCH
/
MLACK	ISZ	STEPER	/ARE ALL ARGUMENTS ASSEMBLED
	JMP	ARGMNT	/NO
	DZM*	AUTOX	/ SAVE PLACE FOR OTABLE REFERENCE
	LAC*	(AUTOX	/ SAVE POINTER TO LAST
	DAC	COUNT	/ WORD
/
/ SEE IF SAME ARGUMENT STRING HAS BEEN USED BEFORE. IF SO USE THE
/ OLD ONE TO SAVE SPACE.
/
	LAC	ARGCHN	/ HEAD OF ARGUMENT STRING CHAIN
CLOOP	DAC	STEPER
	DAC*	(AVPL	/ SET POINTER TO OLD STRING
	SNA
	JMP	NEWONE	/ NO MORE STRINGS IN CHAIN
/
	LAC	DTNXT	/ POINTER TO NEW LIST
	DAC*	(AUTOX
CLOOP2	LAC*	AUTOX	/ COMPARE ARGUMENT
	SZA
	JMP	CLOOP3	/ NOT END OF NEW LIST
	LAC*	AVPL	/ END OF NEW LIST
	SMA		/ IS IT END OF OLD ALSO?
	JMP	OLDONE	/ YES, THEN STRINGS MATCH
/ ARGUMENT STRINGS DIFER, TRY NEXT ONE
XMATCH	LAC*	STEPER
	JMP	CLOOP
/
CLOOP3	SAD*	AVPL
	JMP	CLOOP2	/ ENTRIES MATCH
	JMP	XMATCH
/ AGRUMENT STRING WE JUST BUILT IS UNIQUE. GET IT AN OTABLE
/ ENTRY AND PUT IT IN THE CHAIN.
/
NEWONE	LAC	ARGCHN	/ INSERT NEW STRING AT START OF CHAIN
	DAC*	DTNXT
	LAC	DTNXT
	DAC	ARGCHN
	LAC	ARGDUM	/ GET COUNT OF ARGUMENTS
	TAD	(1	/ COUNT END OF TABLE INDICATOR
	TAD	ARGCNT	/ ADD PREVIOUS TOTAL
	DAC	ARGCNT	/ RETAIN COUNT
	LAC	COUNT
	TAD	(1
	DAC*	DTNEXT	/ RESET TO POINT AT NEXT FREE LOCATION
	LAC	DTNXT	/ DTABLE ADDRESS OF ARGUMENT LIST
	LMQ
	LAC	(AROTB*100000
	JMS*	GETOTB	/ MAKE OTABLE ENTRY FOR ARGUMENT STRING
	DAC*	COUNT	/ ADD OTABLE ADDRESS TO END OF STRING
/
/ AT ENTRY TO OLDONE CONTENTS OF AC IS OTABLE POINTER
/ TO THE ARGUMENT
/
OLDONE	TAD	ASFSET		/ACCOUNT FOR STATEMENT FUNCTION OFFSET
	DAC*	DRESS	/ ASSEMBLE SECOND WORD OF CALL
	DZM*	OPCODE
	JMS*	PUNCH
	JMP	NXT1	/ HAVE ANOTHER GO.
/
/ INSERT AN ARGUMENT INTO ARGUMENT STRING
/
ARGMNT	LAC*	AVPL	/ GET ARGUMENT
	CMA
	TAD	ASFSET		/DETECT ASF DUMMY ARGUMENTS AND
	SPA!CMA			/RECORD THEM AS '71YYYY' WHERE
	JMP	ARGNOR		/'YYYY' IS THE NEGATIVE OFFSET FROM
	AND	(717777		/THE MAIN OTABLE
	DZM*	AVPL		/STEP PAST CLUE FIELD
	JMP	ARGOK		/IT'S A SIMPLE VARIABLE
ARGNOR	LMQ		/ SAVE IT
	LAC*	AVPL	/ GET CLUE BITS
	AND	(CONBIT!FUNCAL!DIMMEN!STATNB
	SNA!CLL
	LAW	2000*C.VAR	/ SIMPLE VARIABLE
	SAD	(FUNCAL
	LAW	2000*C.FUN	/ FUNCTION NAME
	SAD	(DIMMEN
	LAW	2000*C.DIM	/ DIMENSIONED VARIABLE
	SAD	(CONBIT
	LAW	2000*C.CON	/ CONSTANT
	SAD	(STATNB
	LAW	2000*C.STN	/ STATEMENT NUMBER
	RCL
	RCL
	OMQ
/ AC NOW CONTAINS 7XYYYY WHERE X IS ARGUMENT TYPE,
/ AND YYYY IS OTABLE ENTRY
ARGOK	DAC*	AUTOX	/ ADD TO ARGUMENT STRING
	JMP	MLACK
/
FUNSUB	XX
	LAC*	STPL
	SAD	(300000
	JMP	CALLED
	RAL		/L=1 IF SUBSCRIPTING
	LAW	ONEOLY!ARRFUN  /SET FOR FUNCTION
	SZL		/SKIP IF FUNCTION
	LAW	ONEOLY!SUBCHK!LOGILL!RELILL!CPXILL!CHRILL
	JMP*	FUNSUB
/
/ HANDLE STATEMENT NUMBERS IN A CALL STATEMENT
CALLED	LAW	ONEOLY!ARRFUN!STLEGL	/ SET FOR CALL
	JMP*	FUNSUB
/  HANDLE POSITIVE ARGUMENTS
/
FLUSH	XX
	JMS	FUNSUB	/GET CLUE BITS
	JMS	COLECT
	JMS	CLEAR	/CLEAR ACC
	LAC*	VPL
	AND	(TEMPER!CONBIT!STATNB
	SZA
	JMP*	FLUSH
	LAC*	STPL
	XOR	(300000\DEFIND
	SAD	(DEFIND
	JMS*	SHOVE	/DEFINE ARGUMENT IF CALL
	JMP*	FLUSH
/
/  COMPILE SUBSCRIPTING.  OPIT* POINTS AT THE )
/
SCRIPT	LAC	OPIT
	DAC*	(AUTOX  /SET UP AUTO-INDEX REQ
	DZM	ARGS	/NUMBER OF VARIABLE SUBSCRIPTS
	DZM	COUNT	/NUMBER OF SUBSCRIPTS
SB1	ISZ	COUNT
SB2	LAC*	AUTOX
	SAD	(COMMA	/COMMA INDICATES ANOTHER SUBSCRIPT
	JMP	SB1
	SAD	(PVAR
	JMP	SB3	/VARIABLE SUBSCRIPT
	SAD	(SUBS
	JMP	SB4	/START OF STRING
/
/  ****ERROR QQ1 - INVALID SYNTAX IN SUBSCRIPT EXPRESSION
/
ERQQ1	JMS*	ERRORS	/ SUBSCRIPTING FOULED UP
	.SIXBT	'QQ1'	/ (WILL PROBABLY NEVER HAPPEN)
/
SB3	ISZ	ARGS	/COUNT VARIABLE SUBSCRIPTS
	JMP	SB2
/
SB4	DZM*	CLUES	/SET UP TO COMPILE
	LAC	(SUBSRP*M  /SUBSCRIPT CALL
	DAC*	OPCODE
/
	LAC	ARGS	/CALCULATE V-TABLE
	CLL!RAL		/ADDRESS OF ARRAY
	CMA		/NAME ENTRY
	TAD	VPL
	DAC	VPLA
	LAC*	VPLA	/CALCULATE OBJECT TIME
	DAC*	DRESS	/ ADDRESS OF
	TAD	(1	/ DIMENSION TABLE
/
/  SEARCH THROUGH OTABLE LINKS UNTIL ADDRESS OF SUBSCRIPT TABLE IS FOUND
/
AGIN	CLL!RAL		/MULTIPLY BY TWO
	CMA
	TAD*	OTABLE	/CALCULATE OTABLE LOCATION
	DAC	SPOT2
	TAD	(1
	DAC	SPOT	/ POINTS TO IST WORDOF OTABLE ENTRY
	LAC*	SPOT	/NUMBER OF SUBSCRIPTS
	XOR	COUNT	/CHECK IF A MATCH
	CLL!RAL		/BIT 0 IS CHAIN INDICATOR
	SZA
	JMP	ERAA4	/WRONG NUMBER OF SUBSCRIPTS
	LAC*	SPOT2	/POINTS TO DIM. TABLE OR ANOTHER OT.ENTRY
	SZL
	JMP	AGIN	/NOT END OF CHAIN.	TRY AGAIN
/
	DAC	SPOT2	/POINT AT SUBSCRIPT TABLE
	TAD	COUNT	/ POINT AT LAST WORD IN TABLE
	DAC	SPOT	/ POINTS TO ARRAY SIZE
/
	DZM	OFFSET
/
	LAC*	SPOT	/ARRAY SIZE.  NEED FOR
	DAC	ARSIZE	/ALL CONSTANT SUBSCRIPTS
	DZM	SKIPED	/ INITIALIZE # OF MISSING VARIABLES
	LAC	COUNT
	CMA
	TAD	(1
	DAC	COUNT	/ GET 2'S COMP OF COUNT
/
/
/  PROCESS CONSTANT PART OF SUBSCRIPT
/
SB5	LAW	-1
	TAD	SPOT
	SAD	SPOT2	/ ACCUMMULATED SIZE FOR LAST SUBSCRIPT
	LAC	ONES	/ IS 1.
	DAC	SPOT
	LAC*	SBINP	/CONSTANT SUBSCRIPT IN 1'S COMPLEMENT
	GSM
	SNA
	JMP	DLETE	/BY-PASS IF CONSTANT=0
	DAC	MULER
	LAC*	SPOT
	MULS
MULER	XX
	GS!LACQ
	SZL
	TAD	(1	/CONVERT TO 2'S COMPLEMENT
	TAD	OFFSET
	DAC	OFFSET
/
DLETE	ISZ	SBINP	/DELETE CONSTANT SUBSCRIPT
	ISZ	OPIT	/ DELETE , OR )
	LAC*	OPIT
	SAD	(PVAR	/ IS IT +V
	JMP	SB6	/ YES
	ISZ	SKIPED
	JMP	SB6C
/
ONES	.DSA	(1	/ ADDRESS OF LITERAL 1
/
SB6Y	LAC	(200000	/ MARK AS ROW INDEX
	DAC*	OPCODE
	JMP	SB6Z
/
/ THERE IS A VARIABLE
SB6	JMS*	PUNCH	/ PUNCH PREVIOUS ITEM
	ISZ	OPIT	/ DELETE +VAR
	LAC*	OPIT	/ CHECK FOR ROW INDEX
	SAD	(SUBS
	JMP	SB6Y
	LAC	SKIPED
	SNA
	JMP	SB6B
	DAC*	DRESS
	DZM*	CLUES
	LAC	(400000
	DAC*	OPCODE
	DZM	SKIPED
	JMS*	PUNCH
/
SB6B	DZM*	OPCODE
SB6Z	LAC*	VPL
	DAC*	CLUES
	LAW	-1
	TAD	VPL
	DAC	VPL
	LAC*	VPL
	DAC*	DRESS
	LAW	-1
	TAD	VPL
	DAC	VPL
/
/ CHECK IF ALL SUBSCRIPTS HAVE BEEN PROCESSED
/
SB6C	ISZ	COUNT
	JMP	SB5
	ISZ	OPIT	/DELETE THE S(
	LAC	ARGS
	SNA
	JMP	CONSCP	/COMPLETELY CONSTANT SUBSCRIPTS
/
/
SB7	JMS*	PUNCH	/WRITE PREVIOUS LINE
/
/  MUST NOW FIND A SUBSCRIPT ACCUMULATOR.
/  THIS REQUIRES A SEARCH OF THE SUBACC TABLE
	JMS	SETLNK	/ SET LINK ACCORDING TO TYPE OF SUB ACC WANTED
	LAC	(400000	/ INDICATE NORMAL SUBSRCIPT ACC
	SZL
	LAC	(600000	/ INDICATE CHARACTER VARIABLE VAR BEING SUBSCRIPTED
	DAC	SPOT
/
	LAC	(SUBACC-1
	DAC	COUNT
SLOOP	ISZ	COUNT
	LAC	COUNT
	SAD	(ENDSUB
	DZM*	COUNT	/END OF TABLE - LOSE LAST ONE
	LAC*	COUNT
	SPA
	JMP	SLOOP	/IN USE (AC0=1)
	SZA
	JMP	SFND	/FOUND ONE FREE
	SZL!CLA		/ DO NOT HAVE ONE FREE, MUST GO GET A NEW ONE
	LAC	(700000	/ INDICATES A CHARACTER SUBSCRIPTING ACC
	LMQ
	LAC	(SAOTB*100000	/ 2ND WORD=0, 1ST=INDICATOR
	JMS*	GETOTB	/ GO GET SPACE
	TAD	ASFSET
	JMP	SFND2
/
/ NOW MARK AS A CHARACTER SUBSCRIPT ACC FOR CHARACTER VARIABLES OR
/ A REGULAR SUBSCRIPT VACC FOR REGULAR VARIABLES
SFND	TAD	(600000	/ SINCE THIS INSTRUCTION DESTROYS THE LINK
	SZL
	JMP	RESLNK	/ GO RESTORE LINK AND GO TO 'SLOOP'
	AND	(7777
SFND2	DAC*	DRESS
	DAC*	VPLA	/CHANGE V-TABLE TO S-ACC
	XOR	SPOT
	DAC*	COUNT	/INDICATE IN USE
/
/ CHECKS IF OFFSET=0 AND
/ COMPILE POINTER TO SUBSCRIPT ACCUMULATOR
/
	DZM*	CLUES
	LAC	OFFSET
	SZA!CLA
	LAC	(100000
	XOR	(600000
	DAC*	OPCODE
	JMS*	PUNCH
/
/ INSERT OFFSET CONSTANT IN COMPILED CODE
/
	LAC	OFFSET
	DAC*	DRESS
	DZM*	OPCODE
	SZA		/ SKIP CONSTANT OFFSET
	JMS*	PUNCH
	JMP	NXTCK	/AND FORCE OPERATOR TO BE NEXT
/
/ RESTORE LINK FOR NEXT PASS
RESLNK	JMS	SETLNK
	JMP	SLOOP
/
/ THIS ROUTINE SETS:  LINK=1 FOR NORMAL SUBSCRIPT ACC
/                     LINK=0 FOR CHARACTER SUBSCRIPT ACC
SETLNK	XX
	CLL
	LAC*	VPL
	AND	(17
	SAD	(CHARM
	STL		/ WANT NORMAL SUBSCRIPT ACC
	JMP*	SETLNK
/
/
/  ALL SUBSCRIPTS WERE CONSTANTS. (VARIABLES WITH ADJUSTABLE
/   DIMENSIONS WILL NOT ENTER HERE AS ALL CONSTANT SUBSCRIPT
/   WERE TREATED AS VARIABLES WHEN FIRST ENCOUNTERED.)
/
CONSCP	LAC*	SPOT2	/ PICK UP ADJUST
	TAD	OFFSET
	DAC	SPOT2	/ RANGE IS VALID
	SPA
	JMP	ERAB2	/ TOO SMALL
	SNA!CMA
	JMP	NXTCK	/ NO OFFSET.CAN USE MAIN ENTRY AS ADDRESS
	TAD	ARSIZE
	SPA
	JMP	ERAB2
/
	LAC*	VPL	/ GET MODE
	JMS*	WDSIZE	/ GET WORDS/ELEMENT
	GS!MUL		/ AND CALCULATE SIZE IN WORDS
SPOT2	XX
	LACQ
	DAC	SPOT2	/ SIZE IN WORDS (GARBAGE IF CHARACTER)
/  CHECKS IF FORMAL PARAMETER AND EXIT TO COMPILE CODE
/
	LAC*	VPL	/ GET CLUE BITS
	AND	(FORMAL
	SZA!STL		/ L_1
	JMP	SB7	/ FORMAL PARAMETER, COMPILE AS NON-CONSTANT SUBSCRIPT
/
	RAL		/ AC_1
	SAD*	EQUVSW	/ IS IT EQUIVALENCE (AC=1)
	JMP	NXTCK	/ YES! EXIT
	LAC*	VPL
	AND	(17
	SAD	(CHARM	/ IF CHAR, COMPILE AS NON-CONSTANT SUBSCRIPT
	JMP	SB7
/
/  SEPARATE OTABLE ENTRY POINTING AT SPECIFIED ITEM IN ARRAY
/
	LAC	SPOT2	/ RELATIVE LOCATION
	XOR	(400000	/ MARK AS CONSTANT SUBSCRIPT
	LMQ		/ BECOMES 1ST WORD ENTRY
	LAC*	VPL	/ GET CONTROL BITS + MODE
	JMS*	EXCBIT	/ GET OBJECT TIME MODE
	CLL!RAR
	RTR
	XOR	(SAOTB*100000
	XOR*	VPLA	/ PICK UP OTABLE POINTER
	JMS*	GETOTB	/ GET OTABLE SPACE
	TAD	ASFSET
	DAC*	VPLA	/ POINT AT NEW OTABLE ENTRY
	JMP	NXTCK
/
/
/
/  COLLECT LAST TWO VARIABLES FROM V-TABLE &
/  PUT THEM IN AD1 AND AD2
/
COLECT	XX
	AND	(17777	/REMOVE LAW OP. CODE
	DAC	OPS	/AND SAVE CLUE BITS
	CLA!CMA
	TAD	VPL
	DAC	VPLA	/CALC. ADDRESSES OF
	TAD	(-1	/LAST 4 WORDS IN
	DAC	VPLB	/V-TABLE
	TAD	(-1
	DAC	VPLC
/
	LAC*	VPLA
	DAC	AD2	/ MOVE ADDRESS FIELD
	LAC*	VPL	/MOVE MODE BITS TO AD2
N9A	DAC	AD2+1
	SAD	(CONBIT
	JMP	N9	/ POSSIBLE INTEGER SUBSCRIPT
	JMS	CHKMOD	/CHECK IF LEGAL MODE
/
	LAW	ONEOLY
	AND	OPS	/CHECK IF ONLY ONE VARIABLE
	SZA		/WANTED
	JMP*	COLECT	/YES. EXIT
/
	LAC*	VPLC
	DAC	AD1
	LAC*	VPLB	/TRANSFER SECOND VARIABLE TO AD1
N10A	DAC	AD1+1
	SAD	(CONBIT
	JMP	N10	/ CHECK FOR POSSIBLE INTEGER
	JMS	CHKMOD	/CHECK FOR LEGALITY
/
	LAC	AD1+1	/EXIT IF EITHER
	XOR	AD2+1	/VARIABLE IS IN
	AND	(INACC	/ACCUMULATOR
	SZA
	JMP*	COLECT
/
	LAW	TOACC	/CHECK IF VARIABLE
	AND	OPS	/SHOULD BE FORCED INTO
	SNA!CLL		/ACCUMULATOR
	JMP	LOOK	/NO
/
	LAC	(STORE*M	/L=0
	JMS	TEMPAC	/CLEAR ACCUMULATOR OUT
/
	JMS	MODGET
	CMA!CLL!CML	/-MODE(AD1)-1
	TAD	OTHER	/MODE(AD2)-MODE(AD1)-1
	LAC	AD2
	SZL		/L=0, MODE(AD2)>MODE(AD1)
	LAC	AD1
	DAC*	DRESS	/ADDRESS FOR COMPILED INST
	LAC	AD2+1
	SZL
	LAC	AD1+1
	DAC*	CLUES	/CLUE DIGIT FOR PUNCH
	XOR	(INACC	/VARIABLE
	AND	(777777\CONBIT	/IN ACC & NOT A CONST.
	SZL
	DAC	AD1+1	/STORE IN CORRECT PLACE
	SNL
	DAC	AD2+1
/
	LAC	(LOAD*M
	DAC*	OPCODE	/OPERATION CODE
	JMS*	PUNCH
	JMP*	COLECT
/
N9	LAW	SUBCHK	/ IS IT PLACE FOR INTEGER SUBSCRIPT
	AND	OPS
	SNA!CLL		/CLEAR LINK FOR LATER
	JMP	N9AA	/NO.
	LAC	VPLB	/DELETE CONSTANT
	DAC	VPL
/
	LAC	(1
	JMS	OPGET	/ GET +V OR -V
	SAD	(NVAR
	JMP	N9B	/ -V
	LAC	AD2	/ +V
N9C	ADD*	SBINP	/ L=0 BEFORE ADD
	DAC*	SBINP	/ACCUMULATE CONST SUBSCRIPTS
	LAC*	OPIT
	ISZ	OPIT	/DELETE +V OR -V FROM
	DAC*	OPIT	/STRING
	SNL
	JMP	LOOK5
/
/  ****ERROR AB3 - CONSTANT PART OF SUBSCRIPT EXPRESSION EXCEEDS 2**17-1
/
ERAB3	JMS*	ERRORS	/SUBSCRIPTS > 2^17-1
	.SIXBT	'AB3'
/
N9B	LAC	AD2
	CMA		/TAKE 1'S  COMPLEMENT
	JMP	N9C
/
/
N9AA	LAC	AD2	/ GET CONSTANT
	JMS	HIDCON	/ PUT IN SYMBOL TABLE
	TAD	ASFSET		/ADJUST OTABLE ADDRESS IF ASF
	DAC	AD2	/ SAVE OTABLE ADDRESS
	LAC	(CONBIT!SINTGM
	JMP	N9A
/
N10	LAC	AD1
	JMS	HIDCON
	TAD	ASFSET		/ADJUST OTABLE ADDRESS OF ASF
	DAC	AD1
	LAC	(CONBIT!SINTGM
	JMP	N10A
/
HIDCON	XX
	DAC*	VANTED	/ STORE CONSTANT
	DZM*	VANT1
	LAC	(CONBIT!SINTGM
	DAC*	FLTFLG	/ MARK AS SINGLE CONSTANT
	LAC	(CONST
	JMS*	CALCP	/ PUT CONSTANT IN SYMBOL TABLE
	LAC*	TBADDR	/ GET RELATIVE OTABLE ADDRESS
	JMP*	HIDCON
/
/  PUT OPERATOR IN TABLE
/
OPPUT	XX
	LMQ		/SAVE OPERATOR
	LAW	-1
	TAD	OPIT	/CALC. NEXT WORD LOCATION
	DAC	OPIT
	JMS	CFUL
	LACQ
	DAC*	OPIT	/STORE OPERATOR
	JMP*	OPPUT
/
/
CFUL	XX
	LAC	VPL
	CMA		/ -(VPL)-1
	TAD	OPIT	/(OPIT)-(VPL)-1
	SMA
	JMP*	CFUL
/
/  ****ERROR CP6 - TABLE OVERFLOW:  VPL-OPIT
/
ERCP6	JMS*	ERRORS	/TABLES HAVE COLLIDED, STES TABLE OVERFLOW
	.SIXBT	'CP6'
			/VPL OPIT TABLE COLLISION
/
/ OBTAIN AN ITEM FROM TABLE (DO NOT CHANGE LINK)
/
OPGET	XX
	TAD	OPIT
	DAC	OPADR	/CALC.ADDRESS
	LAC*	OPADR	/& PICK UP OPERATOR
	DAC	OPER
	JMP*	OPGET
OPADR	XX
/
/  OBTAIN MODE BITS FROM VARIABLES
/
MODGET	XX
	LAC	AD2+1
	AND	(17	/MODE OF AD2
	DAC	OTHER
	LAC	AD1+1
	AND	(17	/MODE OF AD1
	JMP*	MODGET
/
/CHECK THAT TYPE, AND MODE OF VARIABLE ARE
/PERMITTED IN PRESENT CONTEXT.
/
CHKMOD	XX
	LMQ		/SAVE MODE BITS
	AND	(FUNCAL!DIMMEN!STATNB
	SZA	/IS IT ARRAY OR FUNCTION OR STATEMENT NUMBER
	JMP	PEER	/YES
PEERED	LACQ
	AND	(17	/GET MODE BITS
	TAD	(LAC PERTAB
	DAC	.+1
	XX		/PICK UP MASK BITS
	AND	OPS
	SNA
	JMP*	CHKMOD	/NO MATCH. OK.
/
/  ****ERROR AA9 - ILLEGAL MIXED MODE EXPRESSION
/	I.E. REAL.OR.LOGICAL, OR NON-INTEGER SUBSCRIPT
/
ERAA9	JMS*	ERRORS
	.SIXBT	'AA9'
/
PEER	SAD	(STATNB
	JMP	PEER2
	LAW	ONEOLY!ARRFUN
	AND	OPS
	SAD	(ONEOLY!ARRFUN
	JMP	PEERED
/
/  ****ERROR AA7 - ARRAY OR SUBPROGRAM NAME USED AS SIMPLE VARIABLE
/
ERAA7	JMS*	ERRORS
	.SIXBT	'AA7'
/
PEER2	LAW	STLEGL!ONEOLY
	AND	OPS
	SAD	(STLEGL!ONEOLY
	JMP*	CHKMOD
/
/  ****ERROR ST2 - ILLEGAL USE OF '&NNNN' STATEMENT NUMBER
/
ERST2	JMS*	ERRORS
	.SIXBT	'ST2'	/ ILLEGAL USE OF &NNNN STATEMENT NUMBER
	.EJECT
/  DESCRIPTIONS OF ERRORS GENERATED IN 'EXPRES'
/
/
/  ****ERROR AA0 - MISSING VARIABLE, CONSTANT, OR EXPRESSION
/
ERAA0	JMS*	ERRORS
	.SIXBT	'AA0'
/
/  ****ERROR AA1 - TWO VARIABLES OR CONSTANTS NOT SEPARATED BY OPERATOR
/
ERAA1	JMS*	ERRORS
	.SIXBT	'AA1'
/
/  ****ERROR AA2 - VARIABLE OR CONSTANT MISSING BEFORE ')' OR ','
/
ERAA2	JMS*	ERRORS
	.SIXBT	'AA2'
/
/  ****ERROR AA3 - INVALID SYNTAX IN EXPRESSION
/	I.E.  COMBINATIONS SUCH AS ')NAME' , '-*' , ETC.
/
ERAA3	JMS*	ERRORS
	.SIXBT	'AA3'
/
/  ****ERROR AA4 - INCORRECT NUMBER OF SUBSCRIPTS
/
ERAA4	JMS*	ERRORS
	.SIXBT	'AA4'
/
/  ****ERROR AA6 - FUNCTION OR SUBROUTINE NAME IN FUNCTION OR
/	SUBROUTINE ARGUMENT LIST WAS NOT DECLARED 'EXTERNAL'
/
ERAA6	JMS*	ERRORS
	.SIXBT	'AA6'
/
/  ****ERROR AA7 - ARRAY OR SUBPROGRAM NAME USED AS SIMPLE VARIABLE
/
/  ****ERROR AA9 - ILLEGAL MIXED MODE EXPRESSION
/	I.E.  REAL.OR.LOGICAL  OR  NON-INTEGER SUBSCRIPT
/
/  ****ERROR AB0 - REAL AND IMAGINARY PARTS OF A COMPLEX CONSTANT
/	MUST BE SAME TYPE, EITHER REAL*4 OR REAL*8
/
ERAB0	JMS*	ERRORS
	.SIXBT	'AB0'
/
/  ****ERROR AB1 - COMPLEX CONSTANT NOT TERMINATED WITH A ')'
/
/  ****ERROR AB2 - ELEMENT LOCATION GENERATED FROM CONSTANT SUBSCRIPTS
/	IS OUTSIDE ARRAY LIMITS SPECIFIED IN DIMENSION STATEMENT
/
ERAB2	JMS*	ERRORS
	.SIXBT	'AB2'
/
/  ****ERROR AB3 - CONSTANT PART OF SUBSCRIPT EXPRESSION EXCEEDS 2**17-1
/
/  ****ERROR AB4 - CONSTANT WHERE VARIABLE OR EXPRESSION IS REQUIRED
/
/  ****ERROR AB5 - EXPRESSION WHERE VARIABLE OR CONSTANT IS REQUIRED
/
/  ****ERROR CP2 - TABLE OVERFLOW: OTABLE-DTABLE
/
/  ****ERROR CP3 - TABLE OVERFLOW: (CONSTANT SUBSCRIPTS)
/
ERCP3	JMS*	ERRORS
	.SIXBT	'CP3'
/
/  ****ERROR CP5 - TABLE OVERFLOW: (ARITHMETIC LEVELS)
/
ERCP5	JMS*	ERRORS
	.SIXBT	'CP5'
/
/  ****ERROR CP6 - TABLE OVERFLOW: VPL-OPIT
/
/  ****ERROR CP8 - TOO MANY ARGUMENTS IN ARITHMETIC STATEMENT FUNCTION
/			(COMPILER LIMIT - FRONT OF 'CHI' HAS BEEN SMASHED)
/
/  ****ERROR QQ1 - INVALID SYNTAX IN SUBSCRIPT EXPRESSION
/
/  ****ERROR QQ2 - INVALID MODE IN TEMPORARY ACCUMULATOR REQUEST
/
ERQQ2	JMS*	ERRORS	/ (PROBABLY NEVER HAPPEN)
	.SIXBT	'QQ2'
/
/  ****ERROR SF2 - 1) DID NOT FIND EXPECTED ',' OR ')=' IN ARGUMENT LIST
/		   2) ARG. NAME IS EITHER DUPLICATE OR THE FUNCTION NAME
/
/  ****ERROR SF3 - ILLEGAL VARIABLE IN EXPRESSION (STATEMENT NUMBER OR
/			RECURSIVE CALL)
/
/  ****ERROR SS1 - OUT OF SEQUENCE STATEMENT FUNCTION, OR
/	MISSING DIMENSION STATEMENT
/
ERSS1	JMS*	ERRORS
	.SIXBT	'SS1'
/
/  ****ERROR ST2 - ILLEGAL USE OF '&NNNN' STATEMENT NUMBER
/
	.EJECT
PERTAB	.DSA	INTILL	/ 0 SPECIAL INTEGER FOR SUBSCRIPTS
	.DSA	LOGILL	/ 1 LOGICAL
	.DSA	INTILL	/  2 SINGLE INTEGER
	.DSA	INTILL	/  3 DOUBLE INTEGER
	.DSA	INTILL	/  4 UNKNOWN
	.DSA	RELILL	/  5 REAL
	.DSA	RELILL	/  6 DOUBLE
	.DSA	RELILL	/  7 NON-INTEGER
	.DSA	RELILL	/  8 DOUBLE NON-INTEGER
	.DSA	CPXILL	/  9 COMPLEX
	.DSA	CPXILL	/ 10 UNDEFINED COMPLEX
	.DSA	CPXILL	/ 11 DOUBLE COMPLEX
	.DSA	CHRILL	/ 12 CHARACTER
/
/  STORE ACCUMULATOR IN TEMPORARY STORAGE CELL.
/  ENTRY TO ROUTINE
/
/	LAC	(STORE,STORENEG,MOVE,MOVENEG
/	CLL  (FOR SMASHED STORAGE,  STL  (FOR FORMATTED STORE
/	JMS	TEMPAC
/
/
TEMPA2	XX			/ENTRY POINT FOR CALLS EXTERNAL TO 'EXPRES'
	DZM	ASFSET		/CLEAR STATEMENT FUNCTION OFFSET
	JMS	TEMPAC
	JMP*	TEMPA2
/
TEMPAC	XX
	DAC*	OPCODE	/STORE OR STORENEG
	LAC	ACCSW
	SNA
	JMP*	TEMPAC	/ACC IS EMPTY
/
/
	LAC*	ACCSW	/GET CONTROL BITS
	XOR	(INACC!TEMPER  /DELETE INACC, ADD TEMPER
	DAC*	ACCSW	/RESTORE TO V-TABLE
	AND	(17	/GET MODE BITS
	SZL		/SKIP IF SMASHED FORM
	TAD	(14	  /ADJUST FOR UNSMASHED
	TAD	(-1	/ SET LOWEST INDEX TO ZERO FOR OPA
	JMS	OPA
	TAD	(TEMODE	/GET TEMP. STORAGE TYPE
/
	DAC	T4	/ OBJECT MODE BITS
	ALSS	14	/MOVE INTO OPCODE POSITION
	DAC	T2	/STORAGE TYPE
	SNA
	JMP	ERQQ2	/UNREASONABLE STORE
/
	LAC	(TEMPS-1
	DAC	T3
/
LOOPER	ISZ	T3
	LAC*	T3	/GET ITEM FROM TABLE
	SAD	(770000	/IS TABLE FULL
	JMP	TABFUL	/YES
	SPA		/IS IT A FREE SLOT
	JMP	LOOPER	/NO
/
/
/ HAVE FOUND EITHER A FREE ACCUMULATOR OR
/  AN UNUSED SLOT
/
	AND	(770000	/GET CONTROL BITS
	SAD	T2	/IS IT DESIRED TYPE
	JMP	UNUSED	/YES
	SZA		/IS IT A FREE SLOT
	JMP	LOOPER	/NO.
/
/HAVE FOUND A FREE SLOT IN THE TABLE. GO GET A
/TEMP. ACC FROM THE SYMBOL TABLE ROUTINES.
/
GETONE	LAC	T4	/GET MODE BITS
	JMS	GETMOD	/COLLECT A TEMP. ACC. ADDRESS
	XOR	T2	/INDICATE TYPE
	DAC*	T3	/AND ENTER IT INTO TABLE
/
/ T3 NOW POINTS AT UNUSED TEMP ACC.
/
UNUSED	LAW	-1	/CALC. V-TABLE ADDRESS
	TAD	ACCSW	/FOR STORING TEMP. ACC.
	DAC	ACCSW	/ADDRESS
/
	LAC*	T3
	XOR	(400000
	DAC*	T3	/INDICATE TEMP. ACC IN USE
	AND	(007777	/GET ADDRESS BITS
	DAC*	ACCSW	/SET UP ADDRESS IN V-TABLE
	DZM	ACCSW	/CLEAR ACC. SWITCH
/
	DAC*	DRESS
	DZM*	CLUES
	JMS*	PUNCH	/COMPILE INSTRUCTIONS
	JMP*	TEMPAC
/
T2	XX		/WORK SPACE - STORAGE TYPE
T3	XX		/WORK SPACE - ADDRESS OF ADDRESS
			/ IN TEMPS
T4	XX		/WORK SPACE - MODE
/
/
/ TABLE IS FULL. MUST THROW AWAY AN ENTRY TO
/ MAKE ANOTHER ONE.
/
TABFUL	ISZ	RANDOM	/ GET A NEW NUMBER
	LAC	RANDOM
	AND	(TL-2	/MODULO TL-2 TO GIVE ADDRESSES IN THE
	TAD	(TEMPS	/TEMPS TABLE WITHOUT BOMBING END OF TABLE MARKER
	DAC	T3	/ITS NOW THROWN AWAY
	JMP	GETONE
/
/
TEMODE	.DSA	LOGICM*N+DINTGM*N+DINTGM	/ SMASHED
	.DSA	UNKNOW*N+UNKNOW*N+UNKNOW
	.DSA	UNKNOW*N+UNKNOW*N+UNKNOW
	.DSA	UNKNOW*N+UNKNOW*N+0
	.DSA	LOGICM*N+SINTGM*N+DINTGM	/ UNSMASHED
	.DSA	0*N+REALM*N+DBLEM
	.DSA	0*N+0*N+CMPLXM
	.DSA	0*N+DCMPXM*N+0
/
/ HERE ARE THE SUBSCRIPT AND TEMPORARY ACCUMULATORS. THIS
/ ORDER MUST NOT BE CHANGEG UNLESS THE INITIALIZATION ROUTINE IS
/ CHANGED ALSO!!!
/ SUBSCRIPT ACCUMULATOR ENTRY - 000000 - NOT ASSIGNED
/                               0NNNNN - FREE REGULAR ACCUMULATOR
/                               2NNNNN - FREE CHARACTER ACCUMULATOR
/                               4NNNNN - IN USE REGULAR SUBSCC
/                               6NNNNN - IN USE CHARACTER SUBSCC
/
TL=21	/NUMBER OF TEMP ACC. MUST BE 2**N+1 . SUCH THAT THE RANDOM
	/ENTRIES INTO THE TABLE WILL NOT MAP INTO THE SAME SPOT
	/ON CONSECUTIVE DISCARDS. (IE TL-2 HAS ALL BITS SET)
/
RANDOM	.DSA	1
SUBACC	.BLOCK 21	/ TABLE OF SUBSCRIPT ACCUMULATORS
ENDSUB	.DSA	0
TEMPS	.BLOCK	TL-1	/ TEMPORARY ACCUMULATOR TABLE
	.DSA	770000
/
/
CLRACC	XX
	LAW	RANDOM-ENDSUB-TL
	JMS*	G.INIT
	TAD	(RANDOM	/ START ADDRESS TO BE CLEARED
	CLA
	ISZ	RANDOM	/ SET TO 1
	JMP*	CLRACC
/
/ THIS SUBROUTINE FREES THE SUBSCRIPT ACCUMULATORS SO THEY MAY
/ REUSED IN A NEW STATEMENT.
CLRSUB	XX
	LAW	SUBACC-ENDSUB-1
	DAC	COUNT
	LAC	(SUBACC-1
	DAC	SPOT
NOTESB	ISZ	SPOT
	LAC*	SPOT	/ GET ENTRY
	AND	(377777	/ REMOVE BITS
	DAC*	SPOT
	ISZ	COUNT
	JMP	NOTESB
	JMP*	CLRSUB
/
/
/  THIS ROUTINE REMOVES NEGATIVE SIGNS OF FUNCTION OR SUBSCRIPT
/  ARGUMENTS (TOACC=1), HIDES CONSTANTS FROM DAMAGE, AND CLEARS
/  ARGUMENTS FROM ACCUMALATOR.
/
CLEAR	XX
	LAC	(LAC TABLER	/SET UP FOR ARG IN ACC
	DAC	CLEBOX
	LAC	AD2+1
	AND	(INACC
	SZA
	JMP	CLEAN	/YES.  IN ACC 
/
/  IS ARGUMENT NEGATIVE
/
	LAW	TOACC
	AND	OPS
	SNA!CLL		/L=0
	JMP*	CLEAR	/NO
/
/  GENERATE A MOVE1 CODE TO PUT ARG IN ACC IN NON-EXPANDED FORM.
/ (IF 'FORMAL' SET , GENERATE LOAD INSTEAD)
/
	LAC	(STORE*M	/L=0
	JMS	TEMPAC	/CLEAR AC IF IN USE
/
	LAC	VPL
	DAC	ACCSW	/ TELL WORLD ACC IN USE
	LAC	AD2	/SET UP MOVE1 OR LOAD INSTRUCTION
	DAC*	DRESS
	LAC	AD2+1
	DAC*	CLUES	/CLUE BITS
	AND	(777777\CONBIT  /REMOVE CONSTANT MARKER
	XOR	(INACC	/INDICATE AS IN ACC
	DAC*	VPL
	AND	(FORMAL
	SZA
	JMP	LOADT2
	ISZ	CLEBOX	/ SET UP FOR MOVE OR MOVEN
	ISZ	CLEBOX
	LAC	(MOVE1*M
LOADT3	DAC*	OPCODE
	JMS*	PUNCH	/GENERATE MOVE1 OR LOAD INSTRUCTION
/
/  STORE CONTENTS OF ACC IN TEMP ACC
/
CLEAN	LAW	TOACC	/IS ARG NEGATIVE
	AND	OPS
	SZA!STL		/ ASK FOR PACKED TEMPORARY ACC
	ISZ	CLEBOX	/YES. ASK FOR MOVEN OR STOREN
CLEBOX	XX
	JMS	TEMPAC	/STORE ACC IN TEMP ACC
	JMP*	CLEAR
LOADT2	LAC	(LOAD*M
	JMP	LOADT3
TABLER	.DSA	STORE*M	/STORE OP CODE
	.DSA	STOREN*M	/STORE NEG
	.DSA	MOVE*M	/MOVE
	.DSA	MOVEN*M	/MOVE NEG
/
/ SET ASIDE SPACE FOR THE VARIABLE INDICATED
/ BY THE MODE BITS IN THE AC
/
GETMOD	XX
	XOR	(TAOTB*100000	/ MARK AS TEMPORARY AC.
	CLQ		/ 1ST WORD IS IN MQ, 2ND WORD IN AC
	JMS*	GETOTB	/GET OTABLE SPACE
	TAD	ASFSET		/ADD POSSIBLE ASF OFFSET
	JMP*	GETMOD
/
/  PROCESS STATEMENT FUNCTION
/
LEGASF	LAC	(FUNBIT!DEFIND
	JMS*	SHOVE		/MARK AS DEFINED FUNCTION
	ISZ	ASFNUM		/COUNT NUMBER OF ASF'S
/
/  SET UP OTABLE ENTRY, AND BUILD LIST OF POINTERS TO
/  ASF OTABLE ENTRIES BETWEEN 'BASE2' AND 'BASE3'.
/
	LAC*	BASE3		/CHAIN DOWN LEVEL
	DAC	LBASE3		/OF INDIRECT ADDRESSES
	ISZ*	BASE3		/SPACE FOR NEW ENTRY
/
	LAW	-1		/GET OTABLE POINTER
	TAD*	OPLACE		/AND RECORD IT
	DAC	ASFCNT		/IN POINTER STORE AREA
	DAC*	LBASE3
/
	LAC	(FROTB*100000    /STORE START ADDRESS IN
	TAD*	START		/OTABLE ENTRY
	DAC*	ASFCNT
	ISZ	ASFCNT		/POINT TO ARG COUNT PART OF OTABLE ENTR
/
/  RESET ANY STATEMENT NUMBER AS NON-EXECUTABLE SINCE HAVE LOST
/  STATEMENT NUMBER HISTORY, SEARCH SYMBOL TABLE OF EXECUTABLE OF
/  EXECUTABLE STATEMENT.  IF FIND ONE, IT'S US.
/
	LAW	-1
	TAD*	PTABLE		/SET UP PTABLE SCAN POINTER
	DAC*	(AUTO12
STN	LAC	(STNUM
	JMS*	G.SCAN		/LOOK FOR STATEMENT NUMBER
	SKP
	JMP	GTA		/NO NUMBER IN TABLE
	DAC	SPOT
	LAC*	SPOT
	AND	(.EXC		/CHECKS FOR EXECUTABLE
	SNA
	JMP	STN		/NOT US
	LAC*	SPOT
	XOR	(.EXC!NON.EX
	DAC*	SPOT		/MAKE NON-EXECUTABLE
/
GTA	DZM	AD2
	LAC*	FLTFLG		/SET UP MODE FOR
	XOR	(FUNCAL         /TEMP. ACC. AND MARK AS
	DAC	AD2+1		/ASF FOR 'ASCOM'
/
/  EXTRACT DUMMY ARGUMENT NAMES FROM THE STATEMENT FUNCTION AND
/  STORE THEM IN TEMPORARY SYMBOL TABLE IN WORK AREA BELOW 'CHI'
/
	LAC	LBASE3		/POINT TO TABLE AREA
	DAC*	(AUTOX
/
	LAC*	VANTED		/PUT FUNCTION NAME IN
	DAC*	AUTOX		/ARGUMENT TABLE TO
	LAC*	VANT1		/CAN CATCH ILLEGAL USE
	DAC*	AUTOX
	DZM*	AUTOX		/DUMMY MODE
/
ASFG1	JMS*	GETCHI		/THROW AWAY '(' OR ','
	LAC	(NAME
	JMS*	SEARCH		/PICK UP ARGUMENT NAME
	JMS	ARGCHK		/SEE IF IN TABLE
	SMA
	JMP	ERSF2		/ERROR. DUPLICATE NAME
	LAC*	VANTED
	DAC*	AUTOX		/PUT ARGUMENT NAME AND
	LAC*	VANT1		/IMPLIED MODE IN TABLE
	DAC*	AUTOX
	LAC*	FLTFLG
	DAC*	AUTOX
	ISZ*	ASFCNT		/COUNT ARGUMENT
	LAC*	(AUTOX		/CHECKS THAT WE DON'T OVERWRITE
	CMA			/TOO MUCH OF 'CHI'
	TAD*	INDEX
	SMA
	JMP	.+3
ERCP8	JMS*	ERRORS
	.SIXBT	'CP8'		/HAVE SMASHED USEFUL 'CHI'
/
	LAC*	CHINXT
	SAD	(COMMA
	JMP	ASFG1		/COLLECT NEXT ARGUMENT
	SAD	(CLOSE
	JMP	.+3
ERSF2	JMS*	ERRORS		/DID NOT FIND EXPECTED ',' OR ')='
	.SIXBT	'SF2'		/OR DUPLICATE ARGUMENT OR FUNCTION NAME
	JMS*	GETCHI
	DAC*	OPIT		/FOOL EXIT ROUTINE
	SAD	(REPLAC
	SKP!CLC
	JMP	ERSF2		/MISPLACED ')' OR '='
/
/  GO LOOK DUMMY ARGUMENTS UP IN SYMBOL TABLE TO SEE IF THEY HAVE
/  DEFINED MODES.  MUST DO THIS WITHOUT USING 'CALCP' SINCE
/  IT MODIFIES SYMBOL TABLE.
/
	LAW	-1
	TAD*	PTABLE		/INITIALIZE
	DAC*	(AUTO12         /'PTABLE' SCAN ROUTINE POINTER
VBLES	LAC	(VARIAB
	JMS*	G.SCAN		/SCAN 'PTABLE' FOR VARIABLES
	JMP	ASFMOD		/FOUND ONE
/
/  SET TRAP DOOR SO THAT 'EXPRES' PASSES VARIABLES THROUGH
/  DUMMY ARGUEMNTS BEFORE 'CALCP' SEES THEM.
/
	LAC*	ASFCNT
	TAD	(6		/SET OTABLE ADJUSTMENT FOR
	TAD	ASFOFF		/ASF OTABLE OFFSET
	DAC	ASFSET
	TAD	(4		/NEXT ONE HAS AN EXTRA FOUR TO SKIP
	DAC	ASFOFF
	LAC	(CALCPY
	DAC	CALCPX		/SET 'CALCP' INTERCEPT
/
/ GET A TEMPORARY ACCUMULATOR (PACKED FORM) FOR THE FUNCTION
/ RESULT TO BE STORED IN (FOR SIGN CHANGE AND CORRECT MODE FORCING)
/
	LAC	AD2+1
	SAD	(CHARM!FUNCAL
	JMP	END2	/ DON'T NEED (& DON'T HAVE) TEMP. ACC FOR CHAR
	TAD	(13-FUNCAL	/ GET OBJECT TIME MODE BITS AND
	JMS	OPA	/ HENCE A
	TAD	(TEMODE	/ TEMPORARY ACCUMULATOR
	JMS	GETMOD
	DAC	AD2
	JMP	END2		/RETURN TO FINISH COMPILE OF ' A=B'
/
/  SET MODES OF ASF ARGS IF IN SYMBOL TABLE
/
ASFMOD	DAC	SPOT
	DAC*	(AUTOX		/MOVE NAME TO 'VANTED'
	LAC*	AUTOX
	DAC*	VANTED
	LAC*	AUTOX
	DAC*	VANT1
	JMS	ARGCHK		/GO CHECK ARGUMENTS
	SPA
	JMP	VBLES		/NOT ARGUMENT NAME
	LAC	SPOT		/GET MODE WORD
	AND	(17		/ISOLATE MODE.
	DAC*	AUTOX		/INSERT MODE IN ARGUMENT TABLE
	JMP	VBLES		/TRY FOR NEXT
/
/  THIS ROUTINE SCANS LIST OF ARITHMETIC STATEMENT FUNCTIONS TO SEE IF
/  THERE IS A MATCH FOR SYMBOL NAME IN 'VANTED'.  THE FOLLOWING VALUES
/  ARE RETURNED IN THE AC:
/
/	-1	NOT IN ARGUMENT LIST
/	0	ASF NAME
/	1-N	ARGUMENT NUMBER
/
ARGCHK	XX
	LAC*	ASFCNT		/NUMBER OF ARGS (+N)
	CMA
	DAC	ARGWRK		/ -N-1
	LAC	LBASE3
	DAC*	(AUTOX		/ADDRESS OF TABLE
ARGCK1	LAC*	AUTOX
	SAD*	VANTED
	JMP	ARGCK2		/FIRST WORD OF NAME MATCHED
	LAC*	AUTOX		/SKIP SECOND WORD OF UNMATCHED NAME
ARGCK3	LAC*	AUTOX		/SKIP MODE
	ISZ	ARGWRK
	JMP	ARGCK1		/TRY AGAIN
	LAW	-1		/NOT IN TABLE
	JMP*	ARGCHK
/
ARGCK2	LAC*	AUTOX
	SAD*	VANT1
	SKP			/SECOND WORD OF NAME MATCHES
	JMP	ARGCK3
	LAC	ARGWRK
	TAD*	ASFCNT
	TAD	(1		/CALCULATE ARGUMENT NUMBER
	JMP*	ARGCHK
/
ARGWRK;LBASE3;ASFCNT;ASFSET;CALCPX
/
/  CHECK TO SEE IF VARIABLE IS A DUMMY ARGUMENT
/
CALCPY	XX
	JMS	ARGCHK		/SCAN ARG TABLE
	SMA
	JMP	INARGT		/IN ARGUMENT TABLE
	LAC	(VARIAB         /GO LOOK IT UP IN THE MAIN TABLE
	JMS*	CALCP
	JMP*	CALCPY
/
INARGT	LMQ
	SZA
	JMP	.+3
ERSF3	JMS*	ERRORS		/ILLEGAL VARIABLE IN EXPRESSION
	.SIXBT	'SF3'		/ (STATEMENT NUMBER OR RECURSIVE CALL)
/
	LAC*	AUTOX
	DAC*	FLTFLG		/SET MODE FLAG
	LAC	(ASF4
	DAC	TBPOS		/SET POINTER TO CONTROL BITS
	LACQ
	TAD	(5		/GENERATE OTABLE ADDRESS AND
	JMP	L2B		/GO COMPILE IT
ASF4	FORMAL!NOFUN
/
ASFNUM;ASFOFF
/
/ LEVELS OF ARITHMETIC TABLE &
/ CONSTANT SUBSCRIPT STORAGE TABLE
/
/ STES CONTAINS LEVELS OF ARITHMETIC INDICATORS.
/ STPL POINTS TO THE CURRENT LEVEL.  THE LEVEL
/ IS STORED IN THE FIRST FOUR BITS AND THE
/ CODES ARE:
/
/ 00 - START OF A STATEMENT OR A ' ( '
/ 10 - FUNCTION "("
/ 30 - CALL "("
/ 40 - SUBSCRIPT "("
/ 44 - SUBSCRIPT "(" FOR VARIABLE DIMENSIONS
/
/
STES	.BLOCK 144	/START OF LEVELS TABLE
SBINS	.BLOCK 1		/START OF SUBSCRIPT TABLE
AD1	.BLOCK 2
AD2	.BLOCK 2
CLEW2=AD2+1
WORK1	.BLOCK 1
WORK2	.BLOCK 1
OTHER	.BLOCK 1
WANTED	.BLOCK 6	/TEMP STOR OF VANTED WHEN FORMING
		/COMPLETE COMPLEX NUMBER
X4	.BLOCK 1	/STORES LOCATION, IMAG PART, CMPLX NO.
MODSAV	.BLOCK 1	/TEMP STOR OF FLTFLG
		/POSS DESTROYED WHEN VANTED REPACKED FOR CMPX NO.
/
/ EAE MNEMONICS
/
CA=641000
GS=660000
/
/ BASIC STORAGE LOCATIONS
/
ACCSW	0
ARSIZE	0	/ ARRAY SIZE
ARGCHN	0
ARGCNT	0	/ MAINTAINS TOTAL COUNT OF CALL ARGUMENTS
ARGDUM	0	/ DUMMY STORAGE
ARGS	0
COUNT	0
DTNXT
EXPSWT	0
GLORK	0
HELPER	0
LOOKER	0
NAMFN	0
NXSW	0
OFFSET	0
OPER	0
OPER1	0
OPIT	0
OPS	0
SBINP	0
SKIPED	0	/ # OF CONSTANT SUBSCRIPTS SKIPPED
SPOT	0
STEPER	0
STPL	0
TBPOS	0
VPL	0
VPLA	0
VPLB	0
VPLC	0
WCOMSW	0
	.END