	.TITLE
/ 
/ 
/                   FIRST PRINTING, JANUARY 1975
/ 
/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO 
/ CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
/ AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPON-
/ SIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS
/ DOCUMENT.
/ 
/ THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FUR-
/ NISHED TO THE PURCHASER UNDER A LICENSE FOR USE ON
/ A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH
/ INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR 
/ USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PRO-
/ VIDED IN WRITING BY DIGITAL.
/ 
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/ FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIP-
/ MENT THAT IS NOT SUPPLIED BY DIGITAL.
/ 
/ COPYRIGHT (C) 1975, BY DIGITAL EQUIPMENT CORPORATION
/ 
/ 
/
	.TITLE	XVM FORTRAN IV COMPILER, PART 2
/
/ CONTINUATION OF TWO PART SOURCE FILE OF FORTRAN COMPILER
/ THE SAME EDIT NUMBER AND SOURCE FILE EXTENSION IS MAINTAINED 
/ FOR BOTH PARTS
/
/
/ EDIT # 46  4 FEB 74   TAM
/
/ EDIT	   DATE		VERSION	PROGRAMMER	FIX
/ 050	24-NOV-74	V3A001	R.K. HYATT	CORRECTED >0E < PROBLEM - IN PART TWO
/
/ 051	24- NOV-74	V3A002	R.K. HYATT	CORRECTED NONDETECTION OF
/				MISSING PAREN IN IMPLIED DO LOOPS
/				INCLUDED NEW ERROR MESSAGE >33X<
/
/ 052	24-NOV-74	V3A003	R.K. HYATT	CORRECTED NONDETECTION OF GARBAGE
/				AT END OF EXPRESSION IN ASSIGNMENT STATEMENTS
/				INCLUDED NEW ERROR MESSAGE >34X<
/
/ 053	26-NOV-74	V3A004	R.K. HYATT	CORRECTED INFINITE LOOPING
/				ON ERROR MESSAGE DUE TO COMMAND SYNTAX ERROR
/
/ 054	27-NOV-74	V3B000	R.K. HYATT	CHANGE VERSION NUMBER TO V3B000
/				FOR B UPDATE TO DOS-15
/
/ 055	16-JAN-75	V3B000	R.K. HYATT	CORRECTED DOS INIT PROBLEM
/
/ 056	31-JAN-75	V3B001	R.K. HYATT	REMERGED DOS AND RSX COMPILERS
/				AND DELETED MODE BITS FROM HIGH ORDER VECTORS BITS
/
/ 057	3-FEB-75	V3B002	R.K. HYATT	CORRECTED NONDETECTION OF
/				REDUNTENT EQUIVALENCE STATEMENTS - NEW ERROR
/				MESSAGE >17C< - SPR#15-714
/
/ 058	3-FEB-75	V3B003	R.K.  HYATT	INSERTED CHECK FOR UNBALANCED
/				RIGHT PARENS IN PRE-SCANNER - SPR#15-822
/
/ 059	3-FEB-75	V3B004	R.K. HYATT	CORRECTIONS FOR IMPROPER
/				EVALUATION OF 'IF5' - SPR#15-822
/
/ 060	11-FEB-75	V3B005	R.K. HYATT	CORRECTIONS TO DETECT UNDEFINED
/				FUNCTION DEFINITIONS - SPR#15-E737
/
/ 061	20-FEB-75	V3B006	R.K. HYATT	CHANGED HELLO IN PDP15 VERSIONS
/			OF COMPILER
/
/ 062	21-MAY-75		R.K. BLACKETT	REMOVED ANTIQUE CONDITIONALS
/
/ 063	22-MAY-75	V1X000	R.K. BLACKETT	CHANGE CODE GENERATED FOR A
/					LOGICAL .OR. TO DO A BOOLEAN INCLUSIVE OR
/
/ 064	22-MAY-75	V1X001	R.K. BLACKETT	FIX FORMAT STATEMENT PROCESSOR
/					TO DETECT MISSING OPENING PAREN.
/
/ 065	30-JUL-75	V1X002	R.K. BLACKETT	FIX ERROR IN EDIT 062.
/					FOUR LINES WERE ERONEOUSLY DELETED
/					AFTER LABEL 'DDCHK' IN P1.
/
/ 066	28-AUG-75	V1X003	R.K.BLACKETT	ADD LISTING HEADER LINE.
/
/ 067	16-OCT-75	V1A000	R.K. BLACKETT	ADD SIZE AND ERR CNT MSGS
/
/068	11-NOV-75	V1A000	R.K. BLACKETT	FROM NOW ON, ONLY THE EDIT
/					HISTORY IN PART 1 WILL BE UPDATE
/					WITH EACH EDIT.
/
/
	.TITLE	COMPILER MESSAGES
/SUBROUTINE TO OUTPUT MESSAGES
/CALLING SEQUENCE...
/      JMS	SUB990
/      .DSA	HIGHBITS+MESSAGE ADDRESS (-2 FOR DUMMY HEADER)
/	HIGHBITS=400000 FOR BATCH SUPPRESSION, 100000 FOR TTY FORCE
/
SUB990	CAL	0
	.IFUND	RSX		/(RKB-067)
	LAC*	SUB990
	AND*	SCOM52
	SPA!CLL		/IF BATCH AND HIGHBITS=400000,
	JMP	SUB991	/SCRUB THE MESSAGE
	LAC*	SUB990
	AND	T00000
	RTR
	XOR*	SCOM52	/PUT THE 100000 BIT INTO BIT 4 OF .SCOM+52
	DAC*	SCOM52	/TO FORCE PRINTOUT ON THE TELETYPE IF ON
	.ENDC
	.IFDEF	RSX
	LAC	S990CL	/CHECK TO SEE IF OUTPUT TO LPT
	SAD	(DAT12)
	JMP	SUB992	/YES DON'T SUPPRESS
	LAC	VERPNT	/IS TTY I/O PERMITTED?
	SNA
	JMP	SUB991	/NO IGNORE TTY I/O
SUB992=.
	.ENDC
	LAC*	SUB990
	AND	S77777	/GET RID OF HIGHBITS
	.IFUND	RSX
	DAC	CTLPSW
/      .WRITE -3
S990CL	CAL 2775
	.DSA	000011
CTLPSW	.DSA	000000
Z77677	.DSA	777677
	DZM	.-2
	LAC	S02775
	.ENDC
	.IFDEF	RSX
	DAC	DA3MSG	/SET UP MESSAGE POINTER
	CAL	WRIT3	/WRITE MESSAGE
	JMS	WFEV	/WAIT FOR EVENT VARIABLE
	LAC	S990CL	/LUN IN CASE OF I/O ERROR
	LAC	(DAT3)	/RESTORE LUN NUMBER
	.ENDC
	DAC	S990CL
SUB991	ISZ	SUB990
	JMP*	SUB990
	.IFUND	RSX		/(RKB-067)
SCOM52	.DSA	152
	.ENDC
	.EJECT
/(RKB-067)
/(RKB-067)	SUBROUTINE TO CONVERT A POSITIVE BINARY NUMBER
/(RKB-067)	INTO 5 PACKED ASCII CHARCTERS.
/(RKB-067)
/(RKB-067)	CALLING SEQUENCE:
/(RKB-067)		LAC	(WHERE)	/ WHERE TO PUT THE 5/7 ASCII WORD PAIR
/(RKB-067)		JMS	SUB980
/(RKB-067)		LAC	NO#	/ WHERE TO GET THE NUMBER TO CONVERT
/(RKB-067)		---	------  <-- RETURN
/(RKB-067)
SUB980	XX			/(RKB-067) CONVERT BINARY TO DECIMAL ASCII
	DAC	SUB98P		/(RKB-067) SAVE 'TO' ADDR
	XCT*	SUB980		/(RKB-067) GET NUMBER TO CONVERT
	IDIV			/(RKB-067) PULL OUT LSD
	12			/(RKB-067)
	AAC	60		/(RKB-067) MAKE IT ASCII
	RAL			/(RKB-067) RIGHT PLACE FOR LAST CHAR OF PAIR
	DAC	SUB98T+1	/(RKB-067) PUT IT AWAY
	DIV+1000		/(RKB-067) GET FOURTH CHAR
	12			/(RKB-067)
	AAC	60		/(RKB-067) MAKE IT PRINT
	ALSS	10		/(RKB-067) POSITION IT
	XOR	SUB98T+1	/(RKB-067) COMBINE W/EXISTING CHAR
	DAC	SUB98T+1	/(RKB-067)
	DIV+1000		/(RKB-067)GET THE THIRD
	12			/(RKB-067)
	ALSS	17		/(RKB-067)
	XOR	SUB98T+1	/(RKB-067)
	DAC	SUB98T+1	/(RKB-067)
	DIV+1000		/(RKB-067) NEXT
	12			/(RKB-067)
	AAC	60		/(RKB-067)
	ALSS	4		/(RKB-067)
	AAC	6		/(RKB-067) THIS IS HIGH PART OF CHAR 3
	DAC	SUB98T		/(RKB-067)
	LACQ			/(RKB-067) GET LAST CHAR
	AAC	60		/(RKB-067)
	ALSS	13		/(RKB-067)
	XOR	SUB98T		/(RKB-067)
	DAC*	SUB98P		/(RKB-067) MOVE IT OUT TO USER AREA
	ISZ	SUB98P		/(RKB-067)
	LAC	SUB98T+1	/(RKB-067) SECONT WORD OF PAIR
	DAC*	SUB98P		/(RKB-067)
	JMP*	SUB980		/(RKB-067) ALL DONE
SUB98P	0			/(RKB-267)
SUB98T	.BLOCK	2		/(RKB-067)
	.IFUND	%NOHDG		/(RKB-069)
	MESSY1-./2*1000+2 /(RKB-070)
	0		/(RKB-070)
TOF	.ASCII	<14>'PAGE  000     FILNAM SRC   DD-MON-YY   HH:MM     '  /(RKB-066)
	.ENDC		/(RKB-069)
	.DEFIN	HELLO,VER,RLSE,LVL
	.IFUND	RSX
	.IFUND	%FPP
MESSY1	.ASCII	'F4M XVM V@VER@RLSE@LVL'<15>
	.ENDC
	.IFDEF	%FPP
MESSY1	.ASCII	'FPF4M XVM V@VER@RLSE@LVL'<15>
	.ENDC
	.ENDC
	.IFDEF	RSX
	MESSY4-./2*1000+2 /(RKB-070) RSX NEEDS NICE HEADER WORD PAIR
	0			/(RKB-070)
	.IFUND	%FPP
MESSY1	.ASCII	'F4M RSX XVM V@VER@RLSE@LVL'<15>
	.ENDC
	.IFDEF	%FPP
MESSY1	.ASCII	'FPF4M RSX XVM V@VER@RLSE@LVL'<15>
	.ENDC
	.ENDC
	.ENDM
/
/
/
	HELLO	1,A,000
/
/
/
/
/ OTHER MESSAGES USED BY FORTRAN
/
	.IFDEF	RSX
	MESSY5-MESSY4/2*1000+2
	0
	.ASCII	' FOR-'
	.ENDC
MESSY4	.ASCII /END PASS1/<15>
	.DSA	420240
	.DSA	406472
	.DSA	330432
MESSY5	.DSA	373720	/.ASCII />/<175>
	.IFUND	RSX
MESSY3	.DSA	572417	/.ASCII /^P/<175>
	.ENDC
	.IFDEF	RSX
	X77777-MESSY3/2*1000+1002
	0
MESSY3	.ASCII	/FOR-^P/<175>
	.ENDC
X77777	.DSA	577777
	3002
	0
MESSY6	.ASCII	/ >00I< /<15>
ERFLG1	.ASCII	'< '<15>
	.LOC	.-1
ERFLG2	.ASCII	'<^'<15>
	.LOC	.-1
	.IFUND	RSX
CMDERT	.ASCII /?/<15>
	.LOC .-1
	.ENDC
	.IFDEF	RSX
	4002
	0
CMDERT	.ASCII	/FOR-SYNTAX ERR/<15>
	.ENDC
	.IFDEF	RSX
	4002
	0
	.ENDC
MESSY2	.ASCII	<12>/ PROG > 4K/<15>
	.LOC	.-1
	.IFDEF	RSX
	2002
	00
MESSY7	.ASCII	<15>
	.LOC	.-1
	.ENDC
	.IFUND	%NOEOC		/(RKB-069)
SIZMSG	010002					/(RKB-067)
       	0					/(RKB-067)
	.ASCII	'PROGRAM SIZE = '		/(RKB-067)
PGMSIZ	.ASCII	'XXXXX'				/(RKB-067)
	.ASCII	', NO ERRORS'<15>		/(RKB-067)
	.LOC	.-1				/(RKB-067)
ERRMSG	006002					/(RKB-067)
	0					/(RKB-067)
	.ASCII	'XXXXX ERRORS DETECTED'<15>	/(RKB-067)
	.LOC	.-1				/(RKB-067)
	.ENDC			/(RKB-069)
	.TITLE	ARITHMETIC EXPRESSION ANALYZER
/ SUBROUTINE TO INITIALIZE ARG(I) AND OP(I) LISTS
/ CALLING SEQUENCE...
/      JMS	INAOPI
/
INAOPI	SYN	TFAO04
	LAC	ARG0
	DAC	ARGI		/ 0 TO I
	DAC	ARG1		/ ARG(0) TO ARG1
	DAC	TYPEA1	/ SET NO ARGUMENT 1
	LAC	OP0
	DAC	OPI		/ 0 TO I
	DZM*	OPI		/ OP(0) TO POP
	JMS	EXP640	/0 TO LEVEL(POP)
	LAC	TSIMNE
	DAC	TSI		/ INITIALIZE CREATED TEMPORARY STORAGE
	LAC	TSRMNE
	DAC	TSR		/ FOR INTEGER-LOGICAL, REAL, AND
	LAC	TSDMNE
	DAC	TSD		/ DOUBLE PRECESION.
	LAC	TSJMNE
	DAC	TSJ
	JMS	INFAOP	/ INITIALIZE FETCH ARG-OP SUBROUTINE
	JMP*	INAOPI
TSJMNE	.DSA	125120
	.EJECT
/ SUBROUTINE TO DECODE ARITHMETIC AND LOGICAL EXPRESSIONS
/
EXPRSN	SYN	PARLHI
	JMS	INAOPI	/INITIALIZE ARG(I), OP(I) LISTS
	LAC	IFFLAG	/THE LAST ITEM PROCESSED IS PRE-SET TO AN
	DAC	TFAO01	/OPEN PARENTHESIS FOR AN IF STATEMENT.
EXP001	JMS	FA2NOP
	LAC	RWEXPF
	SZA		/IF THE "I/O LIST" FLAG IS ON
	LAC	IDXNOP
	SAD	C00001	/AND THE CURRENT OPERATOR IS AN = SIGN
	JMP	RWEQLS	/GO TO THE IMPLIED DO LIST CLEANUP ROUTINE
EXP003	LAC	LEVNOP	/INSTRUCTIONS ARE GENERATED IN HEIRARCHAL
	JMS	TWOCMA	/FASHION. EACH OPERATION IS ASSIGNED A
	TAD	LEVPOP	/PRIORITY LEVEL. INDIVIDUAL PRIORITIES MAY
	SMA		/CHANGE DUE TO THE INFLUENCE OF
	JMP	EXP004	/PARENTHETICAL GROUPING. INSTRUCTIONS ARE
EXP011	JMS	EXP530
	JMP	EXP11A		/IF NOT ARRAY,DON'T TEST
	LAC	IDXNOP
	ERS	08E,<SAD C00028>,EE1		/**050** BETTER BE ')'
EXP11A	JMS	EXP710	/NOT GENERATED WHEN THE PRIORITY OF THE
			/LAST OPERATOR IS LESS THAN THE PRIORITY
			/OF THE NEXT OPERATOR.
			/WHEN AN  ARG1.POP.ARG2 TRIPLE IS BYPASSED
			/DUE TO THE RELATIVE PRIORITIES OF THE
	LAC*	NOP
	AND	S00077
	SAD	S00052	/PART WORD OP?
	JMP	EXPART	/YES - GO TO IT
EXP005	LAC	ARG2		/OPERATORS, THE ACCUMULATOR IS STORED IF
	DAC	ARG1		/IT IS AN ARGUMENT.
	LAC	NOP		/THE LIST IS PUSHED DOWN AS THE NEXT
	JMS	EXP640	/ARGUMENT AND NEXT OPERATOR PAIR (ARG2.NOP)
	JMP	EXP001	/BECOME THE LAST ARGUMENT AND LAST OPERATOR
EXP004	LAC	IDXNOP	/AN INDICATION TO GENERATE INSTRUCTIONS
	SAD	C00030	/MAY NOT ALWAYS RESULT IN THE IMMEDIATE
	JMP	EXP006	/GENERATION OF INSTRUCTIONS.
	SAD	C00032	/COMMAS (FUNCTION PARAMETER SEPARATORS)
	JMP	EXP007	/AND PARAMETER LIST TERMINATION DELIMETERS
	SNA!CLA
	LAC	RWEXPF	/DONT CHECK FOR ARRAY NAME ALONE IF NEXT OP IS CR
	SNA		/AND "I/O FLAG" IS ON
	JMS	EXP530	/ARE HANDLED INDEPENDANTLY.
	JMP	EXP008
	LAC	IDXNOP
	ERS	08E,<SAD C00028>,EE	/ERROR: FUNCT NAME NOT
	JMP	EXP011	/FOLLOWED BY ( AND NOT A PARAMETER
EXP006	LAC*	BASEJ		/A COMMA CAN BE USED ONLY AS A DELIMETER
	SNA		/TO SEPARATE ITEMS IN A LIST AND CAN OCCUR
	JMP	UNPCMA	/ONLY WITHIN PARENTHESES UNLESS IN AN I/O LIST
EXP007	LAC	IDXPOP	/FUNCTION PARAMETERS MAY BE SINGLE
	SAD	C00030	/TERMS OR EXPRESSIONS.
	JMP	EXP009	/FUNCTION AND ARRAY NAMES MAY BE FUNCTION
	SAD	C00028	/PARAMETERS AS LONG AS THEY ARE NOT
	JMP	EXP009	/COMBINED INTO AN EXPRESSION.
	JMS	EXP530	/AN ERROR IS ANNOUNCED IF A FUNCTION
	JMP	EXP010	/OR ARRAY NAME IS USED IN AN EXPRESSION
	ERX	09E,EE	/WITHOUT A FOLLOWING OPEN PARENTHESIS
EXP009	LAC	SIGNA2
	SPA		/ALL FUNCTION APARAMETERS ARE REDUCED TO A
	JMS	EXP680	/SINGLE TERM, STORED IN A TEMPORARY IF NECESSARY
	JMS	EXP690	/SO THAT WE HAVE AN ADDRESS TO PASS TO THE FUNCTION
	LAC	IDXNOP
	SAD	C00030	/THE SPECIAL ARGUMENT AND OPERATOR
	JMP	EXP005	/FOLLOWING THE FUNCTION REFERENCE ARE
	JMS	FA2NOP	/FETCHED WHEN THE PARAMETER LIST IS
	DZM	SSCTR	/TERMINATED.
EXP013	LAC	ARGI
	TAD	K00001
	DAC	ARGI
	LAC	OPI
	TAD	K00001
	DAC	OPI
	LAC*	OPI		/THE LIST INDICES ARE PUSHED UP UNTIL THE
	AND	S00077
	SAD	C00030
	ISZ	SSCTR	/COUNT ARGUMENTS (SUBSCRIPTS)
	SAD	C00028	/START OF THE PARAMETER LIST IS FOUND.
	JMP	EXP014
	JMP	EXP013
EXP014	JMS	EXP540	/THE FUNCTION CALL IS GENERATED AS EITHER
	LAC*	TARGI		/A JMS* OR A JMS. A JMS IS GENERATED WHEN
	JMS	SETA2		/THE FUNCTION NAMED IS A STATEMENT FUNCTION
	JMS	SYMTYP	/IS IT A FUNCTION
	XOR	U00000	/OR A SUBSCRIPTED VARIABLE?
	JMP	EXSBSC	/SUBSCRIPTED VARIABLE - GO PROCESS
	LAC*	ADDRA2	/A TRANSFER VECTOR IS UN-NECESSARY FOR
	AND	W17777	/STATEMENT FUNCTIONS AS THEY ARE LOCALLY
	SMA		/DEFINED RATHER THAN EXTERNALLY DEFINED.
	XOR	S20000
	AND	S77777	/THE CALLING SEQUENCE FOR A STANDARD
	XOR	JMSCMD	/LIBRARY ROUTINE IS AS FOLLOWS:
	JMS	RELBIN	/ JMS*  SUB   BRANCH VIA TRANSFER VECTOR
			/ JMP   PN+1  BRANCH AROUND PARAMETERS
	LAC	PC		/ P1		FIRST PARAMETER
	TAD	SSCTR		/ P2		SECOND PARAMETER
	TAD	C00002		/...
	XOR	JMPCMD
	JMS	RELBIN
	LAC	EXPSPC	/SET GATE IN EXP560 TO OUTPUT INDIRECT ADDRESS
	DAC	CALLSW	/TO ARRAYS IN THIS PARAMETER LIST
EXP018	ISZ	TARGI	/ ..
	ISZ	TOPI		/ PN           NTH PARAMETER
	LAC*	TARGI
	JMS	EXP720
	LAC*	TOPI
	AND	S00077
	SAD	C00032
	SKP
	JMP	EXP018	/AFTER THE LAST PARAMETER HAS BEEN OUTPUT,
	LAC	EXPDIR	/RESET CALL OF ARRAY GATE
	DAC	CALLSW	/(ALSO RESET AT ERRAC+1, IN CASE OF ERROR)
EXP002	LAC*	OPI		/THE FUNCTION CALL IS COMPLETE
	DAC	SIGNA2
	AND	W00000	/THE LIST IS PUSHED UP AS THE FUNCTION
	XOR*	NOP
	DAC*	OPI		/REFERENCE (INCLUDING THE PARAMETER LIST)
	LAC	MODEA2		/IS REPLACED WITH THE ACCUMULATOR AS
	DAC*	ARGI
	JMS	SETA2		/ARGUMENT 2. THE NEXT OPERATOR IS THE LAST
	LAC	OPI	/ONE OBTAINED. THE MODE AND THE SIGN OF THE 
	DAC	POP	/FUNCTION NAME ARE RETAINED AS THE MODE
	LAC	ARGI
	JMP	EXP020	/AND SIGN OF THE ACCUMULATOR.
EXP008	LAC	IDXNOP	/THE INSTRUCTIONS GENERATED AS THE RESULT
	SAD	C00001	/OF THE REPLACEMENT (=) OPERATOR BEING
	SKP		/USED ARE DEFERRED UNTIL ALL THE CODE TO
	JMP	EXP010	/THE RIGHT OF THE OPERATOR HAS BEEN EXAMINED.
	LAC	ASSTMT	/EQUAL SIGN OPERATORS ARE ALLOWED ONLY IN ASSIGNMENT 
	ERS  32X,SZA,EX	/STMNT; OTHER LEGAL USES NOT TREATED IN THIS SUBR.
	LAC	IDXPOP	/
	SAD	C00001	/MULTIPLE EQUAL SIGNS ARE ALLOWED AS LONG
	JMP	EXP08A	/AS SUCCESSIVE ASSIGNMENT ARGUMENTS ARE
	LAC	POP		/NOT EXPRESSIONS.
	ERS	14X,<SAD OP0>,EX	/ERROR: EXPRESSION LEFT OF =
	JMP	EXP011
EXP08A	LAC*	ARG1	/MAKE SURE THAT THE ARGUMENT THAT A VALUE
	AND	Z00000	/IS ASSIGNED TO IN A MULTIPLE ASSIGNMENT
	SAD	U00000	/IS NOT A CONSTANT
	JMP	EX14X	/IS A CONSTANT - GO ANNOUNCE ERROR
	JMP	EXP011	/NOT A CONSTANT - CONTINUE
UNPCMA	LAC	RWEXPF		/UNPARENTHESIZED COMMAS ARE ONLY LEGAL
	ERN	23X,SNA,EX	/IN AN I/O LIST
	LAC	POP
	ERS	30X,<SAD OP0>,EX	/BETTER BE NO EXPRESSION LEFT!
EXP010	LAC	POP		/THE EXPRESSION IS COMPLETLY DECODED WHEN
	SAD	OP0		/THE PREVIOUS OPERATOR HAS BEEN PUSHED UP
	SKP		/TO THE BEGINNING OF THE LIST.
	JMP	EXP022
	LAC	RWEXPF
	SZA		/IF WE ARE IN AN I/O LIST,
	JMP	.+3	/DO NOT LOAD THE RESULT INTO THE AC
	JMS	EXP680	/THE VALUE OF THE EXPRESSION IS ALWAYS
	JMS	EXP670	/LEFT IN THE ACCUMULATOR.
	LAW	-67
	TAD	OPVALU
	TAD	IFFLAG
	SZA		/AN ERROR IS ANNOUNCED IF THE EXPRESSION CONTAINS
	LAC*	BASE0	/MORE RIGHT PARENS THAN LEFT PARENS AND WE ARE
	ERN	15X,SZA,EX	/NOT IN AN "IF" STATEMENT.
	JMP*	EXPRSN
EXP022	LAC	IDXPOP	/THE REPLACEMENT, EXPONENTIATION, AND
	SAD	C00001	/UNARY OPERATORS ARE SEPARATED OUT AND
	JMP	EXP024	/EXAMINED SEPARATELY.
	SAD	C00026
	JMP	EXP025
	SAD	C00004
	JMP	EXP067
	SAD	C00024
	JMP	EXP026
	TAD	Z77750	/**CATCHES UNBALANCED PARENTHESES IN
	ERN	31X,SMA,EX	/**SUBROUTINE CALL PARAMETERS
	DZM	RELOPT
	LAC	MODEA1	/IN GENERAL THE MODES OF THE TWO ARGUMENTS
	SAD	MODEA2	/MUST AGREE.
	JMP	EXP027
	LAC	MODEA1	/SWITCH ARGUMENTS SO THAT THE 
	SNA		/LOWER PRECISION ARGUMENT
	JMP	NOCH	/IS IN ARG1
	SAD	S40000
	JMP	CH
	LAC	MODEA2
	SAD	S60000
	JMP	CH
	SNA
CH	JMS	EXP650	/IF ORDERING OCCURS, THE OPERATION IS REVERSED
NOCH	JMS	EXP610	/.POP. IS
	JMP	EXP032	/ MULTIPLY OR DIVIDE,
	JMP	EXP033	/ ADD OR SUBTRACT, OR
	JMP	EXP034	/ RELATIONAL
	ERX	16V,EV	/ERROR: LOG OP WITH NON-INTEGER ARGS
EXP032	LAC	SIGNA2	/THE SIGN OF THE ACCUMULATOR AFTER THE
	XOR	SIGNA1	/MULTIPLICATION OR DIVISION IS PERFORMED
	DAC	SIGNA2	/IS POSITIVE IF BOTH ARGUMENT SIGNS ARE
	JMP	EXP035	/ALIKE AND NEGATIVE IF DIFFERENT.
EXP034	LAC	IDXPOP	/RELATIONAL OPERATIONS ARE EVALUATED BY
	TAD	RELOPC	/SUBTRACTING THE TWO ARGUMENTS AND
	DAC	RELOPT	/EXAMINING THE RESULT. THE ORIGINAL
	LAC	C00012	/OPERATOR IS SAVED FOR FUTURE USE AND THE
	DAC	IDXPOP	/SUBTRACT OPERATOR SUBSTITUTED. SIGN
EXP033	JMS	EXP625	/CONTROL FOR PLUS-MINUS OPERATORS IS USED
EXP035	JMS	EXP690	/SAVE AC IF AC IS ARG2
	LAC	MODEA1
	SAD	S40000
	JMP	EXP037	/IF MODEA1 IS REAL, NO CONVERSION NECESSARY
	JMS	EXP630
	LAC	MODEA2
	DAC	TEMP#
	LAC	MODEA1
	DAC	MODEA2	/SWITCH MODES
	LAC	TEMP
	JMS	EXP740	/GENERATE INSTRUCTION TO CONVERT MODE OF ARG1
	LAC	TEMP
	DAC	MODEA2
	JMS	SETA1	/SET UP NEW ARG1 TO REFLECT MODE CHANGE
EXP037	LAC*	POP		/GENERATED.
	AND	U00000	/WHEN THE ARGUMENT MODES ARE DIFFERENT,
	SNA		/THE REAL ARGUMENT IS ALWAYS LOADED INTO
	JMP	EXP036	/THE ACCUMULATOR AND THE DOUBLE PRECESION
	LAC	IDXPOP	/OPERATION INVOKED.
	SAD	C00012	/REVERSE DIVIDE OR SUBTRACT OPERATIONS
	LAC	C00042	/ARE SET WHEN THE ARGUMENTS WERE
	SAD	C00018	/INTERCHANGED. MULTIPLICATION AND
	LAC	C00039	/ADDITION ARE COMMUTATIVE.
	DAC	IDXPOP	/THE REAL ARGUMENT IS THEN LOADED INTO THE
EXP036=.
	LAC	MODEA1	/INTEGER MODE
	SZA!CLL		/YES
	JMP	EXPKF1	/NO
	LAC	IDXPOP		/SUBTRACT
	SAD	C00012		/NO
	SKP!STL		/YES SET LINK
	SAD	C00042		/REVERSE NO
	SKP			/YES LEAVE LINK 0
	JMP	EXPKF1		/TREAT AS USUAL
	LAC	TYPEA1		/IS ARG1 IN AC
	SZA!RAR		/YES PUT LINK INTO SIGN BIT OF AC
	JMP	EXPKF5		/NO LOAD IT
	XOR	SIGNA2		/RESULT NEGATIVE OF ANSWER IF SUBTRACT
	DAC	SIGNA2
	JMP	EXPKF6
EXPKF5	SPA			/REVERSE SUBTRACT YES
	JMS	EXP650		/NO- INTERCHANGE ARGUMENTS TO MAKE REVERSE
	JMS	EXP630		/LOAD ARG1 INTO AC
EXPKF6	JMS	EXPKFF		/NEGATE ARG1
	LAC	C00015		/CHANGE OPERATION TO TAD
	DAC	IDXPOP
	SKP			/DO NOT LOAD ARG1 AGAIN
EXPKF1	JMS	EXP630	/LOAD ARG1 IF NECESSARY
	JMS	EXP590	/THE INSTRUCTION (.POP.ARG2) IS THEN
	TAD	IDXPOP	/OUTPUT.
	LAC	RELOPT	/WHEN THE ORIGINAL OPERATOR WAS A
	SNA		/RELATIONAL OPERATOR, THE RESULT OF THE
	JMP	EXP038	/SUBTRACTION IS CONVERTED TO ONE OF THE
			/TWO LOGICAL QUANTITIES (.TRUE. OR .FALSE.)
	JMS	GTINAC	/GET A TESTABLE VALUE INTO THE AC
	LAC	SIGNA2
	SPA!CLA		/THE ACCUMULATOR IS NEGATED IF THE
		/SUB-EXPRESSION SIGN IS MINUS.
		/INTEGER NEGATION IS USED TO MAINTAIN
	JMS	EXP570	/A TRUE ZERO RESULT.
	LAC*	RELOPT	/ARG1 - ARG2 TO AC
	
	JMS	ABSBIN	/  XXX    IS...  SPA!SNA!CLA FOR .LE.
	LAC	CLCCMD	/  CLA!CMA  /    SPA!CLA     FOR .LT.
	JMS	ABSBIN	/                SNA!CLA     FOR .EQ.
	DZM	SIGNA2	/                SZA!CLA     FOR .NE.
	CLA!SKP	/                SMA!SZA!CLA     FOR .GT.
EXP038	LAC	MODEA2	/		SMA!CLA	FOR .GE.
EXP066	DAC*	ARG1		/THE SUBEXPRESSION ARG1.POP.ARG2 IS
	JMS	SETA2		/REMOVED FROM THE LISTS AND REPLACED WITH
	LAC*	NOP		/A NEW ARG1, NOP, AND THE ACCUMULATOR.
	AND	T77777
	DAC*	POP		/THE LIST INDICES ARE PUSHED UP AND THE
	LAC	SIGNA2	/NEW VALUES ASSOCIATED WITH THE
	AND	W00000	/ ARG1.POP.ARG2.NOP. SEQUENCE ARE UPDATED.
	XOR*	POP
	DAC*	POP
	LAC	ARG1
EXP020	DAC	ARG2
	DAC	ARGI
	TAD	K00001
	DAC	ARG1
	LAC	POP
	DAC	NOP
	DAC	OPI
	TAD	K00001
	JMS	EXP640
	JMP	EXP003
EXP027	JMS	EXP610	/WHEN THE ARGUMENT MODES AGREE, POP IS
	JMP	EXP041	/DETERMINED TO BE...MULTIPLY-DIVIDE
	JMP	EXP042	/                ...ADD OR SUBTRACT
	JMP	EXP043	/                ...RELATIONAL
	LAC	MODEA2	/                ...LOGICAL
	ERN	19V,SZA,EV
	JMS	EXP520	/TAKE CARE OF THE SIGNS AND LOAD ARG1
EXP046	LAC	IDXPOP	/GET THE OPERATOR
	SAD	C00002	/IS IT .OR.?
	JMP	EXP047	/.OR. IS A FUDGE
	JMS	OPOPA2	/OUTPUT .POP.ARG2
	LAC*	ARG2
	JMP	EXP038	/MOVE DOWN LISTS AND KEEP GOING
EXP047	LAC	LMQCMD	/(RKB-063) OUTPUT	LMQ
	JMS	ABSBIN	/(RKB-063)
	JMS	EXP590	/(RKB-063)			LAC	ARG2
	TAD	C00004
	LAC	OMQCMD	/(RKB-063)			OMQ
	JMS	ABSBIN	/(RKB-063)
	JMP	EXP038
EXP041	LAC	TYPEA2	/THE ARGUMENTS ARE INTERCHANGED AND THE OPERATOR
	SNA		/REVERSED IF ARGUMENT 2 IS THE ACCUMULATOR.
	JMS	EXP650
	LAC	SIGNA2	/THE SIGNS OF THE ARGUMENTS YIELD THE SIGN
	XOR	SIGNA1	/OF THE RESULT.
	DAC	SIGNA2
	JMP	EXP037
EXP043	LAC	IDXPOP
	TAD	RELOPC	/RELATIONAL OPERATIONS ARE EVALUATED BY
	DAC	RELOPT	/FIRST SUBTRACTING THE TWO ARGUMENTS AND
	LAC	C00012	/THEN EXAMINING THE RESULT FOR NEGATIVE,
	DAC	IDXPOP	/ZERO, OR POSITIVE.
EXP042	LAC	TYPEA2
	SNA		/THE ARGUMENTS OF A SUB-EXPRESSION
	JMS	EXP650	/CONTAINING A PLUS OR MINUS OPERATOR ARE
	JMS	EXP625		/PROCESSED BY THE SIGN CONTROL ROUTINE, AND
	JMP	EXP037	/THE PROPER INSTRUCTION IS GENERATED.
EXP024	JMS	EXP680	/ARGUMENT 2 IS LOADED INTO THE ACCUMULATOR
	JMS	EXP670	/AND NEGATED IF NECESSARY.
	LAC*	POP
	AND	U00000		/CHECK FOR THE "REVERSE =" OPERATOR
	SZA
	JMP	PTWEQU	/THIS IS THE "PARTWORD STORE" OP
	LAC	MODEA1
	JMS	EXP740		/CONVERT MODES ACROSS THE EQUAL SIGN
	JMS	EXP600
	JMS	EXP590
	TAD	C00008
EXP040	LAC	SIGNA2
	ERN	21V,SPA,EV	/ERROR IF ASSIGNMENT VAR SIGNED
	JMP	EXP038
EXP025	LAC	MODEA1
	JMS	COMBIN		/COMBINE MODEA1 AND MODEA2 TO GET
	TAD	PWRTAB		/AN INDEX INTO THE EXPONENTIATION TABLE
	DAC	GETPWR
GETPWR	OPR			/GET THE PROPER EXPONENTIATION ROUTINE NAME
	SZA	/CONVERSION NECESSARY?
	JMP	EXPOK
	JMS	EXP520	/YES.THEN MAKE BASE REAL.
	JMS	EXP600
	LAC	S20000
	JMS	EXP740
	JMS	EXP600
	LAC	S20000	/REAL AC
	JMS	SETA1	/BECOMES ARG1
	JMP	EXP025	/TRY IT AGAIN
EXPOK	AND	S17777
	DAC	OPTEMP		/SAVE IT IN THE REPLACEABLE OPERATOR
	JMS	EXP520	/TAKE CARE OF THE SIGNS AND LOAD ARG1
	LAW	-2		/GENERATE:
	JMS	OPOPA2		/JMS* OP
	LAC*	ARG2		/(WHERE OP = -2 = REPLACEABLE OPERATOR)
	XCT	GETPWR		/FETCH THE ROUTINE NAME AGAIN
	AND	S60000		/GET THE MODE OF THE RESULT
	JMP	EXP066		/FROM THE TABLE OF EXPONENTIAL OPERATORS
EXP026	LAC	SIGNA2	/UNARY MINUS SIMPLY CAUSES THE SIGN
	CMA	/OF ARG2 TO BE REVERSED
	DAC	SIGNA2
	LAC*	ARG2
	JMP	EXP038+1	/GO PURGE THE ARG-OP LIST
/
EXP067	LAC	MODEA2	/THE .NOT. OPERATOR IS NOT LEGAL IF ITS
	ERN	25V,SZA,EV	/OPERAND IS NOT INTEGER OR LOGICAL
	JMS	EXP710	/STORE ARG1 IF IT WAS IN THE ACCUMULATOR
	JMS	EXP680	/FORCE ARG2 INTO THE ACCUMULATOR
	JMS	EXP670	/NEGATE THE ACCUMULATOR IF NECESSARY
	LAC	CMACMD
	JMS	ABSBIN	/.NOT. GENERATES A "CMA" COMMAND
	JMP	EXP038
	.EJECT
/ SUBROUTINE TO FETCH ARGUMENT 2 AND NEXT OPERATOR (ARG2 AND NOP)
/
FA2NOP	CAL	0
	JMS	FARGOP	/THE NEXT ARGUMENT-OPERATOR PAIR IS
	JMS	ENTER		/FETCHED AND ENTERED INTO THE ARG-OP LISTS.
	LAC	ARGI
	DAC	ARG2
	LAC*	ARG2
	JMS	SETA2		/ARGUMENT2 CONSISTS OF ARG(I) LIST ADDRESS
	LAC	OP		/SYMBOL/CONSTANT TABLE ADDRESS, TYPE OF
	DAC	SIGNA2	/ARGUMENT (SYMBOLIC, CONSTANT, SUBSCRIPTED
	AND	T77700	/VARIABLE, FUNCTION OR UNARY), SIGN OF THE
	DAC	LEVNOP	/ARGUMENT, AND MODE (INTEGER, REAL, DOUBLE
	LAC	OP		/PRECESION, OR LOGICAL) OF THE ARGUMENT.
	AND	S00077	/NEXT OPERATOR CONSISTS OF OP(I) LIST
	DAC	IDXNOP	/ADDRESS, LEVEL VALUE (HEIRARCHY NUMBER
	LAC	OPI		/PLUS CURRENT PARENTHESIS LEVEL COUNT).
	DAC	NOP		/AND OPERATOR VALUE (INDEX ON OPERATOR
	JMP*	FA2NOP	/TRANSLATION TABLE).
/
/SUBROUTINE TO GET A VALUE INTO THE AC WHICH CAN BE TESTED
/ FOR POSITIVE, ZERO, AND NEGATIVE
/
GTINAC	CAL	0
	LAC	MODEA2
	SNA
	JMP*	GTINAC	/IF EXPR IS INTEGER OR LOGICAL, DO NOTHING
	SAD	S60000
	JMP	DIINAC	/DOUBLE INTEGER - NORMALIZE IT
	LAC	ACCMNE	/GENERATE A   "LAC* .AB" INSTRUCTION
	JMS	EXP580
	.IFUND	%FPP
	XOR	LACCMD
	.ENDC
	.IFDEF	%FPP
	XOR	JMSCMD	/(OR A "JMS* .ZA" IF IN FPP MODE)
	.ENDC
	JMP*	GTINAC	/RETURN
DIINAC	NOP
	.IFUND %FPP
	LAC	NORM18
	JMS	ABSBIN	/OUTPUT NORM-18 INST
	.ENDC
	.IFDEF %FPP
	LAC	ZE
	JMS	EXP580	/OR JMS* .ZE
	XOR	JMSCMD
	.ENDC
	JMP*	GTINAC
ZE	131425
	.EJECT
/ SUBROUTINE TO FETCH UNSIGNED INTEGER ARGUMENT (SIMPLE VARIABLES ONLY)
/
FIARGO	CAL	0
	LAC	K00001	/THE LAST ELEMENT IS INITIALIZED TO
	DAC	TFAO01	/DISALLOW UNARY OPERATORS.
	JMS	FARGOP
	LAC*	ARG	/THE ARGUMENT MUST BE A SCALAR,
	SMA		/THEREFORE ITS TYPE MUST BE EITHER 0,1 OR 3
	SAD	U00000
	SKP		/ALL OTHER TYPES ARE ILLEGAL
	LAC	NAME0	/IN ADDITION, IT MUST BE AN INTEGER - THEREFORE
	ERN	06S,SZA,ES	/ITS MODE MUST BE 0
	JMP*	FIARGO
	.EJECT
/	PART WORD ROUTINES
/COME HERE WHEN PARTWORD OP IS ABOUT TO BE PUT IN ARG-OP LIST
EXPART	JMS	PTWDNM		/GET FIRST BIT NUMBER
	DAC	PTM
	LAC	CHAR
	ERS	01P,<SAD S00051>,EP	/BETTER TERMINATE WITH :
	JMS	PTWDNM		/GET LAST BIT NUMBER
	DAC	PTN
	LAC	CHAR
	ERS	02P,<SAD S00053>,EP	/BETTER END WITH ]
	LAW	-44
	TAD	PTN
	ERN	03P,SMA,EP	/LART BIT NUM SHOULD BE <=35
	CMA
	DAC	PTWDNM		/SAVE 35-N TEMPORARILY
	LAC	PTM
	JMS	TWOCMA
	TAD	PTN
	ERN	04P,SPA,EP	/FIRST BIT NUM SHOULD BE <= LAST
	DAC	PTM		/ALSO SAVE TEMPORARILY
	LAC	C00009
	JMS	SHIFT
	LAC	PTM		/SHIFT N-M LEFT 9
	DAC	PTM
	TAD	Z60000
	SMA!SZA!CLA		/SET HIGH ORDER BIT ON IF N-M>16
	LAC	V56000		/SET BITS 1-8 TO THE WIDTH OF THE FIELD
	TAD	PTM		/(MINUS 18 IF HIGH ORDER BIT ON)
	TAD	S01000		/ADD A LITTLE BIAS TO KEEP IT POSITIVE
	XOR	PTWDNM
	DAC	PTN		/SAVE PARTWORD PARAMETER WORD
	LAC	C00032
	DAC	TFAO01		/PRESET TFAO01(LAST OP) TO F)
	JMS	FARGOP		/(FUNCT CLOSE PAREN) AND GET NEXT ARG/OP
	LAC	OP
	DAC*	OPI		/REPLACE THE [ OPERATOR BY THIS OPERATOR
	AND	T77700
	DAC	LEVNOP
	LAC	OP
	AND	S00077
	DAC	IDXNOP
	SAD	C00001		/IS THE NEXT OP AN EQUAL SIGN?
	JMP	PTWLFT		/YES - PARTWORD STORE NECESSARY
	LAC	SIGNA2		/GENERATE PARTWORD LOAD - FIRST FORCE THE
	SPA			/CURRENT EXPRESSION POSITIVE AND INTO
	JMS	EXP680		/A STORAGE LOCATION
	JMS	EXP690
	LAC	PTWDOP
	JMS	OPOPA2		/THEN GENERATE	JMS*	.PB
	LAC*	ARG2		/			.DSA	ARG
	LAC	PTN		/			.DSA	PARTWORD PARAM
	JMS	FPPOUT
	DZM	SIGNA2
	LAC	PTN
	SPA!CLA
	LAC	S60000		/MODE OF RESULT IS INTEGER IF N-M<=16,
	DAC	MODEA2		/DOUBLE INTEGER OTHERWISE
	DZM	TYPEA2		/RESULT IN AC
	DAC*	ARG2
	JMP	EXP003		/CONTINUE EXPRESSION SCAN
PTWDOP	PARTLD-OPTRAN-1
PTWLFT	LAC	PTN		/PARTWORD STORE NECESSARY - SAVE PARAMETER
	DAC	PTNLFT
	LAC*	OPI
	XOR	U00000		/CHANGE "=" TO "REVERSE ="
	DAC*	OPI
	JMP	EXP003	/CONTINUE SCAN
/
/ROUTINE TO ACCUMULATE A SMALL INTEGER
/
PTWDNM	CAL	0
	JMS	FNBCHR
	ERN	05P,<JMS NUMTST>,EP	/ERROR IF NOT DIGIT
	DAC	TARGI		/SAVE IT AWAY
	JMS	FNBCHR
	JMS	NUMTST		/NEXT CHAR A DIGIT?
	JMP	PTW001		/NO - EXIT
	DAC	TOPI
	LAC	TARGI
	RCL
	RAL
	TAD	TARGI		/ACCUMULATE DIGIT1*10+DIGIT2
	RAL
	TAD	TOPI
	DAC	TARGI
	JMS	FNBCHR		/GET NEXT CHAR BLINDLY
PTW001	LAC	TARGI
	JMP*	PTWDNM		/EXIT WITH NUMBER IN AC
/GO HERE TO GENERATE PARTWORD STORE CODE
PTWEQU	LAC	S60000
	JMS	EXP740		/CONVERT AC TO DOUBLE INTEGER
	LAC	PTWDST
	JMS	OPOPA2		/GENERATE	JMS*	.PC
	LAC*	ARG1		/		.DSA	ARG
	LAC	PTNLFT		/		.DSA	PARAMETER WORD
	JMS	FPPOUT
	JMP	EXP040		/RESUME "=" PROCESSING
PTM	0
PTN	0
PTNLFT	0
PTWDST	PARTST-OPTRAN-1
V56000	356000
	.EJECT
VARSIZ=ADJFLG
EXSBSC	LAC	SYMTBC
	DAC	SYMTBX	/NAME OF ARRAY = MOST RECENT NAME FOR DDIO
	JMS	SETADR	/THE NUMBER OF STATED SUBSCRIPTS MUST EQUAL
	LAC*	SYMTW5	/SAVE THIS, CAUSE SYMTW5 IS SAME LOCATION AS
	DAC	INTDIV	/EXP540, A SUBROUTINE CALLED BELOW
	ISZ	SSCTR	/THE NUMBER OF DECLARED SUBSCRIPTS.
	JMS	SUBCNT
	JMS	EXP540	/SAVE ARGI AND OPI IN TARGI AND TOPI
	LAC*	ARGI
	JMS	SETA2	/SYMTBC IS RESET, BUT NOT YET SYMTW5 OR SYMTW6
	DAC	EXSBMD	/PUT ARRAY INTO ARG2 AND SAVE MODE FOR LATER
	JMS	SETN	/COMPUTE NUMBER OF WORDS PER ELEMENT FOR THIS MODE
	DAC	VARSIZ	/TO BE USED IN TWO PLACES BELOW
	DAC	VARSZ2
	LAC	RWEXPF	/THIS IS NON-0 IF IN I/O LIST
	SNA
	JMP	SNGTST	/IF IS ZERO, THEN CHOOSE OPTIMIZATION NORMALLY
	LAC	SSCTR	/WILL NOT OPTIMIZE FOR I/O OF TWO OR THREE DIMEN-
	SAD	C00001	/SIONS, TO SAVE SPACE. NEITHER WILL WE OPTIMIZE
	SKP		/FOR DDIO OUTPUT OF A SINGLE DIMENSION, AS IT
	JMP	.SSOUT	/NEEDS SUBSCRIPT NUMBER, WHICH IT CAN ONLY GET FROM
	LAC	RWFLAG	/.SS PARAMETER LIST.  RWFLAG= 2 IF WRITE.
	RTR		/PUT LINK ON IF WRITE, OFF IF READ
	LAC	SYMTMP	/BITS 0,1,2 OF SYMTMP = 100 IF DDIO
	SAD	W00000	/DDIO?
	SNL		/YES, BUT IS IT OUTPUT?
	JMP	SNGLSS	/NOT DDIO, OR NOT OUTPUT - OPTIMIZE
	JMP	.SSOUT	/ELSE OUTPUT .SS CALL
SNGTST	LAC	SSCTR	/OPTIMIZE FOR ALL ONE DIMENSIONAL REFERENCES
	SAD	C00001
	JMP	SNGLSS
OPTSWC	NOP		/FOR 2 OR 3 DIMENSIONS, SET TO SKIP IF ARE NOT
	JMP	SSOPT	/TO OPTIMIZE.
.SSOUT	LAC	SSCALC
	JMS	EXP580	/OUTPUT		JMS*	.SS
	XOR	JMSCMD
	LAC*	ARGI
	JMS	SETA2
	LAC*	ARGI
	JMS	EXP560
	XOR	W00000		/FORM PARAMETER ADDRESS OF ARRAY
	AND	W77777		/THEN MASK OUT THE MODE BITS
	JMS	VECBIN		/AND OUTPUT THE RESULT
EXSBLP	ISZ	TOPI
	ISZ	TARGI
	JMS	CKSUB
	LAC	C00004
	JMS	OPOPA2	/OUTPUT LAC(*) SN FOR EACH SUBSCRIPT
	LAC*	TARGI
	LAC*	TOPI
	AND	S00077
	SAD	C00030	/ARE WE DONE YET?
	JMP	EXSBLP	/NO
SSDACA	JMS	EXP550	/OUTPUT A "DAC" WITH A STRING ADDRESS
	XOR	DACCMD
	LAC	EXSBMD	/FORM A NEW ARGUMENT OF TYPE 4(STRING),
	XOR	TSTRNG	/WITH THE SAME MODE AS THE ARRAY AND THE ADDRESS
	XOR	W00000	/OF THE GENERATED STRING
	DAC	MODEA2	/AND REPLACE THE ARRAY NAME WITH IT
	JMP	EXP002	/CONTINUE AS IF A FUNCTION WERE BEING PROCESSED
EXSBMD	.DSA	0
/ ONE DIMENSION SUBSCRIPT OPTIMIZATION
SNGLSS	ISZ	TARGI
	ISZ	TOPI
	JMS	CLCTAD	/OUTPUT: CLC; TAD  I
	JMS	SSOPT0	/OUTPUT:  N* THIS RESULT
	JMP	SSTADA	/GO COMPLETE THE CALCULATION-SAME FOR ALL ARRAYS
/ TWO AND THREE DIMENSIONAL SUBSCRIPT OPTIMIZATION
SSOPT	ISZ	TARGI
	ISZ	TOPI
	LAW	-1	/USE TO ADDRESS TEMPORARY LOCATIONS T1,T2,T3
	TAD	AT1
	DAC	TI	/WHERE AT1 CONTAINS ADDRESS OF T1
	LAC*	SYMTW6	/CHECK FOR VARIABLE DIMENSION OF TWO OR 3 IMEN. 
	DAC	T0	/ARRAY, AS INDICATED BY 777777 IN SYMTW5 OR SYMTW6
	SPA
	JMP	VDOPT	/JUMPT TO VARIABLE DIMEN OPTIMIZATION IF NOT POS
	LAC	INTDIV	/(SINGLE DIMENSIONED ARRAYS DON'T WORRY IF VARIABLE
	SPA		/DIMENSIONED, AS THERE IS NO CHECKING ON SS BOUNDS)
	JMP	VDOPT
	JMS	INTDIV	/PROCEED WITH CONSTANT SS OPTIMIZATION,
	LAC	SSCTR	/DIVIDING IMAX*N BY N AND LEAVING IT IN T1. 
	SAD	C00003	/IF ONLY TWO DIMENSIONS, ZERO THIRD DIMEN VALUES,
	JMP	.+4	/AND OUTPUT LAC J.  WILL GENERATE CODE TO COMPUTE
	DZM	T2	/ BASE ADDR + N*[I+IMAX*(J+K*JMAX) + C]
	JMS	LACOUT	/WHER C =  (-1-IMAX-IMAX*JMAX), A CONSTANT, COMPUTED
	JMP	FIN2ND	/BY THE COMPILER. GO FINISH 2 D CASE.
	LAC	T0	/FOR 3 DIMES, COMPUTE IMAX * JMAX BY DIVIDING
	JMS	INTDIV	/SAVED IMAX*JMAX*N BY N. ANS INTO T2, TI BUMPED TO T3
	LAC	T1	/ALSO COMPUTE JMAX
	DAC	VARSZ2	/SET UP AS IF STILL DIVIDING  BY NO. WORDS PER ELEMENT
	LAC	T2
	JMS	INTDIV	/ RESULT IS IN T3, = JMAX
	ISZ	TARGI	/BUMP TO POINT TO K
	ISZ	TOPI
	JMS	LACOUT	/OUTPUT LAC K
	JMS	MULOUT	/OUTPUT MUL, .DSA JMAX, LACQ, TAD J
	JMS	TADOUT
FIN2ND	LAC	AT1	/OUTPUT  MUL, .DSA IMAX, LACQ
	DAC	TI	/ OUTPUT  TAD I
	JMS	MULOUT
	JMS	TADOUT
	LAC	T2	/COMPUTE  -1-IMAX-IMAX*JMAX,  WHER JMAX IS ZERO IF 2D
	TAD	T1
	CMA
	DAC	S	/OUTPUT TAD TO THIS VALUE, AS ENTERED INTO THE CONSTANT
	DZM	NAME0	/TABLE
	JMS	CONSSE
	DAC	T0
	LAC*	T0
	AND	S17777
	XOR	TADCMD
	JMS	RELBIN
	JMS	SSOPT0	/OUTPUT EFFECTIVE N* RESULT OF PRECEDING CALCS
	LAC*	ARGI
	JMS	SETA2
SSTADA	LAC*	ARGI
	JMS	EXP560	/OUTPUT TAD ARRAY
	NOP		/TO PACIFY EXP560, WHICH RETURNS ON NEXT INSTR
	AND	S77777
	XOR	TADCMD
	JMS	RELBIN
	JMP	SSDACA	/GO CLEANUP
/ADJUSTABLE ARRAY SS OPTIMIZATION - ALL CALCULATIONS DONE AT EXECUTION TIME
VDOPT	JMS	CLCTAD	/OUTPUT LAW, TAD I
	DZM	T0
	JMS	SSOPT0	/OUTPUT EFFECTIVE N* INTERMEDIATE RESULT IN AC
	LAC	T0	/IF N WASN'T 3, T0 IS STILL ZERO, AND A TEMP LOCATION
	SNA		/MUST BE CREATED, SUCH THAT IN EITHER CASE T0 HOLDS IT 
	JMS	EXP510	/ADDRESS
	DAC	T0	/SAVE THE ADDRESS OF THE TEMPORARY
	JMS	DCRLTD	/OUTPUT DAC TEMP, LAC WD3 OF ADB, DAC .+4
	TAD	K00002	/FOLLOWED BY  CLC,  TAD J
	ISZ	TI
	DZM*	TI	/MULOUT PICKS UP ZERO AT TI AS SIGNAL TO OUTPUT ABS 0
	JMS	MULOUT	/ANT TO AVOID CHANGIN ARG POINTERS.  OUTPUT
	LAC	T0	/  MUL,  XX,  LACQ,  TAD TEMP
	JMS	TADOUT
	LAC	SSCTR	/CHECK FOR THIRD DIMENSION
	RAR		/CAN'T BE 1, SO IF IS 3, LINK GETS SET
	SNL
	JMP	SSTADA	/ONLY TWO DIMENS, GO CLEAN UP
	JMS	DCRLTD	/OUTPUT DAC TEMP, LAC ADB WD4, DAC .+4
	TAD	K00001	/FOLLOWED BY  CLC,  TAD K
	JMS	MULOUT	/OUTPUT MUL, XX, LACQ
	LAC	T0
	JMS	TADOUT	/OUTPUT TAD TEMP
	JMP	SSTADA	/GO CLEANUP
/
INTDIV	CAL		/DIVIDE  ROUTINE TO REMOVE N FACTOR, WHEN VARSZ2 IS N,
	CLL
	ISZ	TI
	IDIV		/OR TO COMPUT JMAX WHEN IMAX IS IN VARSZ2
VARSZ2	XX
	LACQ
	DAC*	TI	/ARE SUCCESIVLY STORING RESULT IN T1. T2, T3
	JMP*	INTDIV
/
LACOUT	CAL		/OUTPUT LAC TO TARG
	ISZ	TARGI
	ISZ	TOPI
	JMS	CKSUB	/CHECK THAT SUBSCRIPTS ARE INTEGER SCALARS
	LAC	C00004	/ GET LAC COMMAND CODE
	JMS	OPOPA2	/OUTPUT LAC
	LAC*	TARGI	/ TO THIS ARGUMENT
	JMP*	LACOUT
/
CKSUB	CAL
	LAC*	TARGI	/CHECK THAT ALL OF THE SUBSCRIPTS ARE INTEGERS
	JMS	SETA2	/
	ERN	04S,SZA,ES
	ERS	05S,<JMS EXP530>,ES  /AND SCALAR VARIABLES
	JMP*	CKSUB
/
MULOUT	CAL		/OUTPUT  MUL, .DSA VARIABLE OR ZERO, LACQ
	LAC	MULCMD	/EAE+13122
	TAD	S20000	/ !20000; CAUSES AC0 INTO LINK, THEN MUL
	JMS	ABSBIN
	LAC*	TI	/IF COMES UP 0, .DSA 0 IS OUTPUT, AS THIS LOCATION
	JMS	FPPOUT	/IS SET WHEN RUNNING.  ELSE IS JMAX OR IMAX.
	LAC	LAQCMD	//OUTPUT LAQ (TO REPRESEN LACQ)
	JMS	ABSBIN
	LAC*	TI	/DON'T REGRESS POINTERS WHEN DOING ADJUSTABLE
	SNA!CLC		/DIMENSIONS
	JMP*	MULOUT	/ ELSE HAVE SET AC = 777777
	TAD	TOPI
	DAC	TOPI
	LAW	-1
	TAD	TARGI
	DAC	TARGI
	LAC*	TARGI
	JMP*	MULOUT
/
TADOUT	CAL		/OUTPUT TAD TO ARG ADDRESSED BY AC
	DAC	MULOUT
	JMS	SETA2
	LAC	C00015
	JMS	OPOPA2
	LAC	MULOUT
	JMP*	TADOUT
/
SSOPT0	CAL		/OUTPUT EFFECTIVE N* STUFF IN AC
	LAC	VARSIZ	/AS NOTHING IF N= 1, RAL IF N= 2, OR DAC, RAL, TAD
	SAD	C00001	/IF N = 3
	JMP*	SSOPT0
	SAD	C00002	/ 2 DIMENS?
	JMP	RCLOUX	/YES, GO OUT@PUT RCL
	CLA
	JMS	STORET	/CREATE A TEMPORARY
	DAC	T0	/SAVE ITS ADDRESS
	JMS	RCLOUT	/OUTPUT RCL
	LAC	T0
	JMS	TADOUT	/OUTPUT TAD TEMP
	JMP*	SSOPT0
RCLOUX	JMS	RCLOUT	/OUTPUT JUST RCL FO N = 2
	JMP*	SSOPT0
/
RCLOUT	CAL		/OUTPUT RCL
	LAC	RCLCMD
	JMS	ABSBIN
	JMP*	RCLOUT
/
CLCTAD	CAL		/OUTPUT CLC, TAD
	JMS	CKSUB	/CHECK SUBSCRIPT VALIDITY
	LAC	CLCCMD
	JMS	ABSBIN
	LAC	C00015
	JMS	OPOPA2
	LAC*	TARGI
	JMP*	CLCTAD
/
DCRLTD	CAL		/OUT PUT DAC TEMP, LAC ADB WORD, DAC .+4
	LAC	C00008
	JMS	OPOPA2
	LAC	T0
	LAC*	SYMTBX	/ADDRESS OF WORD 5 OF ADB
	XCT*	DCRLTD	/BACK TO 3RD OR 4TH WOTD
	AND	S17777
	XOR	LACCMD
	JMS	RELBIN
	LAC	PC	/COMPUT .+4
	TAD	C00004
	XOR	DACCMD
	JMS	RELBIN
	ISZ	DCRLTD
	ISZ	TARGI
	ISZ	TOPI
	JMS	CLCTAD	/OUTPUT  CLC, TAD J (OR K)
	JMP*	DCRLTD
	.EJECT
/ SUBROUTINE TO OUTPUT .POP.ARG2 INSTRUCTION
/ CALLING SEQUENCE...
/     LAC	OP
/      JMS	OPOPA2
/      LAC	ARG
/
OPOPA2	SYN	FAOMOD
	DZM	ISUBRR
	SAD	C00012		/IS THIS SUBTRACT OR REVERSE SUBTRACT
	JMP	OUTP12		/SUBTRACT
	SAD	C00042		/REVERSE SUBTRACT NO
	JMP	OUTP13		/YES
OUTP07	TAD	OPTRAN	/THE OPCODE INDEX IS CONVERTED TO A REAL
	DAC	TCTR		/INSTRUCTION AND THE ARGUMENT IS DESECTED.
	XCT*	OPOPA2
	JMS	SETA2		/TWO FORMS OF INSTRUCTIONS ARE GENERATED
	LAC*	TCTR		/BY THE COMPILER. THE MAJORITY OF THEM
	.IFDEF	%FPP
	AND	Z70000		/IS THIS INSTRUCTION FPP INSTRUCTION
	SAD	Z10000
	SKP			/YES, OUTPUT IT ACCORDINGLY
	JMP	NONFPP
	LAC*	TCTR
	JMS	FPPOUT
	XCT*	OPOPA2		/GET THE ARGUMENT
	DAC	OBJB04	/SET PARAMETER MODE
	JMS	EXP560
	XOR	W00000	/MAKE A REGULAR SUBROUTINE PARAMETER OUT OF IT
	AND	W77777	/THEN AND OFF THE MODE BITS AND OUTPUT IT
	JMS	VECBIN	/(THE FPP BOX IS FINICKY ABOUT SUCH THINGS)
	DZM	OBJB04	/RESET PARAMETER MODE FLAG
	JMP	OUTP11	/RETURN TO MAINSTREAM
NONFPP	LAC*	TCTR
	.ENDC
	AND	S17777	/ARE SUBROUTINE CALLS. THE OTHER FORM IS
	SNA		/AN ACTUAL MACHINE INSTRUCTION.
	JMP	OUTP01
	TAD	DECPNT	/SUBROUTINED INSTRUCTIONS REQUIRE THAT
	JMS	EXP580	/THE SUBROUTINE NAME BE ENTERED INTO THE
	XOR	JMSCMD	/SYMBOL TABLE AS ENTERNAL FUNCTIONS.
	LAC*	TCTR		/THE OPERAND ADDRESS OF THE INSTRUCTION
	SMA		/IS OUTPUT AS A PARAMETER TO THE SUBROUTINE
	JMP	OUTP02
	LAC	C00004	/THE PARAMETER OF INTEGER OPERATIONS IS
	JMP	OUTP07	/OUTPUT AS A LAC INSTRUCTION.
OUTP02	XCT*	OPOPA2	/PARAMETERS FOR OTHER INSTRUCTIONAL
	JMS	EXP720	/SUBROUTINES ARE OUTPUT AS VECTOR ADDRESSES
OUTP11	LAC	TYPEA2
	SAD	V00000	/ONCE A TEMPORAY STORAGE LOCATION HAS BEEN
	SKP		/USED (I.E. APPEARS AS THE ARGUMENT), IT
	JMP	OUTP03	/MAY BE RELEASED FOR RE-USE
	ISZ	ADDRA2
	LAC*	ADDRA2	/A TEMPORARY STORAGE LOCATION IS RELEASED
	AND	V77777
	SAD	TSD		/ONLY IF IT IS THE LAST ONE CREATED (THE
	JMP	OUTP04	/THEORY BEING THAT TEMP STORAGE IS USED
	SAD	TSR		/IN THE REVERSE ORDER THAT IT IS CREATED).
	JMP	OUTP05
	SAD	TSJ
	JMP	OUTP06
	JMP	OUTP03
OUTP06	TAD	K00001
	DAC	TSJ
	JMP	OUTP03
OUTP04	TAD	K00001	/AS TEMPORARY STORAGE IS CREATED IN A
	DAC	TSD		/SEQUENTIAL MANNER, IT IS RELEASED
	JMP	OUTP03	/SEQUENTIALLY ALSO.
OUTP05	TAD	K00001
	DAC	TSR
OUTP03	JMS	FAKE		/IGNORE THIS INSTRUCTION IF ILLEGAL
	LAC*	ARG2
	JMS	SETA2
	ISZ	ISUBRR
	SKP
	JMS	EXPKFF
	JMP*	OPOPA2
OUTP01	LAC	TYPEA2	/NORMAL INSTRUCTIONS WITH ARGUMENT
	SAD	W00000	/ADDRESSES THAT ARE THE RESULT OF A
			/PREVIOUS CALCULATION (E.G. SUBSCRIPTED
	JMP	OUTP08	/VARIABLES) MUST REFERENCE THAT ADDRESS
	XCT*	OPOPA2	/OTHERWISE THE ADDRESS IS SET UP (ALONG
	JMS	EXP560	/WITH THE INDIRECT BIT IF NECESSARY..
OUTP10	XOR	S20000	/COMMON, DUMMY,ETC.).
	XOR*	TCTR	/THE OPERAND ADDRESS IS MERGED WITH THE
	JMS	RELBIN	/INSTRUCTION AND THE RESULT OUTPUT AS A
	JMP	OUTP11	/RELOCATABLE INSTRUCTION.
OUTP08	LAC	MODEA2	/INDIRECTLY.
	JMS	EXP510	/A TEMPORAY STORAGE LOCATION IS CREATED
	JMS	SETA2	/AND ITS ADDRESS STRUNG TO THE ADDRESS
	XCT*	OPOPA2	/OF THE STORE FOLLOWING THE ADDRESS
	AND	S17777	/CALCULATION.
	JMS	BINOUT
	XOR	C00020	/OUTPUT REFERENCE ADDRESS.
	LAC*	ADDRA2
	AND	S17777
	JMS	BINOUT
	XOR	C00021	/OUTPUT DEFINITION ADDRESS.
	LAC*	ADDRA2	/THE TEMP STORE ADDRESS BECOMES THE
	AND	S17777	/ARGUMENT ADDRESS OF THE INSTRUCTION.
	JMP	OUTP10
OUTP12	CLC		/REGULAR SUBTRACT FLAG
	DAC	ISUBRR
OUTP13	JMS	EXPKFF		/OUTPUT TCA AND ADD
	LAC	C00015
	JMP	OUTP07
	.EJECT
/
/ CONSTANT OR FLOATING INSTRUCTION OUTPUT ROUTINE
/ CALLING SEQUENCE
/	LAC	CONSTANT
/	JMS	FPPOUT
/
FPPOUT	0
	JMS	ABSBIN
FPPTST	JMP*	FPPOUT
/
/
/
/ SUBROUTINE TO ENTER ARG, OP IN ARG(I) AND OP(I) LISTS
/
ENTER	SYN	SYMTW3
	ISZ	ARGI	/LIST ENTRY AD. UPDATE
	LAC	ARGI	/AND CHECKED
	ERN	01T,<SAD ARGEND>,ET	/ERROR: LISTS FULL
	ISZ	OPI
	LAC	ARG		/THE CURRENT ARGUMENT AND OPERATOR PAIR
	DAC*	ARGI		/ARE ENTERED INTO THE NEXT AVAILABLE LIST
	LAC	OP		/POSITION.
	DAC*	OPI
	AND	S00077
	JMP*	ENTER
	.EJECT
/ SUBROUTINE TO SET UP ARGUMENT 1
/ CALLING SEQUENCE...
/      LAC	ARG		/ARGUMENT DESCRIPTION WORD
/      JMS	SETA1		/ARG1 ALREADY CONTAINS ARG(I) ADDRESS
/
SETA1	SYN	SYMTW2		/AN ARGUMENT COSISTS OF...
	DAC	ADDRA1	/ ADDRESS OF ENTRY IN SYMBOL OR CONSTANT
	AND	Z00000	/TABLE.
	DAC	TYPEA1	/ TYPE OF ARGUMENT
	SZA!SMA
	JMP	.+3		/IF THE ARGUMENT IS NOT A VARIABLE OR
	LAC	ADDRA1	/CONSTANT, THE MODE IS CARRIED IN THE
	SKP		/ORIGINAL DESCRIPTION WORD.
	LAC*	ADDRA1
	AND	S60000
	DAC	MODEA1	/ MODE OF ARGUMENT
	JMP*	SETA1		/ SIGN(ARG1) IS HANDLED INDEPENDANTLY
/
/
/
/ SUBROUTINE TO SET UP ARGUMENT 2
/ CALLING SEQUENCE...
/      LAC	ARG		/ARGUMENT DESCRIPTION WORD
/      JMS	SETA2		/ARG2 ALREADY CONTAINS ARG(I) ADDRESS
/
SETA2	SYN	SYMT2A		/AN ARGUMENT CONSISTS OF...
	DAC	ADDRA2	/ ADDRESS OF ENTRY IN SYMBOL OR CONSTANT
	DAC	SYMTBC	/TABLE.
	AND	Z00000
	DAC	TYPEA2	/ TYPE OF ARGUMENT
	SZA!SMA
	JMP	.+3		/IF THE ARGUMENT TYPE IS NOT A VARIABLE OR
	LAC	ADDRA2	/CONSTANT, THE MODE IS CARRIED IN THE
	JMP	.+3
	JMS	FAKE
	LAC*	ADDRA2
	AND	S60000
	DAC	MODEA2	/ MODE OF ARGUMENT
	JMP*	SETA2		/ SIGN(ARG2) IS HANDLED INDEPENDANTLY
	.EJECT
/ SUBROUTINE TO TEMPORARILY STORE THE CURRENT ACCUMULATOR
/ CALLING SEQUENCE...
/      LAC	MODE
/      JMS	STORET
/
STORET	CAL	0
	JMS	EXP510	/A TEMPORARY STORAGE LOCATION IS CREATED
	DAC	ARG		/AND SUBSTITUTED FOR THE ACCUMULATOR AS
	JMS	GETMOD		/GET THE OPERATOR INCREMENT
	LAC	NAME0		/FROM THE MODE OF NAME0
	TAD	C00008	/MODE OF THE ARGUMENT) AND A STORE
	JMS	OPOPA2	/INSTRUCTION INSERTED INTO THE COMMAND
	LAC	ARG		/SEQUENCE.
	XOR	U00000	/THE ARGUMENT TYPE IS CHANGED FROM SIMPLE
	JMP*	STORET	/VARIABLE TO TEMPORARY STORAGE.
/
/
/
/ SUBROUTINE TO OUTPUT STRING CODES (ADDRESS TO PC)
/ CALLING SEQUENCE...
/      LAC	STRING ADDR
/      JMS	STRING
/
STRING	CAL	0
	AND	S17777
	JMS	BINOUT
	XOR	C00020	/OUTPUT REFERENCE ADDRESS
	LAC	PC
	JMS	BINOUT
	XOR	C00021	/OUTPUT DEFINITION ADDRESS
	JMP*	STRING
	.EJECT
/ SUBROUTINE TO OUTPUT RELOCATABLE INSTRUCTIONS
/ CALLING SEQUENCE...
/      LAC	INSTRUCTION
/      JMS	RELBIN
/
RELBIN	SYN	FMS
	JMS	BINOUT	/THE BINARY WORD IS OUTPUT AS A RELOCATABLE
	XOR	C00003	/INSTRUCTION.
	JMP*	RELBIN	/LOADER CODE 03.
/
/
/ SUBROUTINE TO OUTPUT INSTRUCTION WITH AN ADDRESS TAKEN FROM
/ THE CURRENTLY-POINTED-TO SYMBOL TABLE ENTRY (SYMTBC)
/ CALLING SEQUENCE...
/	JMS	SYMBIN
/	XOR	INSTRUCTION
/
/
SYMBIN	SYN	FLS
	LAC*	SYMTBC
	AND	S17777	/GET ADDRESS OF SYMBOL
	XCT*	SYMBIN	/MUSH IN THE INSTRUCTION
	JMS	RELBIN	/OUTPUT THE MESS
	JMP*	SYMBIN	/RETURN
/
/
/
/ SUBROUTINE TO OUTPUT ABSOLUTE BINARY CODE
/ CALLING SEQUENCE...
/      LAC	BINARY WORD
/      JMS	ABSBIN
/
ABSBIN	SYN	ENTFLG
	JMS	BINOUT	/THE BINARY WORD IS OUTPUT AS AN ABSOLUTE
	XOR	C00004	/INSTRUCTION, CONSTANT, OR ADDRESS.
	JMP*	ABSBIN	/LOADER CODE 04
	.EJECT
/ SUBROUTINE TO CREATE TEMPORARY STORAGE
/ CALLING SEQUENCE...
/      LAC	MODE
/      JMS	EXP510
/
EXP510	CAL	0
	DAC	NAME0		/THE MODE OF THE ACCUMULATOR DETERMINES THE
	JMS	RTLAND		/MODE OF THE TEMPORARY STORAGE IN WHICH THE
	TAD	PTSI		/ACCUMULATOR IS TO BE STORED.
	DAC	NAME1
	ISZ*	NAME1
	LAC*	NAME1
	DAC	NAME1		/A NAME IS GENERATED FOR EACH OF THE THREE
	LAC	STAF		/NAME TEMP STORAGE DIFFERENTLY IF A
	DAC	NAME2		/STATEMENT FUNCTION IS BEING PROCESSED
	JMS	SYMBSE	/TEMP STORAGE TYPES AND ENTERED INTO THE
	LAC	SYMTBC	/SYMBOL TABLE. (I,L=.AN , R=.BN , D=.CN ..
	XOR	T00000	/WHERE N IS THE NTH GENERATED NAME). THIS
	JMP*	EXP510	/NAME REPLACES THE ACC AS THE ARGUMENT.
PTSI	.DSA	TSI	/POINTER TO ARRAY OF TEMPORARY NAMES
TSI	.DSA	0	/INTEGER TEMPORARY NAME
TSR	.DSA	0	/REAL  TEMPORARY NAME
TSD	.DSA	0	/DOUBLE PRECISION TEMPORARY NAME
TSJ	.DSA	0
/
/
/ SUBROUTINE TO TAKE CARE OF ARGUMENT SIGNS AND LOAD ARG1
/
EXP520	CAL	0
	LAC	SIGNA2
	SMA		/ARG2 NEGATIVE?
	JMP	.+3	/NO
	JMS	EXP710	/YES - STORE ARG1 IF NECESSARY
	JMS	EXP680	/LOAD ARG2
	JMS	EXP690	/SAVE ARG2(FIXING SIGN) IF ARG2 IS IN THE AC
	JMS	EXP630	/LOAD ARG1
	JMS	EXP700	/NEGATE ARG1 IF NECESSARY
	JMP*	EXP520
/
/
RTLAND	0
	RTL
	RTL
	RTL
	AND	C00003
	JMP*	RTLAND
	.EJECT
/ SUBROUTINE TO CHECK FOR UNSUBSCRIPTED ARRAY REFERENCE OR FUNCTION
/ REFERENCE WITHOUT A PARAMETER LIST
/ CALLING SEQUENCE...
/      JMS	EXP530
/      JMP	NEITHER
/      XXX    FUNCTION
/
EXP530	SYN	SYMTW4
	LAC	TYPEA2	/WHEN FUNCTION PARAMETER LISTS ARE NOT
	SAD	T00000	/INDICATED, THE ARGUMENT IS EXAMINED TO
	SKP		/PREVENT FUNCTION AND ARRAY NAMES FROM
	JMP*	EXP530	/BEING USED AS SIMPLE VARIABLES.
	LAC*	ADDRA2	/I.E., WITHOUT PARAMETER OR
	AND	Z00000	/SUBSCRIPT LISTS
	SMA			/THE ILLEGAL TYPE FIELDS IN THE SYMBOL TABLE
	SAD	U00000	/ARE: 2,4,5,6 AND 7
	ISZ	EXP530	/SKIP IF BAD
	JMP*	EXP530	/RETURN
/
/
/
/ SUBROUTINE TO TEMPORIARLY STORE ARG(I) AND OP(I) INDICES
/
EXP540	SYN	SYMTW5
	LAC	ARGI
	DAC	TARGI		/ARG(I) TO TEMP
	LAC	OPI
	DAC	TOPI		/OP(I) TO TEMP
	JMP*	EXP540
/
/
/
/ SUBROUTINE TO OUTPUT AN INSTRUCTION WITH A STRING ADDRESS
/ CALLING SEQUENCE...
/      JMS	EXP550
/      XOR	INSTRUCTION
/
EXP550	SYN	S
	LAC	PC		/THE STRING ADDRESS IS THE CURRENT VALUE
	DAC	TSTRNG	/OF THE PROGRAM COUNTER.
	XCT*	EXP550	/THIS TOGETHER WITH THE INSTRUCTION IS
	JMS	RELBIN	/OUTPUT AS A RELOCATABLE INSTRUCTION
	LAC	TSTRNG	/(LOADER CODE 03).
	ISZ	EXP550
	JMP*	EXP550
	.EJECT
/ SUBROUTINE TO SET UP A PARAMETER OR INSTRUCTION
/ CALLING SEQUENCE...
/      LAC	ARG
/      JMS	EXP560
/      XOR	INDIRECT BIT
/
EXP560	SYN	MS		/PARAMETERS MAY BE VARIABLES, CONSTANTS,
	DAC	SYMTBC		/TEMPORARY STORAGE, OR STRING ARGUMENTS.
	SMA!SZA	/WE MAY HAVE TO GET THE MODE
	LAC*	SYMTBC	/INDIRECTLY
	AND	S60000		/EXTRACT MODE
	RCL
	RAL
	DAC	MODEXX	/SHIFT IT TO BITS 1,2 AND SAVE IT
	LAC	SYMTBC
	AND	Z00000
	SAD	T00000	/CONSTANTS AND TEMPORARY STORAGE ARE
	JMP	EXP561	/LOCALLY DEFINED AND AS SUCH ARE OUTPUT AS
	SAD	W00000	/DIRECT ADDRESSES.
	JMP	EXP562
EXP563	LAC*	SYMTBC
	AND	S17777
EXP565	OPR	/**MBOX**TAD	MODEXX		/ADD IN MODE BITS
EXP564	ISZ	EXP560
	JMP*	EXP560	/SORT OUT VARIOUS SYMBOL TYPES, CHOSING EXP565
EXP561	LAC*	SYMTBC	/IF NO INDIRECT BITS.  ARRAYS ARE SPECIAL -
	LRS	17	/ IF WE ARE IN A SUBR. OR FUNC. CALL, CALLSW
	TAD	EQEXP	/ADDRESSES 'SPECAL', WHICH FORCES INDIRECT IN
	DAC	RTLAND	/BIT 0.  THIS GIVES TRUE CALL BY REFERENCE.
	LAC*	SYMTBC
	AND	S17777
	JMP*	RTLAND
EQEXP	.DSA	EXPTAB	/ ADDRESS OF TABLE
EXPSPC	JMP	SPECAL	/ SET  INTO CALLSW WHEN FUNC. OR SUBR. CALL
CALLSW	JMP	EXP565	/ INITIALLY DIRECT, DEFAULT FOR ARRAYS
EXPDIR	JMP	EXP565	/ USED TO RESET CALL SW TO DEFAULT
EXPTAB	JMP	EXP565	/0 - LOCAL SCALAR
	JMP	INDIR	/1 - COMMON SCALAR
	JMP	INDIR	/2 - EXTERNAL FUNCTION
	JMP	INDIR	/3 - DUMMY SCALAR (ALSO STMNT NUMBER)
	JMP	CALLSW	/4 - LOCAL ARRAY
	JMP	CALLSW	/5 - COMMON ARRAY
	JMP	EXP565	/6 - INTERNAL (STATEMENT) FUNCTION
	JMP	CALLSW	/7 - DUMMY ARRAY
SPECAL	XOR	W00000	/FORCE INDIRECT OF ARRAY WHEN IN A SUBR. OR
	JMP	EXP565	/FUNCTION CALL.
INDIR	XCT*	EXP560	/IMPOSE ACTUAL INDIRECT BIT.
	JMP	EXP565
EXP562	LAC	SYMTBC
	JMS	STRING	/STRING CODE ARGUMENTS ARE OUTPUT AS THE
	JMP	EXP564	/CURRENT PROGRAM COUNTER.
MODEXX	.DSA	0
	.EJECT
/ SUBROUTINE TO GENERATE COMMANDS TO NEGATE THE ACCUMULATOR
/ CALLING SEQUENCE...
/      LAC	MODE
/      JMS	EXP570
/
EXP570	SYN	LS
	SZA
	JMP	EXP571
	JMS	EXPKFF		/OUTPUT TCA
	JMP*	EXP570	/COMPLEMENT PLUS ONE.
EXP571	SAD	S60000
	JMP	EXP572
	LAC	OPTR25	/THE REAL AND DOUBLE PRECESION ACCUMULATOR
	SKP
EXP572	LAC	DBLNEG
	.IFDEF	%FPP
	JMS	FPPOUT
	CLA
	JMS	FPPOUT		/FLOATING INSTRUCTIONS ARE ALWAYS TWO WORDS 
	.ENDC
	.IFUND	%FPP
	JMS	EXP580
	XOR	JMSCMD
	.ENDC
	JMP*	EXP570
/
/
/SUBROUTINE TO OUTPUT A TCA INSTRUCTION
/
EXPKFF	0
	LAC	TCACMD
	JMS	ABSBIN
	JMP*	EXPKFF
	.EJECT
/ SUBROUTINE TO OUTPUT COMPILER GENERATED SUBROUTINE CALLS
/ CALLING SEQUENCE...
/      LAC	SUBROUTINE NAME
/      JMS	EXP580
/      XOR	COMMAND
EXP580	SYN	TMS
	DAC	NAME1		/THE SUBROUTINE NAME IS ENTERED INTO THE
	DZM	NAME2
	LAC	U00000	/SYMBOL TABLE AS AN EXTERNAL FUNCTION.
	DAC	NAME0
	JMS	SYMBSE	/THE ADDRESS ASSIGNED TO THE TRANSFER
	LAC*	SYMTBC	/VECTOR IS MERGED WITH A JMS( INSTRUCTION
	AND	S17777	/AND OUTPUT AS THE CALL TO THE SUBROUTINE.
	XCT*	EXP580
	XOR	S20000	/THE NAMES OF COMPILER CALLED SUBROUTINES
	JMS	RELBIN	/ARE THREE CHARACTERS IN LENGTH AND ALWAYS
	JMP*	EXP580	/BEGIN WITH A PERIOD. E.G. .AA
	.EJECT
/ SUBROUTINE TO OUTPUT   .OP. ARG2 INSTRUCTION BASED ON MODE
/ CALLING SEQUENCE...
/      JMS	EXP590
/      TAD	OPERATION
/
EXP590	SYN	TLS
	JMS	GETMOD	/GET THE OPERATOR MODE INCREMENT
	LAC	MODEA2	/FROM THE MODE OF ARGUMENT 2
	XCT*	EXP590
	JMS	OPOPA2	/THE .OP. ARG2 INSTRUCTION IS THEN OUTPUT.
	LAC*	ARG2
	JMP*	EXP590
/
/ SUBROUTINE TO COMPUTE OPERATOR OFFSET FROM MODE
/
GETMOD	CAL	0
	XCT*	GETMOD	/GET THE ARGUMENT
	JMS	RTLAND
	SAD	C00003	/IF IT IS DOUBLE INTEGER
	LAC	DIFDGE	/LOAD A SPECIAL DOUBLE INTEGER FUDGE VALUE
	ISZ	GETMOD
	JMP*	GETMOD
DIFDGE	.DSA	DIOPS-OPTRAN-5
/
/
/ SUBROUTINE TO INTERCHANGE ARGUMENT 1 AND ARGUMENT 2
/
EXP600	SYN	SYMTW6
	LAC*	ARG2		/ARGUMENT 1 AND ARGUMENT 2 ARE ORDERED
	DAC	TARGI		/(INTERCHANGED) TO OBTAIN A MORE
	LAC*	ARG1		/EFFICIENT CODE GENERATION.
	DAC*	ARG2
	JMS	SETA2		/THE ORDERING IS PERFORMED BY PHYSICALLY
	LAC	SIGNA1	/INTERCHANGING THE ARGUMENTS IN THE
	DAC	SIGNA2	/ARGUMENT LIST AND RE-GENERATING THE
	LAC	TARGI		/ARGUMENT DESCRIPTION WORDS (MODE, TYPE,
	DAC*	ARG1	/SIGN, AND TABLE ADDRESS).
	JMS	SETA1
	LAC*	NOP
	DAC	SIGNA1
	JMP*	EXP600
	.EJECT
/ SUBROUTINE TO DECODE PREVIOUS OPERATOR (POP)
/CALLING SEQUENCE...
/      JMS	EXP610
/      JMP	MULT-DIV
	
/      JMP	ADD-SUB
/      JMP	RELATIONAL
/      XXX    LOGICAL
/
EXP610	SYN	TSMTBC
	LAC	IDXPOP
	SAD	C00021
	JMP*	EXP610
	SAD	C00018	/THE FIRST EXIT IS TAKEN WHEN POP IS
	JMP*	EXP610	/MULTIPLY (*) OR DIVIDE (/).
	ISZ	EXP610
	SAD	C00015
	JMP*	EXP610
	SAD	C00012	/THE SECOND EXIT IS TAKEN WHEN POP IS
	JMP*	EXP610	/ADDITION (+) OR SUBTRACT (-).
	ISZ	EXP610
	TAD	K00005
	SPA
	JMP	EXP611	/THE THIRD EXIT IS TAKEN WHEN POP IS
	TAD	K00006	/RELATIONAL (.LT., .LE., .NE., .EQ.,
	SMA		/.GE., .GT.)
EXP611	ISZ	EXP610	/THE LAST EXIT IS TAKEN WHEN POP IS
	JMP*	EXP610	/LOGICAL (.AND., .OR.)
	.EJECT
/ SUBROUTINE TO PERFORM SIGN CONTROL FOR PLUS-MINUS OPERATORS
/
EXP625	SYN	DOI	/THE SIGN OF THE SUB-EXPRESSION AND THE
	LAC	C00015	/AS THE ARGS ARE ALREADY ORDERED,IT IS
	SAD	IDXPOP	/ONLY NECESSARY OF DETERMINE THE MOST
	JMP	EXP627	/EFFICIENT OPERATOR & SIGN OF THE RESULT.
	DAC	IDXPOP	/+ IS CHOSEN AS A FIRST GUESS AS IT IS
	LAC*	POP		/USUALLY THE MOST EFFICIENT.
	AND	U00000	/SEE IF REVERSE SUBTRACT.
	SNA
	JMP	EXP621	/PROCESS AS NORMAL SIGN CHANGE.
	LAC	SIGNA1	/REVERSE SIGN OF ARG1
	CMA
	DAC	SIGNA1
EXP627	LAC*	POP		/GET RID OF THE REVERSE INDICATOR.
	AND	X77777
	DAC*	POP
	JMP	EXP626
EXP621	LAC	SIGNA2
	CMA
	DAC	SIGNA2
EXP626	LAC	SIGNA2	/OPERATOR ARE CHOSEN BASED UPON THE
	SMA		/FOLLOWING ARITHMETIC IDENTITIES....
	JMP	EXP622
	DZM	SIGNA2	/ (+A)-(+B) = (+A)+(-B) = + (A-B)
	LAC	SIGNA1	/ (+A)-(-B) = (+A)+(+B) = + (A+B)
SPACMD	SPA		/ (-A)-(+B) = (-A)+(-B) = - (A+B)
	JMP	EXP623	/ (-A)-(-B) = (-A)+(+B) = - (A-B)
	LAC	C00012
	DAC	IDXPOP
	DZM	SIGNA2
	JMP*	EXP625
EXP622	LAC	SIGNA1
	SMA
	JMP*	EXP625
	LAC	C00012
	DAC	IDXPOP
	LAC*	POP		/MAKE OP REVERSE
	XOR	U00000
	DAC*	POP
	DZM	SIGNA1
	JMP*	EXP625
EXP623	LAC	W00000
	DAC	SIGNA2
	JMP*	EXP625
	.EJECT
/ SUBROUTINE TO OUTPUT A LOAD ARG1 INSTRUCTION
/
EXP630	CAL	0
	LAC	TYPEA1	/NO ACTION IS TAKEN IF ARGUMENT 1 IS
	SNA		/ALREADY THE ACCUMULATOR.
	JMP*	EXP630
	JMS	GETMOD	/GET THE OPERATOR MODE INCREMENT
	LAC	MODEA1	/FROM THE MODE OF ARGUMENT 1
	TAD	C00004
	JMS	OPOPA2	/THE LOAD ARG1 INSTRUCTION IS THEN OUTPUT.
	LAC*	ARG1
	LAC*	ARG2
	JMS	SETA2
	JMP*	EXP630
/
/
/
/ SUBROUTINE TO SET UP ARGUMENT 1 AND PREVIOUS OPERATOR
/ CALLING SEQUENCE...
/      LAC	POP	/NEW ADDRESS OF POP
/      JMS	EXP640
/
EXP640	SYN	TSMTW4
	DAC	POP	/THE LIST INDICES HAVE BEEN PUSHED EITHER
	LAC*	ARG1	/DOWN (NO CODE OUTPUT AND A NEW ARG2,NOP
	JMS	SETA1	/ARE TO BE FETCHED) OR UP (CODE HAS BEEN
	LAC*	POP	/GENERATED AND THE ARG1.POP.ARG2
	DAC	SIGNA1	/SUB-EXPRESSION IS BEING REMOVED FROM THE
	AND	T77700	/LISTS).
	DAC	LEVPOP
	LAC*	POP
	AND	S00077
	DAC	IDXPOP
	JMP*	EXP640
/
/
/
/ SUBROUTINE TO INTERCHANGE ARGUMENTS 1 AND 2 AND REVERSE THE OPERATOR
/
EXP650	SYN	TRELAD
	JMS	EXP600	/ARGUMENT 1 AND ARGUMENT 2 ARE INTERCHANGED
	LAC*	POP	/AND THE OPERATOR REVERSED.
	XOR	U00000
	DAC*	POP
	JMP*	EXP650
	.EJECT
/ SUBROUTINE TO NEGATE ARGUMENT 2 (IF NECESSARY)
/
EXP670	CAL	0
	LAC	SIGNA2	/THE SIGN OF THE ACCUMULATOR IS EXAMINED
	SMA		/AND IF MINUS, THE ACCUMULATOR IS NEGATED.
	JMP*	EXP670
	LAC	MODEA2
	JMS	EXP570
	DZM	SIGNA2
	JMP*	EXP670
/
/
/
/ SUBROUTINE TO LOAD ARGUMENT 2 INTO THE ACCUMULATOR (IF NECESSARY)
/
EXP680	CAL	0
	LAC	TYPEA2	/NO ACTION IS TAKEN IF ARGUMENT 2 IS
	SZA		/ALREADY IN THE ACCUMULATOR.
	JMS	EXP590	/OTHERWISE, A LOAD ARGUMENT 2 INSTRUCTION
	TAD	C00004	/IS GENERATED.
	LAC	MODEA2
	DAC*	ARG2		/SET ARGUMENT AS ACCUMULATOR
	JMS	SETA2
	JMP*	EXP680
/
/
/
/ SUBROUTINE TO TEMPORARILY STORE ACCUMULATOR AND SET ARGUMENT 2
/
EXP690	CAL	0
	LAC	TYPEA2	/NO ACTION IS TAKEN WHEN ARGUMENT 2 IS NOT
	SZA		/THE ACCUMULATOR.
	JMP*	EXP690
	JMS	EXP670	/NEGATE THE ACCUMULATOR IF NECESSARY.
	LAC	MODEA2	/WHEN ARGUMENT 2 IS THE ACCUMULATOR, IT IS
	JMS	STORET	/TEMPORARILY STORED.
	DAC*	ARG2
	JMS	SETA2	/ARGUMENT 2 IS REPLACED WITH A TEMPORARY
	JMP*	EXP690	/STORAGE LOCATION OF THE SAME MODE.
	.EJECT
/ SUBROUTINE TO NEGATE ARGUMENT 1 (IF NECESSARY)
/
EXP700	SYN	ARGCTR
	LAC	SIGNA1	/THE SIGN OF THE ACCUMULATOR IS EXAMINED
	SMA		/AND IF MINUS, THE ACCUMULATOR IS NEGATED.
	JMP*	EXP700
	LAC	MODEA1
	JMS	EXP570
	DZM	SIGNA1
	LAC*	POP
	AND	V77777
	DAC*	POP
	JMP*	EXP700
/
/
/
/ SUBROUTINE TO TEMPORARILY STORE ACCUMULATOR AND SET ARGUMENT 1
/
EXP710	SYN	MODE
	LAC	TYPEA1	/NO ACTION IS TAKEN WHEN ARGUMENT 1 IS NOT
	SZA		/THE ACCUMULATOR.
	JMP*	EXP710
	JMS	EXP700	/THE ACCUMULATOR IS NEGATED (IF NECESSARY)
	LAC	MODEA1	/BEFORE IT IS TEMPORARILY STORED.
	JMS	STORET
	DAC*	ARG1	/ARGUMENT 1 IS REPLACED WITH A TEMPORARY
	JMS	SETA1	/STORAGE LOCATION OF THE SAME MODE.
	JMP*	EXP710
	.EJECT
/ SUBROUTINE TO OUTPUT A PARAMETER
/ CALLING SEQUENCE...
/      LAC	ARG
/      JMS	EXP720
/
EXP720	SYN	DOM1
	DAC	OBJB04	/(VECTOR IS A PARAMETER - FOR OBJ. LIST)
	JMS	EXP560	/THE PROPER ADDRESS IS DETERMINED AND
	XOR	W00000	/OUTPUT AS A FULL 15 BIT RELOCATABLE
	JMS	VECBIN	/VALUE.
	DZM	OBJB04	/(RESET VECTOR-PARAMETER INICATOR)
	JMP*	EXP720
/
/
/
/ SUBROUTINE TO OUTPUT	TAD (1) INSTRUCTION
/
EXP730	CAL	0
	LAC	IACCMD
	JMS	ABSBIN	/GENERATE IAC FOR PDP15
	JMP*	EXP730
	.EJECT
/ SUBROUTINE TO CONVERT MODE OF ACCUMULATOR
/ CALLING SEQUENCE...
/      LAC	CONVERSION MODE
/      JMS	EXP740
/
EXP740	SYN	DOM3
	JMS	COMBIN	/COMBINE AC AND MODEA2 TO GET AN INDEX INTO
	TAD	CVTBLA	/THE MODE CONVERSION TABLE
	DAC	.+1
	OPR
	SNA		/ENTRY=0 MEANS NO CONVERSION NECESSARY
	JMP*	EXP740
	SPA		/ENTRY NEGATIVE MEANS MACHINE OPCODE
	JMP	EXP741
	JMS	EXP580
	XOR	JMSCMD	/OTHERWISE ITS A SUBROUTINE CALL
	JMP*	EXP740
	.IFUND	%FPP
EXP741	JMS	ABSBIN
	.ENDC
	.IFDEF	%FPP
EXP741	JMS	FPPOUT
	CLA
	JMS	FPPOUT
	.ENDC
	JMP*	EXP740
/
/
CVTBLA	LAC	.+1
	0		/INT_INT
	127500		/INT_REAL	.AX
	127500		/INT_D.P.	.AX
NORM18	FPPIN	640422,131424		/INT_D.I.	NORM-18 OR .ZD
	127477		/REAL_INT	.AW
	0		/REAL_REAL
	0		/REAL_D.P.
	FPPIN	130247,714210		/REAL_D.I.	.JW
	127477		/D.P._INT	.AW
	0		/D.P._REAL
	0		/D.P._D.P.
	FPPIN	130247,714210
LRSS18	FPPIN	660522,131423		/D.I._INT	LRSS 18 OR .ZC
	FPPIN	130250,714670		/D.I._REAL	.JX
	FPPIN	130250,714670		/D.I._D.P.	.JX
	0		/D.I._D.I.
	.EJECT
/ SUBROUTINE TO OUTPUT RELOCATABLE VECTORS
/ CALLING SEQUENCE
/      LAC	BINARY WORD
/      JMS	VECBIN
/
VECBIN	CAL	0
	JMS	BINOUT	/THE BINARY WORD IS OUTPUT AS A 15 BIT
	XOR	C00005	/RELOCATABLE ADDRESS (VECTOR).
	JMP*	VECBIN	/LOADER CODE 05.
/
/SUBROUTINE TO FORM A TABLE INDEX (0 THRU 15)  FROM THE AC AND MODEA2
/
COMBIN	CAL	0
	RCL
	RAL		/CLL RTL
	TAD	MODEA2
	RTL
	RTL
	RTL		/ROTATE MESS INTO LOW ORDER BITS
	JMP*	COMBIN
/
/
/
/ SUBROUTINE TO DETERMINE IF STATED SUBSCRIPTS EQUAL DECLARED SUBSCRIPTS
/
SUBCNT	CAL	0
	JMS	SUBCT2	/COUNT NUMBER OF SUBSCRIPTS
	ERS  16S,<SAD SSCTR>,ES  /# SUBSCRIPTS STATED .NE. # DECLARED
	JMP*	SUBCNT
SUBCT2	CAL		/COUNT NO OF SUBSCRIPTS; ALSO ENTERED DURING
	LAC	C00001	/ALLOCATION OF ARRAY DES. BLOCK
	DAC	TCTR	/A MINIMUM OF ONE DIMENSION IS ASSUMED.
	LAC*	SYMTW5	/WORDS FIVE AND SIX OF THE SYMBOL TABLE
	SZA		/ENTRY FOR THE ARRAY CONTAIN INFORMATION
	ISZ	TCTR	/PERTAINING TO DIMENSIONS TWO AND THREE.
	LAC*	SYMTW6
	SZA		/THESE WORDS ARE ZERO IF DIMENSIONS TWO
	ISZ	TCTR	/AND/OR THREE DO NOT EXIST.
	LAC	TCTR
	JMP*	SUBCT2
	.TITLE	SYNTAX ANALYZER ( ARGUMENT - OPERATOR FETCH)
/ SUBROUTINE TO INITIALIZE FETCH ARGUMENT-OPERATOR SUBROUTINE
/
INFAOP	SYN	TCTR
	LAC	BASE0	/THE PARENTHESIS LEVEL INDEX IS SET TO THE
	DAC	BASEJ	/FIRST ENTRY AND THAT ENTRY CLEARED. MORE
	DZM*	BASEJ	/THAN ONE ENTY IS USED IN ORDER TO KEEP
	LAC	K00001	/TRACK OF NESTED FUNCTION CALLS. THE LAST
	DAC	TFAO01	/ELEMENT PROCESSED IS NON-EXISTANT.
	JMP*	INFAOP
/
/
/
/ SUBROUTINE TO FETCH AN ARGUMENT-OPERATOR PAIR
/
FARGOP	CAL	0
	LAC	FAOPIM	/THIS ROUTINE IS PRE-INITIALIZED AS IT IS
	DZM	NAME0	/CALLED MANY TIMES IN SUCCESSION. EACH CALL
	DZM	SIGN	/IS A REQUEST FOR AN ARGUMENT-OPERATOR (OR
	DAC	TFAO04	/DELIMETER) PAIR. THE FIRST ITEM OBTAINED
FAO081	DAC	FAOMOD	/IS ALWAYS AN ARGUMENT UNLESS THE LAST ITEM
FAO080	JMS	FNBCHR	/WAS A SPECIAL DELIMETER.
	LAC	CHRTYP
	SNA
FAO090	ERX	18I,EI	/ERROR: BAD CHAR
	TAD	FAOMOD	/CHARACTER DECODING IS BASED ON THE CURRENT
	DAC	.+3		/PROCESSING MODE AND THE CHARACTER TYPES.
	LAC	CHAR	/EXIT IS TO ONE OF TWENTY-NINE ROUTINES.
	DAC	OPVALU
	JMS*
	.EJECT
/ FETCH ARGUMENT-OPERATOR DECODING MATRIX (MODE BY CHARACTER TYPE)
/ INITIAL MODE ROW
/
FAOPIM	JMP	FAOPIM	/TYPE	CHARACTER
	JMP	FAO010	/01	NUMERIC		0123456789
	JMP	FAO020	/02	ALPHABETIC	BCJKMNQSUVWYZ
	JMP	FAO020	/03	ALPHABETIC	ED
	JMP	FAO020	/04	ALPHABETIC	AFGHILPXORT
	JMP	FAO030	/05	OPERATOR	+-
	JMP	FAO040	/06	OPERATOR	*/
	JMP	FAO050	/07	PERIOD		.
	JMP	FAO060	/08	PARENTHESIS	(
	JMP	FAO075	/09	PARENTHESIS	)
	JMP	FAO035	/10	DELIMETER	,=C/R
	JMP	FAO120	/11	SPACE
	JMP	FAO700	/12	QUOTES		"$
	JMP	FAO040	/13	PARTWD		[
	JMP	FAO750	/14	MISC		:];#@
/ NUMERIC MODE ROW
/
FAOPNM	JMP	FAOPNM	/TYPE	CHARACTER
	JMP	FAO130	/01	NUMERIC		01234567890
	JMP	FAO280	/02	ALFABETIC	BCJKMNQSUVWYZ
	JMP	FAO140	/03	ALFABETIC	ED
	JMP	FAO150	/04	ALFABETIC	AFGHILPXORT
	JMP	FAO160	/05	OPERATOR	+-
	JMP	FAO170	/06	OPERATOR	*/
	JMP	FAO180	/07	PERIOD		.
	JMP	FAO280	/08	PARENTHESIS	(
	JMP	FAO190	/09	PARENTHESIS	)
	JMP	FAO163	/10	DELIMETER	,=C/R
	JMP	FAO120	/11	SPACE
	JMP	FAO163	/12	QUOTES		"$
	JMP	FAO170	/13	PARTWD		[
	JMP	FAO164	/14	MISC		:];#@
/ (ALL MISC CHARS IN NUMERIC MODE ARE ILLEGAL  PARTWORD
/ PROCESSOR DOES NOT USE FARGOP, SO : ] BAD, AND ; @ # ARE
/ STRICTLY OUT OF CONTEXT)
/ SYMBOLIC MODE ROW
/
FAOPSM	JMP	FAOPSM	/TYPE	CHARACTER
	JMP	FAO200	/01	NUMERIC		0123456789
	JMP	FAO200	/02	ALPHABETIC	BCJKMNQSUVWYZ
	JMP	FAO200	/03	ALPHABETIC	ED
	JMP	FAO200	/04	ALPHABETIC	AFGHILPXORT
	JMP	FAO210	/05	OPERATOR	+-
	JMP	FAO220	/06	OPERATOR	*/
	JMP	FAO230	/07	PERIOD		.
	JMP	FAO240	/08	PARENTHESIS	(
	JMP	FAO250	/09	PARENTHESIS	)
	JMP	FAO210	/10	DELIMETER	,=C/R
	JMP	FAO120	/11	SPACE
	JMP	FAO210	/12	QUOTES		"$
	JMP	FAO220	/13	PARTWD		[
	JMP	FAO211	/14	MISC		:];#@
	.EJECT
/ PROCESSOR RETURN TO SET LAST ITEM AND GETCH NEXT CHARACTER
FAO001	LAC	OPVALU
FAO003	DAC	TFAO01
	JMP	FAO080
/
/ PROCESSOR RETURN WHEN ARGUMENT-OPERATOR PAIR HAS BEEN FETCHED
FAO002	LAC	OPVALU	/THE CURRENT OPERATOR IS SET AS THE LAST
	DAC	TFAO01	/ITEM PROCESSED. THIS IS TO ALLOW LOOKING
	XOR	LEVEL	/BACKWARDS NEXT TIME.
	DAC	TCTR
	LAC	SIGN	/THE OPERATOR, ITS HEIRARCHY LEVEL AND THE
	AND	W00000	/ARGUMENT SIGN ARE ALL PUT TOGETHER IN ONE
	XOR	TCTR		/WORD.
	RCL		/A C/R HAS A TRUE LEVEL OF ZERO.
	SZA!RAR		/OTHERWISE, THE CURRENT PAREN LEVEL COUNT
	TAD*	BASEJ	/IS ADDED TO THE OPERATOR HEIRARCHY SO
	DAC	OP	/THAT PARENTHESIS GROUPING OF ARGUMENTS
	LAC	OPVALU	/AND OPERATORS GET PREFERENTIAL TREATMENT.
	JMP*	FARGOP
	.EJECT
/ NUMERIC CHARACTER AFTER INITIAL PERIOD
/
FAO100	LAC	S20000	/THE NUMBER MODE IS SET TO REAL
	DAC	NAME0
/
/ NUMERIC CHARACTER IN THE INITIAL MODE
/			/THE MODE OF THE NUMERIC ARGUMENT IS
FAO010	JMS	FAO500	/INITIALLY SET AS INTEGER. THE LAST ITEM
K00029	LAW	-35	/IS EXAMINED TO DETERMINE IF TWO ARGUMENTS
	TAD	CHAR	/HAVE BEEN WRITTEN BACK-TO-BACK. IF NOT,
	DAC	LS	/THE PROCESSOR IS INITIALIZED FOR NUMERIC
	DZM	MS	/CONVERSION. THE MANTISSA IS SET TO THE
	LAC	PASS2	/INITIAL DIGIT. SWITCHES ARE SET TO
			/INDICATE CONVERSION INCOMPLETE,
	DAC	FAO131	/MANTISSA VERSUS EXPONENT CONVERSION, AND
	DZM	TFAO03	/THE FRACTIONAL DIGIT COUNT, AND
	DZM	TFAO05	/EXPONENT SIGN ARE RESET.
	JMP	FAO132+1
/
/ ALPHABETIC CHARACTER (TYPES 02,03,04) IN THE INITIAL MODE
/
FAO020	JMS	FAO500	/THE LAST ITEM PROCESSED IS EXAMINED TO
	LAC	C00001
	DAC	CHRCTR
	LAC	CHAR	/DETERMINE IF TWO ARGUMENTS HAVE BEEN
	DAC	NAME2	/WRITTEN BACK-TO-BACK. IF NOT, THE
	DZM	NAME1	/PROCESSOR IS INITIALIZED FOR SYMBOLIC
			/CONVERSION. THE SYMBOL (NAME) IS SET WITH
			/THE FIRST CHARACTER.
/
	TAD	LACTAB	/THE MODE OF THE SYMBOL IS DETERMINED BY A
	DAC	.+1	/TABLE LOOKUP. THE TABLE CONTAINS THE STANDARD
	XX		/MODE CODES IN BITS 4-5 AND THE LOGICAL FLAG
	RCL		/IN THE SIGN BIT
	DAC	NAME0
	CLA!RAR
	DAC	LOGFLG
			/THE MODE OF A VARIABLE CAN ALWAYS BE CHANGED
K00002	LAW	-2	/THROUGH THE USE OF THE SPECIFICATION
FAO023	DAC	TCTR	/STATEMENTS. NAMES ARE CONCATENATED THREE
	LAC	FAOPSM	/CHARACTERS PER WORD WITH A MAXIMUM OF SIX
	JMP	FAO081	/CHARACTERS.
	.EJECT
/.OPERATOR (+ -) IN THE INITIAL MODE
FAO030	LAC	TFAO01	/A PLUS-MINUS OPERATOR AS THE FIRST ITEM
	SAD	C00024	/IS ALLOWED IN TWO CASES.  THE MORE FREQUENT
	JMP	FAO031
	SAD	C00028	/BEING WHEN THE LAST ITEM IS THE CLOSING
	JMP	FAO031	/PARENTHESIS OF A SUBSCRIPT OF FUNCTION
	SAD	C00034	/ARGUMENT LIST.  THE OTHER CASE IS WHEN THE
	JMP	FAO031	/OPERATOR IS USED AS A UNARY OPERATOR
	SAD	C00030
	JMP	FAO031
	SPA
	JMP	FAO035
	TAD	K00010
	SPA!SNA
	JMP	FAO031
FAO035	ERN	10S,<JMS FAO510>,ES
	LAC	Z00000	/WHEN THE PREVIOUS DELIMITER WAS SPECIAL,
	DAC	ARG	/THE OPERATOR IS RETURNED
	JMP	FAO002	/ALONG WITH A SPECIAL ARGUMENT.
FAO031	LAC	OPVALU	/ONLY A PLUS OR MINUS OPERATOR MAY BE
	SAD	C00015	/CONSIDERED AS A UNARY OPERATOR. UNARY
	JMP	FAO001	/PLUS OPERATORS ARE UNCONDITIONALLY IGNORED
	LAC	C00024	/THE MINUS OPERATOR IS CONVERTED TO A

	DAC	OPVALU	/UNARY NEGATION OPERATOR

	LAC	S01000

	DAC	LEVEL

	DAC	ARG

	LAC	DATAFL

	SNA			/IS IT IN DATA STMT?

	JMP	FAO034		/NO.

	LAC	W00000		/YES -- NEGATE ARGUMENT.

	XOR	OPVALU

	DAC	SIGN

	LAC	FAOPIM

	DAC	FAOMOD

	JMP	FAO001

FAO034	LAC	Z00000		/MODE NEGATION OF AN ARG.

	DAC	ARG	/WHEN THE OPERATOR IS DISTRIBUTIVE, A

	JMP	FAO002	/SPECIAL UNARY ARGUMENT IS RETURNED

/

/

/  OPERATOR (* / [ , = C/R) IN THE INITIAL MODE

FAO040	JMS	FAO540	/AN ERROR IS ANNOUNCED WHEN A BINARY

	JMP	FAO035	/OPERATOR IS USED AS A UNARY OPERATOR.

	.EJECT

/

/ PARENTHESIS (OPEN) IN THE INITIAL MMDE

FAO060	ERS	16X,<JMS TSTORD>,EX  /ILLEGAL IN DECLARATION STMTS

	JMS	FAO500		/ILLEGAL AFTER SPECIAL DELIMITER

	ERN	17X,<SAD K00001>,EX	/ILLEGAL IF TFA001=INITIAL VALUE

	LAC	S01200

	TAD*	BASEJ	/OPEN PARENS CANNOT FOLLOW LIST TERMINATION

	DAC*	BASEJ	/EITHER. WHERE GROUPING IS ALLOWED, THE

FAO062	LAC	CHAR	/PAREN LEVEL COUNT IS UPDATED FOR OPERATOR

	JMP	FAO003	/HEIRARCHY TESTING.

/

/

/ PARENTHESIS (CLOSING) IN THE INITIAL MODE

FAO075	ERN	11S,<JMS FAO510>,ES	/ERROR IF NO SPECIAL DELIMITER

	DAC	CHAR

	LAC	Z00000	/(OPERATOR OR A GOUPING PAREN FOLLOWING A

	DAC	ARG	/FUNCTION OR A SUBSCRIPTED VARIABLE.

FAO073	LAW	776600	/EACH TIME A CLOSING PARENTHESIS IS

	TAD*	BASEJ	/ENCOUNTERED, THE PAREN LEVEL COUNT IS

	DAC*	BASEJ	/DECREASED. SINCE THE NUMBER OF CLOSING

	SMA		/PARENTHESIS MUST EQUAL THE NUMBER OF OPEN

	JMP	FAO074	/PARENTHESIS, THE LEVEL COUNT SHOULD NOT

	SAD	Z76600	/NORMALLY BE LESS THAN 0. THE EXCEPTION IS

	LAC	BASEJ	/DURING SCANNING OF AN IF, READ, WRITE, OR

	ERS	19X,<SAD BASE0>,EX	/EQUIVALENCE STATEMENT WHEN ONE

	LAC	S01200	/EXCESS CLOSE PAREN IS LEGAL.

	DAC	LEVEL

	LAC	C00031	/A CLOSING PARENTHESIS IS RETURNED AS THE

	JMP	FAO072	/OPERATOR TO INDICATE THIS DELIMITER.

FAO074	LAC	BASEJ	/FUNCTION NESTING (I.E. ONE FUNCTION IS AN

	SAD	BASE0	/ARGUMENT OF ANOTHER FUNCTION) HAS OCCURED

	JMP	FAO062	/WHEN THE INITIAL BASE INDEX IS NOT THE

	TAD	K00001	/CURRENT BASE INDEX (THE INDEX IS INCREASED

	DAC	TCTR	/FOR EACH FUNCTION ENCOUNTERED). AS SUCH,

	LAC*	BASEJ	/THE CURRENT CLOSING PARENTHESIS MAY BE

	SAD*	TCTR	/THE ARGUMENT LIST DELIMETER.(IT IS IF THE

	SKP		/CURRENT LEVEL IS EQUAL TO THE PREVIOUS

	JMP	FAO062	/LEVEL). OTHERWISE THE PARENTHESIS IS JUST

			/A GROUPING DELIMETER (NO IMMEDIATE EFFECT).

	LAC	TCTR	/THE OPERATOR )F IS RETURNED WHEN LIST

	DAC	BASEJ	/TERMINATING DELIMETERS ARE ENCOUNTERED.

	LAC	C00032	/FOR EACH FUNCTION TERMINATED, THE NESTING

FAO072	DAC	OPVALU	/LEVEL IS DECREASED BY ONE.

	JMP	FAO002

Z76600=FAO073

	.EJECT

/ PERIOD (.) IN THE INITIAL MODE

/

FAO050	JMS	FNBCHR	/GET A CHARACTER

	LAC	CHRTYP	/IF THE CHARACTER IS NUMERIC, THEN THE PERIOD

	SAD	C00001	/IS THE BEGINNING OF A FLOATING POINT

	JMP	FAO100	/NUMBER.

	SZA		/IF THE CHARACTER IS ALPHABETIC (TYPE 2,3 OR 4)

	TAD	K00005	/THEN THE PERIOD IS THE BEGINNING OF A

	SMA		/LOGICAL OPERAND OR CONSTANT.

	JMP	FAO090	/IF CHARACTER IS ANYTHING ELSE, ITS AN ERROR.

/

/ ALPHABETIC CHARACTER IN THE UNDECIDED MODE

FAO110	LAC	FAOMOD	/AN ALPHABETIC CHARACTER FOLLOWING A PERIOD

	DAC	TFAO06	/INDICATES THE PRESENCE OF EITHER A LOGICAL

	LAC	CHAR	/OPERATOR OR CONSTANT OR A RELATIONAL

	DAC	NAME2	/OPERATOR. AN ENTRY FROM X-MODE FLAG IS SET

			/TO PREVENT OPERATORS FROM OCCURING

			/WITHOUT ARGUMENTS (AND VICE VERSA).

FAO111	JMS	FNBCHR	/GET NEXT CHARACTER

	SAD	C00046	/IF IT IS A PERIOD,

	JMP	FAO270	/PROCESS THE COLLECTED LOGICAL QUANTITY

	LAC	CHRTYP

	SZA		/IF IT IS ALPHABETIC OR NUMERIC,

	TAD	K00005	/CONCATENATE THIS CHARACTER TO THE CHARACTERS

	SMA		/ALREADY COLLECTED AND CONTINUE.

	JMP	FAO090	/IF NON-ALPHANUMERIC, ITS AN ERROR

	JMS	CAT

	JMP	FAO111

	.EJECT

/ NUMERIC CHARACTER IN THE NUMERIC MODE

FAO130	JMS	FAO620	/WHEN CONVERSION IS COMPLETE, ACCEPT ONLY

FAO131	NOP		/OPERATORS. WHEN CONVERSION IS INCOMPLETE,

	JMP	FAO132	/THE DECESION TO CONVERT THE MANTISSA OR

	LAC	TFAO05	/THE EXPONENT MUST BE MADE.

	SNA		/WHEN THE

	LAC	C00015	/EXPONENT IS BEING PROCESSED, THE SIGN IS

	AND	S00077	/(SET EXPONENT OBTAINED FLAG)

	DAC	TFAO05	/SET TO PLUS IF ONE WAS NOT WRITTEN.

	JMS	DECBIN	/THE MAGNITUDE OF THE DECIMAL EXPONENT

	JMS	FAO560	/CANNOT EXCEED THE MAXIMUM INTEGER SIZE

	JMP	FAO080

FAO132	JMS	DECBIN	/MANTISSA CONVERSION PROCEEDS AS IF ALL

	LAC	NAME0	/NUMBERS ARE DOUBLE PRECESION IN LENGTH.

SZACMD	SZA		/IF THE NUMBER MODE IS EITHER REAL OF

	ISZ	TFAO03	/DOUBLE PRECESION, ONE IS ADDED TO THE

FAO013	LAC	FAOPNM

	JMP	FAO081	/FRACTIONAL DIGIT COUNT FOR EXP ADJUSTMENT.

/

/ ALPHABETIC CHARACTER (E,D) IN THE NUMERIC MODE

/

FAO140	ERS	28V,<XCT FAO131>,EV	/ERROR IF EXPONENT FIELD

	JMS	FAO620			/ALREADY PROCESSED.

	LAC	CHAR	/THE MODE OF THE NUMBER HS DETERMINED BY

	TAD	K00005	/THE CHARACTER BEGINNING THE EXPONENT

	SZA

	LAC	S20000	/FIELD. AN EXPONENT BEGINNING WITH E

	TAD	S20000	/INDICATES A REAL NUMBER. THE EXPONENT OF

	DAC	NAME0	/A DOUBLE PRECESION NUMBER BEGINS WITH A D.

	LAC	PASS1	/SET...

	DAC	FAO131	/CONVERT EXPONENT FLAGS.

	JMS	FAO550	/THE MANTISSA IS MOVED AS THE EXPONENT

	DZM	MS

	DZM	LS

	JMP	FAO080	/CONVERSION UTILIZES THE SAME STORAGE.

	.EJECT

/ ALPHABETIC CHARACTER (A,F,H,I,L,P,X) IN THE NUMERIC MODE

/

FAO150	ERS	20X,<SAD C00008>,EX	/ONLY H IS LEGAL

	LAC	NAME0

	ERN	05H,SZA,EH

			/NUMBER PRECEDING H MUST BE INTEGER

	JMS	FAO560	/HOLLERITH CONSTANT.

	JMS	TWOCMA

	DAC	TCTR

	CLL

	TAD	C00005		/THE NUMBER PRECEDINH "H" MUST BE

	ERN	03H,SNL,EH	/BETWEEN 1 AND 5

K00005	LAW	-5

	DAC	FMTCNT	/THE HOLLERITH CONSTANT OCCUPIES TWO

FAO156	JMS	FETCHR	/WORDS AND IS PACKED IN 5/7 ASCII FORMAT

	ERS	04H,<JMS CTRL60>,EH	/CARRIAGE RETURN ILLEGAL HERE

	LAC	XCHAR

	JMS	FMTPAK

	OPR

	ISZ	TCTR	/WHEN ALL THE CHARAATERS HAVE BEEN FETCHED

	JMP	FAO156	/AND THE CONSTANT FORMED, THE CONSTANT....

	LAC	FMTCNT	/(HOLCON SET TO 1 BEFORE ENTERING; RESETTING IT

	DAC	HOLCON	/SEZ WE GOT HOLLERITH INFO, AND HOW LONG IT IS)

	JMS	FMTFIL	/...IS LEFT JUSTIFIED WITHIN THE 2 WORDS

	OPR

	LAC	S20000	/AND SPACE CHARACTERS ADDED IF NECESSARY.

FAO712	DAC	NAME0	/THE MODE OF THE CONSTANT IS SET TO REAL

	LAC	FMS	/SO THAT BOTH WORDS WILL BE USED.

	DAC	S

	LAC	FLS

	DAC	NAME1

FAO713	LAC	PROCAD	/DATA INITIALIZATION CONSTANTS ARE NOT

	SAD	DATAAD		/ENTERED INTO THE CONSTANT TABLE

	SKP!CLA			/CONSTANTS FOUND IN EXECUTABLE

	JMS	CONSSE	/STATEMENTS ARE ENTERED.

			/THE CONSTANT OR ITS ADDRESS BECOMES THE

	XOR	U00000	/ARGUMENT AND THE NEXT NON-BLANK CHARACTER

	DAC	ARG	/BECOMES THE OPERATOR-DELIMETER.

FAO711	DZM	TFAO04

	JMP	FAO013

	.EJECT

/ QUOTE (",$,') IN THE INITIAL MODE

/

FAO700	LAC	XCHAR

	DAC	NAME0	/SAVE THE OPENING QUOTE

	LAW	-5

	DAC	FMTCNT	/INITIALIZE FORMAT PACKER

	LAW	-7

	DAC	TCTR	/AND CHARACTER COUNTER

FAO701	JMS	FETCHR	/GET A CHARACTER

	ERS	07H,<JMS CTRL60>,EH	/END OF STMT IS ERROR

	ERS	06H,<ISZ TCTR>,EH	/SO IS >5 CHARACTERS

	LAC	XCHAR

	SAD	NAME0	/CHECK FOR CLOSING QUOTE

	JMP	FAO702

FAO703	JMS	FMTPAK	/PACK THE CHARACTER IN

	OPR

	JMP	FAO701

FAO702	JMS	FNBCHR	/LOOK ONE CHARACTER AHEAD

	SAD	NAME0	/IF THE DELIMITER IS REPEATED,

	JMP	FAO703	/THEN INSERT THE DELIMITER INTO THE TEXT.

	DZM	UNFNBC	/OTHERWISE PUT THE CHARACTER BACK

	LAC	FMTCNT	/(RESET HOLCON FROM 1 TO FMTCNT TO SIGNAL HOLLERITH

	DAC	HOLCON	/CONSTANT, AND HOW LONG IT IS)

	JMS	FMTFIL	/LEFT JUSTIFY THE TEXT WITH SPACES

	OPR

	LAC	S60000	/SET MODE TO DOUBLE INTEGER

	JMP	FAO712

/

/ SPECIAL CHARACTERS (@,#,;,],:) IN THE INITIAL MODE

/

FAO750	LAC	XCHAR	/GET THE CHARACTER

	SAD	S00073	/SEMICOLON?

	JMP	FAO035	/YES - TREAT LIKE COMMA

	SAD	C00035	/#?

	JMP	FAOCTL	/YES - OCTAL CONSTANT

	ERS	23I,<SAD S00100>,EI	/BETTER BE @

	JMS	FDFSNO	/GET THE STATEMENT NUMBER FOLLOWING THE @

	LAC	SYMTBC

	DAC	S	/FORM A RELOCATABLE INTEGER CONSTANT

	LAC	Y00000	/(MODE=0 BUT TYPE=6)

	DAC	NAME0

	JMS	CONSSE	/ENTER IT INTO THE CONSTANT TABLE

	XOR	T00000	/CALL IT A VARIABLE NAME, BUT HOPEFULLY

	DAC	ARG	/THE FACT THAT ITS "TYPE" IS THAT OF A FUNCTION

	DZM	UNFNBC

	JMP	FAO711	/WILL PROPERLY RESTRICT ITS USAGE

	.EJECT

FAOCTL	DZM	MS

	DZM	LS	/INITIALIZE NUMBER

	JMS	FNBCHR	/GET A CHAR

	SAD	S00104	/D?

	SKP		/YES

	JMP	FAOCTS

	LAC	S60000	/SET MODE TO DOUBLE INTEGER

	DAC	NAME0

	JMS	FNBCHR

FAOCTS	SAD	C00045	/-?

	SKP

	JMP	FAOOLP	/NO

	ISZ	SIGN	/YES - COMPLEMENT SIGN

	JMS	FNBCHR

FAOOLP	AND	Z77770

	XOR	C00048

	SZA		/OCTAL DIGIT?

	JMP	FAOODN	/NO

	JMS	DLSHFT	/YES - SHIFT  MS,LS LEFT 3

	JMS	DLSHFT

	JMS	DLSHFT

	LAC	XCHAR

	AND	C00007	/ADD IN NEW OCTAL DIGIT

	TAD	LS

	DAC	LS

	JMS	FNBCHR	/GET A NEW CHARACTER

	JMP	FAOOLP	/LOOP

FAOODN	LAC	NAME0	/IF NOT DOUBLE PRECISION,

	SNA

	DZM	MS	/ZAP HIGH ORDER WORD

	SNA		/IF MODE IS INTEGER AND LS IS NAGATIVE,

	LAC	LS

	SMA		/WE MUST FUDGE BECAUSE OF A TEST IN

	JMP	FAOO01	/SUBROUTINE "FAO570"

	JMS	TWOCMA

	DAC	LS	/SET LS POSITIVE

	CLC

	TAD	SIGN

	DAC	SIGN	/AND COMPLEMENT SIGN

FAOO01	JMS	FAO570	/COMPLETE THE CONVERSION

	DZM	UNFNBC

	JMP	FAO013

	.EJECT

/ OPERATOR (+,-) IN THE NUMERIC MODE

/

FAO160	XCT	FAO131	/A PLUS OR MINUS SIGN IN A NUMERIC FIELD

	JMP	FAO163	/IS EITHER A DELIMITING OPERATOR (E.G.

	LAC	TFAO05	/ONLY A MANTISSA HAS BEEN OBTAINED) OR IT

	SZA		/IS THE SIGN OF THE EXPONENT (WHEN ONE HAS

	JMP	FAO163	/NOT YET BEEN OBTAINED).

	LAC	CHAR

	XOR	W00000	/THE EXPONENT SIGN IS FLAGGED TO INDICATE

	DAC	TFAO05	/THE ABSENCE OF AN EXPONENT.

	JMP	FAO080

FAO163	JMS	FAO570	/THE NUMBER CONVERSION IS COMPLETED AND

	JMP	FAO002	/THE SIGN TAKEN AS THE OPERATOR.

/

/ OPERATOR :];#@ IN NUMERIC MODE

/

FAO164	LAC	XCHAR	/ONLY # IS LEGAL

	SAD	C00035

	JMP	FAO163	/AS USED IN RANDOM ACCESS READ/WRITE

	JMP	EI13I	/GO GENERATE DIAGNOSTIC

/

/ OPERATOR (*,/,[) IN THE NUMERIC MODE

/

FAO170	JMS	FAO540	/THE OPERATOR IS TESTED FOR EXPONENTIATION

	JMP	FAO163	/AND NUMERIC CONVERSION COMPLETED.

	.EJECT

/ PERIOD (.) IN THE NUMERIC MODE

/

FAO180	JMS	FNBCHR	/A PERIOD IN A NUMERIC STRING CAN BE

	LAC	TFAO04	/INTERPRETED AS EITHER A DECIMAL POINT OR

	SNA		/AS THE BEGINNING OF A LOGICAL OR

	JMP	FAO110	/RELATIONAL OPERATOR. IF IT TURNS OUT TO

	LAC	NAME0	/BE A LOGICAL CONSTANT OR THE UNARY

	SNA		/OPERATOR .NOT. THE ENTER FROM X-MODE FLAG

	JMP	FAO182	/SETTING WILL CAUSE AN ERROR ANNOUNCEMENT.

FAO183	JMS	FAO570	/THE PERIOD IS NOT A DECIMAL POINT IF THE

	JMP	FAO110	/NUMBER HAS ALREADY BEEN CONVERTED OR IF

FAO182	LAC	CHRTYP	/THE MODE OF THE NUMBER IS NOT INTEGER.

	SAD	C00002	/THE PERIOD IS A DECIMAL POINT IF THE

	JMP	FAO183	/CHARACTER FOLLOWING IT IS NOT ALPHABETIC.

	SAD	C00004	/IT MAY BE A DECIMAL POINT IF THE

	JMP	FAO183	/ALPHABETIC CHARACTER IS AN E OR A D (FOR

	SAD	C00003	/EXPONENT IDENTIFICATION).

	JMP	FAO184

	DZM	UNFNBC	/WHEN A DECIMAL POINT IS ENCOUNTERED, THE

	LAC	S20000	/NUMBER MODE IS TENATIVELY SET TO REAL AND

	DAC	NAME0	/THE CONVERSION ALGORITHM IS INITIALIZED

	JMP	FAO080	/TO ACCEPT THE FRACTIONAL DIGITS.

FAO184	LAC	CHAR

	SAD	C00004		/ONE REL. OP. BEGINS WITH

	JMP	FAO140	/LETTER E (.EQ.).

	JMS	FNBCHR	/WHEN E IS THE NEXT CHARACTER AFTER THE

	DZM	UNFNBC

	LAC	C00005	/PERIOD, THE CHARACTER FOLLOWING E IS

	DAC	CHAR		/LOOKED AT TO SEE IF IT IS THE LETTER Q.

	LAC	XCHAR	/IF NOT, THE LETTER E IS ASSUMED TO BE THE

	SAD	S00121	/START OF THE EXPONENT FIELD.

	JMP	FAO183    /IF IT IS A Q, THE CONVERSION OF THE

	JMP	FAO140	/NUMBER IS COMPLETED AND THE LOGIC OP GOT.

/

/ PARENTHESIS (CLOSING) IN THE NUMERIC MODE

/

FAO190	JMS	FAO570	/THE CONVERSION IS COMPLETED AND THE

	JMP	FAO073	/PARENTHESIS LEVEL COUNT UPDATED.

	.EJECT

/ NUMERIC, ALPHABETIC (ALL) CHARACTERS IN THE SYMBOLIC MODE

FAO200	JMS	FAO620	/ONLY UNCONVERTED ARGUMENTS CONTAIN LETTERS

	JMS	CAT	/SYMBOLIC NAMES ARE CONCATENATED THREE

	ISZ	TCTR	/CHARACTER PER WORD USING A RADIX 50

	JMP	FAO080	/CONVERSION ALGORITHM.

	LAC	NAME1	/A SYMBOLIC NAME IS A STRING OF NO MORE

	ERN	21X,SZA,EX	/THAN 6 ALPHANUMERIC CHARACTERS.  THE

	LAC	NAME2	/CONCATENATED STRINGS OCCUPY ONE OR TWO

	DAC	NAME1	/WORDS IN THE SYMBOL TABLE. THREE OR LESS

	DZM	NAME2	/CHARACTERS REQUIRE ONLY ONE WORD.

	DZM	CHRCTR

K00004	LAW	-4	/NAMES CONSISTING OF FOUR TO SIX CHARACTERS

	JMP	FAO023	/OCCUPY TWO WORDS.

/

/ OPERATOR (*,/,[) IN THE SYMBOLIC MODE

/

FAO220	JMS	FAO540	/TEST FOR THE EXPONENTIATION OPERATOR.

/

/ OPERATOR-DELIMETER (+ - , = * / ** C/R) IN THE SYMBOLIC MODE

/

FAO210	JMS	FAO590	/SYMBOLIC CONVERSION IS COMPLETED, AND THE

	JMP	FAO002	/CHARACTER SET AS THE OPERATOR.

/

/ PERIOD (.) IN THE SYMBOLIC MODE

/

FAO230	JMS	FAO590	/WITH SYMBOLIC CONVERSION COMPLETED, THE

	JMS	FNBCHR	/PROCESSOR IS INITIALIZED TO FETCH A

	JMP	FAO110	/LOGICAL OR RELATIONAL OPERATOR.

/

/ @ ] : ; # IN THE SYMBOLIC MODE

/

FAO211	LAC	XCHAR	/# IS LEGAL, AS USED IN RANDOM

	SAD	C00035	/ACCESS READ/WRITE

	JMP	FAO210	/SEMICOLON IS LEGAL..

	SAD	S00073

	SKP

	JMP	EI23I

	LAC	TORDER	/...AND IT MUST BE IN A COMMON STATEMENT

	SAD	T40000

	JMP	FAO210	/IS COMMON, OK

	JMP	EI23I	/ELSE REPORT ERROR

	.EJECT

/ PARENTHESIS (OPEN) IN THE SYMBOLIC MODE

FAO240	JMS	FAO590	/COMPLETE THE SYMBOL PROCESSING

	JMS	TSTORD	/IS THIS STATEMENT A SPECIFICATION STMT?

	JMP	FAO241	/NO

	LAC*	SYMTBC

	AND	V00000	/NO FUNCTIONS ARE ALLOWED IN

	ERN	27V,<SAD U00000>,EV	/SPECIFICATION STATEMENTS

FAO248	LAC	C00028	/SET OPERATOR TO (F, THE FUNCTION/SUBSCRIPT

	DAC	OPVALU	/OPERATOR

	LAC	BASEJ

	TAD	C00001	/BUMP THE FUNCTION/SUBSCRIPT NESTING LEVEL

	ERN	03L,<SAD BASEMX>,EL	/CHECK FOR OVERFLOW

	LAC*	BASEJ	/START THE NEW LEVEL OFF

	ISZ	BASEJ	/WITH A PRECEDENCE

	TAD	S01200	/ONE GREATER THAN THAT OF THE PREVIOUS

	DAC*	BASEJ	/NESTING LEVEL

	JMP	FAO002	/RETURN FROM FARGOP

/

FAO241	LAC*	SYMTBC	/EXECUTABLE STATEMENT - CHECK

	AND	Z00000	/IF VARIABLE IS A SCALAR

	SNA

	JMP	FAO242	/YES - REDEFINE IT AS A FUNCTION (MAYBE)

	XOR	U00000	/IF THE VARIABLE IS AN ARRAY OR FUNCTION,

	SPA!SNA

	JMP	FAO248	/RETURN THE FUNCTION/SUBSCRIPT OPERATOR (F

	LAC	U00000	/VARIABLE MUST BE A DUMMY SCALAR - REDEFINE

	XOR*	SYMTW2	/IT AS A FUNCTION BUT SET A FLAG SO THAT

	DAC*	SYMTW2	/THE TRANSFER VECTOR WILL NOT BE OUTPUT

	JMP	FAO243

FAO242	LAC	NAME1	/BEFORE WE REDEFINE A SCALAR AS A FUNCTION,

	ERN	29V,SZA,EV	/CHECK IT ISN'T ALREADY DEFINED

FAO243	LAC*	SYMTBC

	AND	S77777	/AND OUT THE TYPE BITS

	XOR	U00000	/REPLACE WITH FUNCTION TYPE

	DAC*	SYMTBC

	JMP	FAO248	/GO TO COMMON CODE

/

/

/PARENTHESIS (CLOSING) IN THE SYMBOLIC MODE

FAO250	JMS	FAO590	/THE CONVERSION IS COMPLETED AND THE

	JMP	FAO073	/PARENTHESIS LEVEL COUNT UPDATED.

	.EJECT

/ PERIOD (.) IN THE LOGIC OPERATOR MODE

FAO270	LAC	LOCTAB	/A PERIOD IS THE ONLY LEGAL DELIMETER FOR

	DAC	TCTR	/THE LOGICAL AND RELATIONAL OPERATORS AND

FAO273	LAC*	TCTR	/THE LOGICAL CONSTANTS .TRUE. AND .FALSE.

	SAD	NAME2

	JMP	FAO271	/THE CONCATENATED MNEMONIC IS COMPARED

	ISZ	TCTR	/WITH THE TABLE OF ALLOWABLE OPERATORS AND

	LAC	TCTR	/CONSTANTS.

	ERN	19I,<SAD LOCTBM>,EI	/ERROR: NAME NOT IN TABLE

	JMP	FAO273

FAO271	LAC	LOCTAB

	JMS	TWOCMA	/THE OPERATOR VALUE OF THE TERM IS A

	TAD	TCTR	/FUNCTION OF ITS POSITION IN THE TABLE.

	DAC	OPVALU

	SZA		/THE LOGICAL CONSTANTS .TRUE. AND .FALSE.

	SAD	C00001	/AND THE UNARY LOGICAL OPERATOR .NOT.

	JMP	FAO274	/CONNOT BE OBTAINED OTHER THAN AS A FIRST

	SAD	C00011	/ELEMENT OF THE ARGUMENT-OPERATOR PAIR.

	LAC	C00001	/IF OPERATOR IS .XOR.,

	TAD	K00004	/FUDGE TO GET PRECEDENCE=1

	SMA!SZA

	LAC	C00001	/THE PRECEDENCE OF THE LOGICAL OPERATORS IS:

	TAD	C00004	/.XOR.=1,.OR.=2,.AND.=3,.NOT.=4,.XX.(REL)=5

	CLL		/THIS IS COMPUTABLE FROM THE OPERATOR VALUE

	RTL		/EASILY. NOW ROTATE THE PRECEDENCE

	RTL		/INTO BITS 9-11,

	RTL

	DAC	LEVEL	/AND STORE IT

	SAD	S00400

	JMP	FAO274

	LAC	TFAO06

	SAD	FAOPIM	/THE REMAINDER OF THE LOGICAL AND

	JMP	FAO035	/RELATIONAL OPERATORS MUST OCCUR IN CONTEXT

	JMP	FAO002	/AS BINARY OPERATORS (I.E. PRECEDED AND

			/FOLLOWED BY ARGUMENTS). AN ERROR CONDITION

			/EXISTS WHEN THIS IS NOT TRUE.

FAO274	LAC	TFAO06	/MAKE SURE THAT .TRUE.,.FALSE. AND .NOT.

	ERS	22X,<SAD FAOPIM>,EX	/ONLY OCCUR AS UNARY TERMS

	JMS	FAO500

	LAC	OPVALU	/THE UNARY OPERATOR .NOT. IS HANDLED IN

	SAD	C00004	/THE SAME MANNER AS THE UNARY MINUS

	JMP	FAO034	/OPERATOR.

	DZM	NAME0	/THE LOGIC CONSTANT MNEMONIC IS CONVERTED

	LAC	OPVALU	/TO THE PROPER BINARY REPRESENTATION.

	JMS	TWOCMA	/.TRUE.  IS REPRESENTED BY (777777).

	DAC	S

	JMP	FAO713	/GO TO COMMON CODE

	.EJECT

/

/ ILLEGAL CHARACTER IN THE UNDECIDED MODE

FAO120=FAO090

/ ILLEGAL CHARACTER IN THE NUMERIC MODE

FAO280=FAO090

/

/

/ SUBROUTINE TO TEST FOR EXISTING ARGUMENT

/

FAO500	CAL	0	/TWO ARGUMENTS CANNOT BE WRITTEN BACK-TO-

	ERS	14S,<JMS FAO510>,ES	/BACK, THEREFORE AN ARG

	JMP*	FAO500	/IS NOT ALLOWED AFTER A SPECIAL DELIMITER

/

/

/

/ SUBROUTINE TO TEST LAST ELEMENT FOR SPECIAL DELIMETER

/ CALLING SEQUENCE...

/      JMS	FAO510

/      JMP	NO	/LAST ITEM WAS NOT )F

/      NEXT INSTRUCTION	/LAST ITEM WAS )F

/

FAO510	CAL	0	/THE FIRST ITEM PROCESSED CANNOT BE AN

	LAC	TFAO01	/ARGUMENT IF THE LAST ITEM PROCESSED (LAST

	SAD	C00032	/CALL TO FARGOP) IS ONE OF THE SPECIAL

	ISZ	FAO510		/DELIMETERS. (ACTUALLY, NOW THERE IS

	JMP*	FAO510		/ONLY ONE - ")F"  )

	.EJECT

/ SUBROUTINE TO TEST FOR ** OPERATOR

/

FAO540	CAL	0	/BOTH MULTIPLICATION AND EXPONENTIATION

	SAD	C00021	/ARE INDICATED BY USING THE ASTERISK (*)

	SKP

	JMP*	FAO540	/CHARACTER. MULTIPLICATION BY ONE (*) AND

	JMS	FNBCHR	/EXPONENTIATION BY TWO (**).

			/WHENEVER AN ASTERISK IS ENCOUNTERED, THE

	SAD	C00042	/CHARACTER FOLLOWING IT IS EXAMINED TO

	JMP	FAO541	/DETERMINE IF IT IS ALSO AN ASTERISK. IF

	DZM	UNFNBC	/NOT THE CHARACTER IS UNFETCHED AND THE

	LAC	S00700

	DAC	LEVEL

	JMP*	FAO540	/OPERATOR REMAINS AS MULTIPLICATION.

FAO541	LAC	S01100	/EXPONENTIATION IS RANKED AS 8.

	DAC	LEVEL

	LAC	C00026	/IF IT IS AN ASTERISK, THE EXPONENTIATION

	DAC	OPVALU	/OPERATOR IS SET.

	JMP*	FAO540

/

/

/

/SUBROUTINE TO MOVE CONVERTED MANTISSA TO BETTER PLACE

/

FAO550	CAL	0	/THE CONVERTED MANTISSA IS MOVED AS THE

	LAC	LS	/SAME STORAGE IS USED FOR THE CONVERSION

	DAC	NAME2	/OF THE EXPONENT AND THE GENERATION OF

	LAC	MS	/THE POWER NUMBER FOR FRACTIONAL MANTISSAE.

	DAC	NAME1

	JMP*	FAO550

/

/

/

/ SUBROUTINE TO CHECK MAGNITUDE OF INTEGER NUMBER

/

FAO560	CAL	0	/ALL NUMBERS ARE CONVERTED AS IF THEY ARE

	LAC	LS	/DOUBLE PRECISION CONSTANTS.

	SMA		/HOWEVER, CERTAIN NUMBERS

	LAC	MS	/(LIKE EXPONENTS AND HOLLERITH COUNTS)

	ERN	06M,SZA,EM	/MUST BE  POSITIVE INTEGERS

	LAC	LS	/PUT INTEGER VALUE IN AC

	JMP*	FAO560

	.EJECT

/ SUBROUTINE TO COMPLETE CONVERSION OF A NUMERIC ARGUMENT

/

FAO570	CAL	0

	LAC	TFAO04	/RETURN IS IMMEDIATE WHEN THE NUMBER HAS

	SNA		/ALREADY BEEN CONVERTED.

	JMP*	FAO570

	LAC	NAME0	/NUMBERS ARE INTEGERS, REAL FLOATING POINT.

	SNA		/OR DOUBLE PRECESION FLATING POINT.

	JMP	FAO572

	SAD	S60000

	JMP	FAO571	/DOUBLE PRECISION OCTAL CONSTANT

	XCT	FAO131	/FLOATING POINT NUMBERS MAY OR MAY NOT BE

	JMP	FAO573	/WRITTEN WITH AN EXPONENT FIELD.

	LAC	TFAO05

	ERN	30V,SPA!SNA,EV	/ERROR: NO NUMBER AFTER E OR D

	LAC	PASS2

	DAC	FAO131	/CLEAR 'STILL IN EXPONENT' FLAG

	JMP	FAO589

FAO573	JMS	FAO550	/REAL NUMBERS WITHOUT EXPONENTS ARE

	DZM	LS	/SUPPLIED WITH AN EXPONENT OF ZERO.

FAO589	LAC	LS	/FOATING POINT NUMBERS CONSIST OF AN

	DAC	TFAO04	/EXPONENT (INITIALLY AN EXPONENT OF TEN.(

	LAC	NAME2	/AND A MANTISSA (INITIALLY AN INTEGER).

	DAC	LS

	LAC	NAME1

	DAC	MS	/A REAL OR DOUBLE PRECESION NUMBER IS

	TAD	NAME2	/REPRESENTED INTERNALLY BY TWO OR THREE

	SZA		/WORDS RESPECTIVELY. A FLOATING POINT

	JMP	FAO575	/NUMBER WHOSE MAGNITUDE IS ZERO IS

	DZM	S	/REPRESENTED INTERNALLY BY TWO (OR THREE)

	JMP	FAO576	/ZERO WORDS.

FAO575	LAC	C00035	/THE INITIAL SCALE OF A D.P. INTEGER IS 35.

	DAC	S	/THE MANTISSA IS NORMALIZED TO OBTAIN THE

	JMS	DNORM	/MAXIMUM SIGNIFICANCE FOR THE NUMBER.

	LAC	TFAO05

	SAD	C00012

	JMP	FAO577

	LAC	TFAO04	/THE CONVERTED EXPONENT IS ADJUSTED TO

	JMS	TWOCMA	/ACCOUNT FOR THE FRACTIONAL DIGITS IN THE

	DAC	TFAO04	/MANTISSA. (I.E. THE DIGIT COUNT IS

FAO577	LAC	TFAO04	/SUBTRACTED FROM THE ALGEBRAIC VALUE OF

	TAD	TFAO03	/THE INPUTTED TENS EXPONENT.)

	DAC	TFAO04

	SPA		/THE MAGNITUDE OF THE ADJUSTED EXPONENT

	JMS	TWOCMA	/IS EXAMINED AND IF IT IS GREATER THAN

	TAD	K00077	/76 AN ERROR IS ANNOUNCED.

	ERN	07M,SMA,EM	/ERROR: EXPONENT > 76

	LAC	TFAO04

	DZM	TFAO05	/THE CONVERSION OF THE NUMBER IS COMPLETE

	SNA		/IF THE ADJUSTED EXPONENT IS ZERO. (THE

	JMP	FAO578	/MANTISSA IS NORMALIZED AND THE TWOS SCALE

	SPA		/FACTOR IS THE EXPONENT.)

	JMP	FAO579	/THE ALGEBRAIC SIGN OF THE ADJUSTED

	JMS	TWOCMA	/EXPONENTS DETERMINES WHETHER THE MANTISSA

	DAC	TFAO05	/IS TO BE MULTIPLIED (+) OR DIVIDED (-) BY

	DAC	TFAO04	/TEN RAISED TO THE ABSOLUTE VALUE OF THE

	LAC	S	/ADJUSTED EXPONENT.

	DAC	TFAO03	/WHEN THE EXPONENT IS POSITIVE, THE

	LAC	C00001	/MANTISSA CAN BE SUCCESSIVELY MULTIPLIED

	DAC	S	/BY TEN WITHOUT ANY ACCURACY LOSS.

	JMS	FAO550	/HOWEVER, SUCCESSIVE DIVISIONS BY TEN WILL

	DZM	LS	/RESULT IN AN ACCURACY LOSS. TO MINIMIZE

	LAC	U00000	/THE ACCURACY LOSS WHEN NEGATIVE EXPONENTS

	DAC	MS	/ARE INVOLVED, A NUMBER EQUIVALENT TO THE

FAO579	JMS	MOVE	/MOVE (MS,LS) TO (TMS,TLS)

	JMS	DRSHFT	/BOTH THE ORIGINAL ACCUMULATOR AND THE

	JMS	DRSHFT	/MULTIPLIER (10) ARE NORMALIZED PRIOR TO

	LAC	TLS	/THE MULTIPLICATION (SHIFT AND ADD)

	JMS	DADD	/THE RIGHT INSTEAD OF LEFT SHIFT KEEPS THE

	LAC	S	/RESULT NORMALIZED WITHIN ONE BINARY PLACE.

	TAD	C00003	/THE ORIGINAL SCALE IS ADJUSTED TO ACCOUNT

	DAC	S	/FOR THE NORMALIZED 10.

	JMS	DNORM	/THE NUMBER IS MULTIPLIED AS A FRACTION

	ISZ	TFAO04	/DIVISION PERFORMED. THE POWER NUMBER IS

	JMP	FAO579	/FORMED BY SUBSTITUTING A NORMALIZED ONE

	LAC	TFAO05	/FOR THE MANTISSA. THE RESULT OF EACH

	SNA		/MULTIPLICATION IS NORMALIZED TO MAINTAIN

	JMP	FAO578	/THE 35 MOST SIGNIFICANT BITS.

	LAW	-44	/THE NUMBER CONVERSION IS COMPLETE EXCEPT

	DAC	TCTR	/FOR FORMING THE NUMBER IF THE EXPONENT IS

	LAC	LS	/POSITIVE.

	JMS	TWOCMA	/THE DIVISION MUST BE PERFORMED IF THE

	DAC	TLS	/EXPONENT IS NEGATIVE.

	LAC	MS

	CMA!SZL		/THE DIVISOR IS NEGATED FOR SUBTRACTION

	TAD	C00001	/PURPOSES.

	DAC	TMS

	DZM	MS	/THE QUOTIENT IS INITIALIZED TO ZERO.

	DZM	LS

	LAC	S

	JMS	TWOCMA	/THE QUOTIENT EXPONENT IS CALCULATED AND

	TAD	TFAO03	/STORED. (DIVIDEND EXPONENT MINUS DIVISOR

	DAC	S	/EXPONENT)

FAO583	JMS	DLSHFT	/DIVISION OCCURS BETWEEN TWO POSITIVE,

	SPA		/NORMALIZED NUMBERS. THE QUOTIENT WILL

	JMP	FAO580	/ALSO BE NORMALIZED OR AT MOST GREATER BY

	LAC	NAME2	/ONE AS THE RESULT OF THE DIVISION MAY BE

	TAD	TLS	/AN OVERSCALED NUMBER.

	DAC	TFAO06	/THIRTY-SIX QUOTIENT BITS ARE GENERATED TO

	GLK		/ALLOW FOR THE OVERSCALING. THE QUOTIENT

	TAD	NAME1	/IS NORMALIZED TO THIRTY-FIVE BITS WHEN

	TAD	TMS	/THIS OCCURS.

	SMA		/THE DIVISION IS PERFORMED AS SUCCESSIVE

	JMP	FAO581	/SUBTRACTIONS OF THE DIVISOR ON DECESENDING

	LAC	NAME2	/POWERS OF TWO OF THE DIVIDEND.

	JMP	FAO582

FAO581	DAC	NAME1

	LAC	C00001	/A QUOTIENT BIT IS GENERATED EACH TIME THE

	XOR	LS	/DIVIDEND IS EQUAL TO OR LARGER THAN THE

	DAC	LS	/DIVISOR. THE DIVIDEND IS REPLACED WITH ITS

	LAC	TFAO06	/ADJUSTED VALUE. THE QUOTIENT BITS ARE

FAO582	RCL		/GENERATED IN ASCENDING POWERS OF TWO.

	DAC	NAME2

	LAC	NAME1	/THE DIVIDEND IS LEFT SHIFTED SO THAT THE

	RAL		/NEXT SUBTRACTION INVOLVES A LESSER POWER

	DAC	NAME1	/OF TWO TERM.

	ISZ	TCTR

	JMP	FAO583	/THE QUOTIENT IS NOW EITHER NORMALIZED OR

FAO580	JMS	DNORM	/OVERSHIFTED BY ONE.

FAO578	DZM	TMS

	LAC	S20000	/THE CONVERTED MANTISSA IS ROUNDED AT THE

	SAD	NAME0	/LEAST SIGNIFICANT BIT. (AT THIS POINT

	TAD	S00377	/REAL NUMBERS ARE SIGNIFICANT TO 28 BITS

	TAD	Z60001	/AND DOUBLE PRECISION NUMBERS ARE

	JMS	DADD	/SIGNIFICANT TO 36 BITS.) THE NUMBER IS

	JMS	DNORM	/RE-NORMALIZED IN CASE THE ROUNDING CAUSED

			/A CARRY OUT OF THE MOST SIGNIFICANT BIT.

	LAC	NAME0	/REAL NUMBERS ONLY OCCUPY TWO WORDS IN

	SAD	S40000	/MEMORY. THE NINE LEAST SIGNIFICANT BITS

	JMP	FAO585	/OF THE EXPONENT AND THE NINE LEAST

	LAC	LS	/SIGNIFICANT BITS OF THE MANTISSA OCCUPY

	AND	Z77000	/THE FIRST WORD. THE MOST SIGNIFICANT

	DAC	LS	/SEVENTEEN BITS OF THE NORMALIZED MANTISSA

	LAC	S	/OCCUPY THE SECOND WORD. THE MATISSA IS

	AND	S00777	/ACCURATE TO 27 BITS (APPROX. 8+ DECIMAL

	XOR	LS	/DIGITS), THE EXP. TO 8 BITS (10**76).

	DAC	S	/DOUBLE PRECISION NUMBERS OCCUPY THREE

FAO585	LAW	-2	/WORDS IN MEMORY, WITH THE EXPONENT, THE

	AND	LS	/MOST SIGNIFICANT 17 MANTISSA BITS AND THE

	DAC	LS	/LEAST SIGNIFICANT 17 MANTISSA BITS EACH

	LAC	SIGN	/OCCUPYING ONE WORD. THE MANTISSA IS

	SZA!CLA		/ACCURATE TO 34 BITS (APPROX. 10+ DEC DIG).

	LAC	W00000	/THE ARGUMENT SIGN HAVING BEEN DIRECTLY

	XOR	MS	/ASSIMULATED INTO THE ARGUMENT WAS EXAMINED

	DAC	MS	/TO PREVENT THE LOGICAL UNARY OPERATOR

	JMS	FAO550	/.NOT. FROM BEING APPLIED TO AN ARITH TERM.

	JMP	FAO576

FAO572	LAC	LS

	SMA

	LAC	MS

	SZA!CLA		/IF THE INTEGER'S MAGNITUDE IS >2**17-1

	LAC	S60000	/THEN MAKE IT A DOUBLE INTEGER LITERAL

	DAC	NAME0

FAO571	LAC	SIGN

	SNA!CLA

	JMP	FAO598	/SIGN POSITIVE - DON'T NEGATE

	LAC	LS

	JMS	TWOCMA

	DAC	LS

	LAC	MS	/DOUBLE INTEGER 2'S COMPLEMENT NEGATION

	CMA

	SZL

	TAD	C00001

	DAC	MS

FAO598	LAC	LS

	DAC	NAME1	/LOW ORDER INTO LOW ORDER

	LAC	LS

	DAC	S	/ALSO INTO HIGH ORDER IN CASE ITS AN INTEGER

	LAC	NAME0

	SNA

	JMP	.+3	/IT IS

	LAC	MS	/ITS NOT - SET HIGH ORDER TO HIGH ORDER

	DAC	S

FAO576	JMS	TSTORD

	SNA		/CONSTANTS ARE NOT ENTERED INTO THE

	JMP	FAO588	/CONSTANT TABLE IF THEY APPEAR ON

	JMS	CONSSE	/PRE-EXECUTABLE OR DATA STATEMENTS.

FAO574	XOR	U00000	/THE CONSTANTS ADDRESS IN THE CONSTANT

	DAC	ARG	/TABLE PLUS AN INDENTIFICATION CODE ARE

			/USED TO FORM THE ARGUMENT.

	DZM	TFAO04	/THE CONVERSION IS FLAGGED AS COMPLETE AND

	DZM	SIGN

	JMP*	FAO570	/RETURN IS MADE TO THE CALLING PROGRAM.

FAO588	LAC	NMODE

	JMP	FAO574	/SET DUMMY ADDRESS

NMODE	.DSA	NAME0

	.EJECT

/ SUBROUTINE TO FORM A SYMBOLIC ARGUMENT

/

FAO590	SYN	TFAO05

	LAC	TFAO04	/RETURN IS IMMEDIATE IF THE SYMBOL HAS

	SNA		/ALREADY BEEN ENTERED INTO THE SYMBOL

	JMP*	FAO590	/TABLE. OTHERWISE, THE SYMBOLIC ARGUMENT

	JMS	FAO600	/IS ENTERED INTO THE SYMBOL TABLE.

	JMS	SYMBSE	/THE JUST ENTERED-PREVIOUSLY ENTERED

	LAC	SYMTBC	/GET SYMTAB POINTER

	DAC	SYMTBX	/SAVE AS LAST REFERENCED SYMBOL FOR DD I/O

	LAC	T00000	/INDICATOR IS RETAINED FOR FUTURE USE.

	XOR	SYMTBC	/THE ARGUMENT IS FORMED BY COMBINING THE

	DAC	ARG	/ENTRY ADDRESS AND AN INDICATOR IDENTIFYING

	DZM	TFAO04	/THE ARGUMENT AS SYMBOLIC.

	JMP*	FAO590

SYMTBX	.DSA	0

/

/

/ SUBROUTINE TO SET UP NAME WORDS FOR ENTRY IN THE SYMBOL TABLE

/

FAO600	CAL	0

	LAC	CHRCTR	/SYMBOLS AND STATEMENT NUMBERS ARE ENTERED

	SZA		/INTO THE SYMBOLTABLE AS 6 CHARACTER NAMES

	TAD	K00003	/NAMES WHICH ARE LESS THAN 

	SMA

	JMP	FAO603

	DAC	TFAO04	/ SIX CHARACTERS IN LENGTH ARE PADDED

	DZM	CHAR	/WITH SPACES TO MAKE UP THE RIGHT NUMBER.

FAO604	JMS	CAT

	ISZ	TFAO04	/THIS BIT OF FUSSING AROUND MAKES LIFE

	JMP	FAO604	/MORE BEARABLE FOR SYMBOL TABLE SORTS AND

FAO603	LAC	NAME1	/WORD ENTRY INTO THE SYMBOL TABLE.

	SZA

	JMP*	FAO600

	LAC	NAME2

	DZM	NAME2

	DAC	NAME1

	JMP*	FAO600

/

/

/ SUBROUTINE TO ANNOUNCE AN ERROR IF THE ARGUMENT CONVERSION IS FINISHED

/

FAO620	CAL	0

	LAC	TFAO04	/AN ERROR IS ANNOUNCED IF A DIGIT OR LETTER

	ERN	15S,SNA,ES	/IS OBTAINED IN THE ARGUMENT MODE

	JMP*	FAO620	/AFTER THE ARGUMENT HAS BEEN CONVERTED

			/BUT AN OPERATOR HAS NOT BEEN FOUND.

	.TITLE	SYMBOL AND CONSTANT TABLE SEARCH ROUTINES

/ SUBROUTINE TO SEARCH-ENTER NAMES IN THE SYMBOL TABLE

/ CALLING SEQUENCE

/      JMS	SYMBSE

/			/NAME JUST ENTERED IF ZERO ACC

/			/NAME PREVIOUSLY ENTERED IF NON-ZERO ACC

SYMBSE	CAL	0	/INITIALIZE THE SEARCH ADDRESS TO THE FIRST

	ISZ	FILFLG

	SKP

	JMP	CMDA1

	DZM	FILFLG

	LAC	SYMTB0	/ENTRY IN THE SYMBOL TABLE.

	DZM	CHRCTR	/INITIALIZE RELATIVE POSITION

SBSE01	DAC	SYMTBC

	ISZ	CHRCTR

	SAD	SYMTBN	/THE SEARCH ADDRESS IS COMPARED AGAINST

	JMP	SBSE02	/THE NEXT ENTRY ADDRESS. IF EQUAL, THE

	JMS	SETADR	/NAME IS NOT IN THE TABLE.

	LAC*	SYMTW2	/OTHERWISE THE NAME IS COMPARED AGAINST

	AND	T77777

	SAD	NAME1	/THE CURRENT SEARCH SYMBOL.

	SKP

	JMP	SBSE04

	LAC*	SYMT2A

	AND	T77777	/AND OUT "LOGICAL VAR" FLAG FROM 2D WORD

	SAD	NAME2

	JMP	SBSE05

SBSE04	JMS	SBSE50	/WHEN THE NAME DOES NOT MATCH THE CURRENT SEARCH SYMBOL

	JMP	SBSE01	/THE NEXT SYMBOL IS FETCHED

SBSE05	LAC*	SYMTBC

	AND	S60000

	DAC	NAME0	/THE MODE OF THE FOUND VARIABLE IS

	LAC	TSMTBN	/RETAINED AS THE MODE OF THE CURRENT VAR.

	SNA

	JMP	SBSE06	/THESE DUMMY VARIABLES ARE UNIQUE ONLY

	LAC	SYMTBC	/TO THE CURRENT STATEMENT FUNCTION.

	JMS	TWOCMA	/HOWEVER, THEY DO RETAIN THE SAME MODE

	TAD	DOTABX	/AS THE PERMANENT VARIABLE BY THE SAME

	SPA!SNA		/NAME.

	JMP	SBSE03

SBSE06	JMS	TSTORD		/IF WE ARE IN AN EXECUTABLE STATEMENT

	LAC*	SYMTBC		/AND THIS SYMBOL IS A SIMPLE NON-COMMON

	AND	Z17777		/VARIABLE OF ANY MODE WHICH HAS NOT YET

	SAD	S17777		/BEEN REFERENCED IN AN EXECUTABLE

	SKP			/STATEMENT, THEN MAKE BELIEVE THAT WE

	JMP	SBSE08		/JUST DEFINED THE SYMBOL. THIS ALLOWS

	LAC*	SYMTBC		/FUNCTIONS TO BE TYPED IN TYPE STATEMENTS.

	XOR	C00001		/OF COURSE WE MUST NOW INDICATE THAT THE

	DAC*	SYMTBC		/VARIABLE HAS BEEN ACCESSED IN EXECUTABLE

	JMP	CLACMD		/CODE. (THIS CODE ALWAYS FAILS ON PASS 2)

Z17777	.DSA	717777

SBSE08	LAC	SYMTBC

	JMP	SBSE07

SBSE02	LAC	TSMTBN	/ENTER SYMBOL INTO THE SYMBOL TABLE

	SZA

	JMP	SBSE03

	LAC	C00007	/WHEN THE NAME IS NOT IN THE TABLE AN

	JMS	TABOFL	/ATTEMPT IS MADE TO ENTER IT.

	JMS	SETADR	/THE NAME IS ORIGINALLY ENTERED AS IF

	LAC	NAME0	/IT WERE A SIMPLE VARIABLE

	XOR	S17777	/THE INITIAL DEFINITION OF THE VARIABLE IS

	DAC*	SYMTBC	/SET TO 17777, MEANING UNDEFINED

	LAC	NAME1	/THE NEXT TWO WORDS OF THE ENTRY

	DAC*	SYMTW2	/CONTAIN THE RADIX-50 NAME OF THE VARIABLE

	LAC	NAME2

	XOR	LOGFLG	/THE SECOND NAME WORD ALSO CONTAINS

	DAC*	SYMT2A	/THE "LOGICAL VARIABLE" INDICATOR.

	LAC	NAME0

	JMS	SETN	/GET THE NUMBER OF WORDS OCCUPIED BY THE

	DAC*	SYMTW3	/VARIABLE AND PUT IT INTO THE ENTRY

	LAC	CHRCTR	/SET THE VARIABLE TO POINT TO ITSELF AS IT

	DAC*	SYMTW4	/BELONGS TO NO EQUIVALENCE CLASS YET

	DZM*	SYMTW5	/ZERO OUT THE SUBSCRIPT ENTRIES FOR THE VARIABLE

	DZM*	SYMTW6

	LAC	S17777	/INITIALIZE THE "OFFSET" WORD

	DAC*	SYMTW7	/TO AN UNDEFINED NUMBER

	JMS	TSTORD	/ARE WE IN THE EXECUTABLE STATEMENTS?

	SKP		/YES

	JMP	SBSE12-1	/NO - FINISHED

	LAC*	SYMTW2	/SET BIT 0 OF THE HIGH-ORDER NAME WORD ON TO

	XOR	W00000	/INDICATE THAT WORDS AFTER THE NAME WORDS

	DAC*	SYMTW2	/DO NOT EXIST - SAVES MUCHO TABLE SPACE

	LAC*	SYMTBC	/IF THE FIRST DEFINITION OF THE VARIABLE

	XOR	C00001	/OCCURS IN AN EXECUTEABLE STATEMENT, DEFINE

	DAC*	SYMTBC	/IT WITH THAT IN MIND

	JMS	SBSE50	/THE NEXT ENTRY ADDRESS IS UPDATED

SBSE12	DAC	SYMTBN	/ACCORDINGLY.

CLACMD	CLA

SBSE07	DAC	NAME1	/THE ACCUMULATOR IS CLEARED AS AN INDICATOR

	JMP*	SYMBSE	/THAT THE NAME WAS JUST ENTERED.

SBSE03	LAC	SYMTB0

	DAC	TCTR

	JMS	CNSE50	/ERASEABLE DUMMY VARIABLES

	LAC	NAME2	/(FROM STATEMENT FUNCTIONS)

	DAC*	TCTR		/ARE ENTERED IN FRONT OF THE

	JMS	CNSE50		/PERMANENT SYMBOL TABLE

	LAC	NAME1

	XOR	W00000	/MAKE THIS A SHORT ENTRY

	DAC*	TCTR

	JMS	CNSE50

	DAC	SYMTB0

	DAC	SYMTBC

	LAC	NAME0

	DAC*	TCTR

	JMP	CLACMD

	.EJECT

/ SUBROUTINE TO UPDATE CURRENT SYMBOL ADDRESS TO NEXT ENTRY

/

SBSE50	CAL	0

	LAC*	SYMTW2	/GET THE HIGH-ORDER NAME WORD

	SMA!CLA		/IS THE "SHORT ENTRY" BIT ON?

	LAC	C00005	/NO - ENTRY WAS 8 WORDS LONG

	TAD	SYMTW3	/YES - ENTRY IS 3 WORDS LONG

	JMP*	SBSE50

/

/

	.EJECT

/ SUBROUTINE TO SEARCH-ENTER CONSTANTS IN THE CONSTANT TABLE

/

CONSSE	CAL	0		/INITIALIZE THE SEARCH ADDRESS TO THE FIRST

	LAC	CONTB0	/ENTRY IN THE CONSTANT TABLE

CNSE05	DAC	TCTR		/THE CURRENT ENTRY ADDRESS IS RETAINED SO

	DAC	CONTBC	/THAT IT MAY BE RETURNED TO THE CALLING

	SAD	CONTBN	/PROGRAM. WHEN THE CURRENT SEARCH ADDRESS

	JMP	CNSE02	/IS EQUAL TO THE NEXT ENTRY ADDRESS, THE

	LAC*	TCTR		/CONSTANT IS NOT IN THE TABLE AND MUST BE

	AND	Z60000	/ENTERED. IF NOT, THE CONSTANT LOCATED AT

	XOR	NAME0	/THE SEARCH ADDRESS IS COMPARED AGAINST THE INCOMING

	SZA		/CONSTANT. CONSTANTS MUST AGREE IN MODE AND VALUE

	JMP	CNSE03	/BEFORE THEY CAN BE CONSIDERED IDENTICAL.

	JMS	CNSE50	/WITH MODES IDENTICAL, THE SEARCH ADDRESS

	LAC*	TCTR		/IS UPDATED TO THE FIRST CONSTANT WORD.

	SAD	S		/IF THE FIRST WORDS DONT COMPARE, THE

	JMP	CNSE04	/SEARCH ADDRESS IS UPDATED TO THE NEXT

CNSE03	JMS	CNSE51	/ENTRY IN THE CONSTANT TABLE AND THE SEARCH

	JMP	CNSE05	/CONTINUES.

CNSE04	LAC	NAME0	/THE MODE IS EXAMINED FOR INTEGER

	AND	S60000	/WHEN THE FIRST WORDS COMPARE. THE CONSTANT

	SNA		/HAS BEEN FOUND IF THE MODE

	JMP	CNSE08	/IS INTEGER

	JMS	CNSE50	/WHEN THE MODE IS NOT INTEGER, THE SEARCH ADDRESS

	LAC*	TCTR	/IS BUMPED SO THE 2D WORDS CAN BE COMPARED.

	SAD	NAME1	/IF THE SECOND CONSTANT WORDS COMPARE

	SKP		/THE MODE IS EXAMINED TO DETERMINE IF THE

	JMP	CNSE03	/CONSTANT IS A REAL OR DOUBLE PRECESION

	LAC	NAME0	/CONSTANT. WHEN THE SECOND WORDS DO NOT

	AND	S20000	/COMPARE THE NEXT ENTRY IS EXAMINED.

	SZA		/IF THE CONSTANT IS A REAL CONSTANT, A

	JMP	CNSE08	/MATCH HAS BEEN FOUND AND EXIT IS IMMEDIATE

	JMS	CNSE50	/IF THE CONSTANT IS A DOUBLE PRECESION

	LAC*	TCTR	/CONSTANT, THE THIRD CONSTANT WORDS ARE

	SAD	NAME2	/COMPARED. IF EQUAL, A MATCH IS FOUND. IF

	JMP	CNSE08	/NOT EQUAL, THE NEXT ENTRY IS EXAMINED.

	JMP	CNSE03

CNSE02	LAC	C00003

	JMS	TABOFL	/BEFORE A NEW CONSTANT IS ENTERED INTO THE

	LAC	NAME0	/TABLE, IT MUST BE DETERMINED IF THERE IS

	DAC*	TCTR	/ENOUGH ROOM FOR IT. AT THIS POINT (FOR THE

	JMS	CNSE50	/SAKE OF SIMPLICITY) ALL CONSTANTS ARE

	LAC	S	/ASSUMED TO BE DOUBLE PRECESION. WHEN ROOM

	DAC*	TCTR	/EXISTS, ALL FOUR WORDS OF THE ASSUMED

	JMS	CNSE50	/DOUBLE PRECESION CONSTANT ARE ENTERED

	LAC	NAME1	/INTO THE TABLE.

	DAC*	TCTR

	JMS	CNSE50

	LAC	NAME2

	DAC*	TCTR

	JMS	CNSE51	/THE NEXT ENTRY ADDRESS IS UPDATED, HOWEVER

	DAC	CONTBN	/ACCORDING TO THE MODE OF THE CONSTANT.

CNSE08	LAC	CONTBC	/THE ENTRY ADDRESS OF THE CONSTANT IS

	JMP*	CONSSE	/RETURNED TO THE CALLING PROGRAM.

/

/

/

/ SUBROUTINE TO UPDATE THE CONSTANT TABLE SEARCH ADDRESS BY ONE

/

CNSE50	CAL	0		/THE CONSTANT TABLE OCCUPIES THE TOP-HALF

K00001	LAW	-1		/OF THE CONSTANT-SYMBOL TABLE.

	TAD	TCTR		/ENTRIES ARE MADE FROM THE TOP DOWN. THERE-

	DAC	TCTR		/FORE THE SEARCH ADDRESS MUST BE NEGATIVELY

	ERN	02T,<SAD .FFREE>,ET /ERROR: TOO MANY DUMMY VARS

	JMP*	CNSE50	/UPDATED.

/

/

/

/ SUBROUTINE TO UPDATE CONSTANT TABLE INTRY ADDRESS

/

CNSE51	CAL	0		/THE CURRENT ENTRY ADDRESS IS UPDATED BY

	LAC*	CONTBC	/THE NUMBER OF WORDS OCCUPIED BY THE ENTRY.

	JMS	SETN		/THAT NUMBER IS A FUNCTION OF THE MODE OF

	CMA		/THE CURRENT ENTRY.

	TAD	CONTBC

	JMP*	CNSE51	/WORDS. THE UPDATED ADDRESS IS RETURNED.

	.TITLE	MISCELLANEOUS SUBROUTINES

/ SUBROUTINE TO TEST FOR SYMBOL-CONSTANT TABLE OVERFLOW

/ CALLING SEQUENCE...

/      LAC	N		/N IS THE LENGTH OF THE ENTRY MINUS ONE

/      JMS	TABOFL	/(THE MINUS ONE IS FOR TWOS COMPLEMENT)

/

TABOFL	CAL	0		/THE SYMBOL AND CONSTANT TABLES ARE REALLY

	TAD	SYMTBN	/JUST ONE BIG TABLE. SYMBOLS ARE ENTERED

	CMA		/FROM THE BOTTOM UP. CONSTANTS ARE ENTERED

	TAD	CONTBN	/FROM THE TOP DOWN.

	ERN	03T,SPA,ET	/ERROR: SYMBOL AND CONSTANT TABLE MEET

	JMP*	TABOFL

/

/

/

/

/ SUBROUTINE TO DETERMINE NUMBER OF MACHINE WORDS OCCUPIED BY AN ITEM

/ BASED ON THE MODE OF THE ITEM.

/ CALLING SEQUENCE...

/      LAC	MODE		/MODE IS CONTAINED IN BITS 3 AND 4

/      JMS	SETN

/

SETN	CAL	0

	JMS	RTLAND

	SAD	C00003	/IS THE MODE DOUBLE INTEGER?

	LAC	C00001	/DOUBLE INTEGER IS THE SAME AS REAL FOR

	TAD	C00001	/LENGTH PURPOSES.

	JMP*	SETN	/THE LENGTH IS (CONVENIENTLY) 1+ THE MODE NUMBER

/

/

/

/

/ SUBROUTINE TO CONVERT DECIMAL TO BINARY

/

DECBIN	CAL	0

	JMS	MOVE	/(TMS,TLS)=(MS,LS)

	JMS	DLSHFT

	JMS	DLSHFT	/(MS,LS)=(MS,LS)*4

	ERN	10M,SPA!SZL,EM	/CHECK FOR OVERFLOW

	LAC	TLS

	JMS	DADD	/(MS,LS)=(MS,LS)*5

	JMS	DLSHFT

	ERN	09M,SPA!SZL,EM	/CHECK FOR OVERFLOW AGAIN

	DZM	TMS

	LAC	CHAR		/CONVERT INTERNAL REPRESENTATION OF DIGIT

	TAD	K00029	/TO PURE BINARY CHARACTER (00 TO 11)

	JMS	DADD		/(ACC*10)+DIGIT

	ERN	08M,SPA,EM	/ERROR: NUMBER > 2**35-1

	JMP*	DECBIN

	.EJECT

/ SUBROUTINE TO CONCATENATE SYMBOLS

/

CAT	CAL	0		/SYMBOLS ARE CONCATENATED USING A RADIX 40

	LAC	C00002	/SCHEME..I.E. NORMAL BASE CONVERSION EXCEPT

	JMS	SHIFT		/THERE ARE 40 ELEMENTS IN THE SYSTEM.

	LAC	NAME2		/(WORD)*4

	TAD	NAME2		/(WORD*4)+(WORD*1)

	DAC	NAME2

	LAC	C00003

	JMS	SHIFT

	LAC	NAME2		/(WORD*5)*8

	TAD	CHAR

	DAC	NAME2		/(WORD*40)+CHAR

	ISZ	CHRCTR	/COUNT THE CONCATENATED CHARACTERS.

	JMP*	CAT

	JMP*	CAT

/

/

/

/ SUBROUTINE TO DETERMINE IF THE FIRST EXECUTABLE STATEMENT HAS BEEN

/  ENCOUNTERED.

/ CALLING SEQUENCE...

/      JMS	TSTORD

/      JMP	YES		/YES

/

TSTORD	CAL	0	/ALL STATEMENTS CONTRIBUTING TO THE

	LAC	TORDER	/SPECIFICATION OF DATA STORAGE HAVE AN

	TAD	X40000	/ORDER NUMBER LESS THAN  5 . ALL SUCH

	SPA		/STATEMENTS MUST OCCUR BEFORE THE FIRST

			/EXECUTABLE STATEMENT (DATA AND FORMAT

	ISZ	TSTORD	/MUST ALSO OCCUR AFTER SPECIFICATION

	JMP*	TSTORD	/STATEMENTS.

/

/

/

/ SUBROUTINE TO DETERMINE TYPE OF CURRENT SYMBOL TABLE ENTRY

/ CALLING SEQUENCE...

/      JMS	SYMTYP	/X IS...0 FOR NON-COMMON, 1 FOR COMMON,

/      XOR	(X00000) /       2 FOR FUNCTION, 3 FOR DUMMY

/      JMP	NO	/NOT TYPE TESTED

/      NEXT INSTRUCTION	/IS THE TYPE TESTED

/

SYMTYP	CAL	0	/THE DESCRIPTION WORD OF THE CURRENT

	LAC*	SYMTBC	/SUMBOL TABLE ENTRY IS FETCHED AND THE

	AND	V00000	/SYMBOLS TYPE IS ISOLATED.

	XCT*	SYMTYP	/THIS TYPE IS MATCHED AGAINST THAT

	ISZ	SYMTYP	/SPECIFIED BY THE CALLING SEQUENCE.

SNACMD	SNA		/THE EXIT POINT IS DETERMINED BY THE

	ISZ	SYMTYP	/RESULT OF THE COMPARISON.

	JMP*	SYMTYP

	.EJECT

/ SUBROUTINE TO FETCH STATEMENT NUMBER

/ CALLING SEQUENCE...

/      JMS	FETSNO

/ ON RETURN, AC=DEFINITION WORD IF STMT NUMBER FOUND, OTHERWISE -1

/

FETSNO	CAL	0	/A STATEMENT NUMBER IS A SYMBOL MADE UP OF

FSNO07	JMS	FNBCHR	/ALL NUMERIC CHARACTERS. FIVE ARE ALLOWED.

	LAC	CHRTYP

	SAD	C00001	/IF THE FIRST CHARACTER IS NOT NUMERIC, NO

	JMP	FSNO01	/STATEMENT NUMBER HAS BEEN FOUND AND THIS

	DZM	UNFNBC	/FACT IS INDICATED TO THE CALLING PROGRAM

	LAW	-1	/BY RETURNING WITH A ZERO ACCUMULATOR. THE

	JMP*	FETSNO	/COLUMN COUNT IS RESET TO ALLOW THE CHAR

FSNO01	LAC	CHAR	/TO BE RE-FETCHED.

	SAD	C00029	/LEADING ZEROES IN A STATEMENT NUMBER ARE

	JMP	FSNO07	/IGNORED.

	DZM	NAME1

	LAC	C00002

	DAC	CHRCTR

	LAW	-2	/INITIALLY THE FIRST NAME WORD IS CLEARED

FSNO06	DAC	TCTR	/AND THE CHARACTER PUT INTO WORKING STORAGE

	LAC	CHAR	/A MAXIMUM OF TWO MORE CHARACTERS WILL BE

	DAC	NAME2	/CONCATENATED TO FORM THE FIRST HALF OF THE

			/SYMBOL FORM OF A STATEMENT NUMBER.

FSNO05	JMS	FNBCHR

	LAC	CHRTYP

	SAD	C00001	/THE NEXT NON-DIGIT CHARACTER ENCOUNTERED

	JMP	FSNO02	/IS INTERPRETED AS THE TERMINAL CHARACTER

	JMS	FAO600	/OF THE STATEMENT NUMBERS.

	LAC	NAME1	/ALL STATEMENT NUMBERS ARE ENTERED INTO THE

			/SYMBOL TABLE.

	TAD	DECPNT	/A PERIOD IS PLACED IN FRONT OF THE

	DAC	NAME1	/STATEMENT NUMBER FOR IDENTIFICATION.

	LAC	V00000

	DAC	NAME0

	JMS	SYMBSE	/THE SYMBOL IS FLAGGED AS A STATEMENT

	LAC*	SYMTBC	/NUMBER AND EXIT IS MADE WITH THE SYMBOL

	JMP*	FETSNO	/DESCRIPTION IN THE ACCUMULATOR.

FSNO02	ISZ	TCTR	/A COUNT IS MAINTENED ON THE NUMBER OF

	JMP	FSNO03	/DIGITS IN THE NUMBER TO PERMIT TWO WORD

	LAC	NAME1	/CONCATENATION OF THE STATEMENT LABEL.

	ERN	07N,SZA,EN	/ERROR: STMT NO HAS > 5 DIGITS

	LAC	NAME2	/WHEN THREE DIGITS HAVE BEEN ENCOUNTERED,

	DAC	NAME1	/THE FIRST TWO PLUS A PERIOD (ADDED LATER

	LAC	C00001

	DAC	CHRCTR

K00003	LAW	-3	/IS THE FIRST NAME WORD AND THE LAST THREE

	JMP	FSNO06	/IS THE SECOND NAME WORD.

FSNO03	JMS	CAT		/CONCATENATE THE CURRENT CHARACTER AND GO

	JMP	FSNO05		/FETCH THE NEXT ONE.

	.TITLE	CHARACTER INPUT SUBROUTINES

/ SUBROUTINE TO FETCH THE NEXT CHARACTER FROM THE CURRENT SOURCE IMAGE

/ CALLING SEQUENCE...

/      JMS	FETCHR

/ FETCHR SKIPS IF A C/R IS FETCHED DURING "NO CONTINUATION" MODE

/

FETCHR	CAL	0

	LAC	UNFNBC	/A NEW CHARACTER WILL NOT BE FETCHED IF

	SZA		/THE LAST CHARACTER FETCHED WAS NOT USED.

	JMP	FTC06

	LAC	LSTCHR

	JMP	FTC07	/WHEN THE NEXT CHARACTER TO FETCH IS TO BE

FTC06	LAC	ERFLG1	/FOUND IN COLUMN 73, THE CURRENT IMAGE IS

	DAC	MESSY6+2

	LAC	COL

	SAD	S00111	/EXHAUSTED AND A NEW IMAGE MUST BE INPUT.

JMPFT2	JMP	FTC02

	JMP	FTC01

FTC02	LAC	CTRLSW	/IMAGE CONTINUATION IS NOT ALLOWED DURING

	SNA		/STATEMENT RECOGNITION.

	JMP	FTC05	/THEREFORE, A SPECIAL EXIT IS TAKEN WHEN

	ISZ	FETCHR	/THE IMAGE IS EXHAUSTED.

	JMP*	FETCHR

FTC05	JMS	SINPUT	/A NEW IMAGE IS INPUT AND EXAMINED TO SEE

	JMS	FTC500	/IF IT IS A CONTINUATION OF THE LAST ONE.

	JMP	FTC04	/THE PRESENT STATEMENT IS TERMINATED IF

	LAC	ERFLG2

	XCT	PASS

	XCT	SLIST

	DAC	MESSY6+2

	LAC	CHARCR	/THE NEW IMAGE IS NOT A CONTINUATION

	JMP	FTC07

FTC04	JMS	SOUTPT	/IF THE NEW IMAGE IS A CONTINUATION OF THE

			/LAST ONE (COLUMN SIX CONTAINS A CHARACTER

FTC01	JMS	SIN500	/OTHER THAN SPACE OR ZERO), THE COLUMN

	SAD	CHARCR	/COUNT IS SET TO THE BEGINING OF THE

FT2CNG	JMP	FTC02	/STATEMENT FIELD

	ISZ	COL

FTC07	DAC	LSTCHR

	DAC	UNFNBC	/RESET NO FETCH INDICATOR.

	AND	S00077	/THE INTERNAL REPRESENTATION OF THE

	DAC	CHAR	/CHARACTER IS SENT BACK TO THE CALLER,

	LAW	-13	/ALONG WITH THE EXTERNAL REPRESENTATION

	JMS	SHIFT	/OF THE CHARACTER (FOR HOLLERITH DATUM

	LAC	LSTCHR	/AND FORMAT STATEMENT PACKING), AND

	DAC	XCHAR

	LAW	-6

	JMS	SHIFT

	LAC	LSTCHR	/ALONG WITH A CODE IDENTIFYING WHAT TYPE

	AND	C00015	/OF CHARACTER IT IS (NUMERIC,ALPHABETIC,

	DAC	CHRTYP	/OPERATOR, DELIMITER, ETC.)

	SAD	C00005

	LAC	S00600	/A PLUS-MINUS OPERATOR IS RANKED AS 6.

	SAD	C00006

	LAC	S00700	/A MULTIPLICATION-DIVISION OPERATOR IS

	SAD	C00013	/RANKED AS 7.

	LAC	S01200	/THE PARTWORD OPERATOR IS RANKED AS 10.

	AND	S07700

	DAC	LEVEL	/A NON-OPERATOR/DELIMETER IS RANKED AS 0.

	LAC	CHRTYP

	JMP*	FETCHR

	.EJECT

/ SUBROUTINE TO FETCH THE NEXT NON-BLANK CHARACTER FROM THE SOURCE IMAGE

/

FNBCHR	CAL	0

	DZM	CTRLSW	/(ALLOW IMAGE CONTINUATION)

	JMS	FETCHR	/CHARACTERS ARE FETCHED UNTIL A NON-BLANK

	SKP

	JMP	.+3

	SAD	C00011	/CHARACTER IS FOUND.

	JMP	.-4		/BLANK AND SPACE ARE SYNONYMOUS

	LAC	XCHAR	/RETURN CHARACTER TO CALLER

	JMP*	FNBCHR

/

/

/

/

/ SUBROUTINE TO TEST CURRENT SOURCE IMAGE FOR CONTINUATION

/ CALLING SEQUENCE...

/      JMS	FTC500

/      JMP	YES

/      XXX    NO

/

FTC500	SYN	TEMP0

	LAC	COL06	/A CONTINUATION IMAGE CONTAINS A NON-ZERO

	SAD	CHARSP	/DIGIT IN COLUMN SIX.

	JMP	FTC501

	SAD	CHAR0	/SOURCE INPUT HAS ALREADY SET COLUMN SIX

			/TO EITHER A NUMBER OR A SPACE

			/CONTINUATION IMAGE.

FTC501	ISZ	FTC500

	JMP*	FTC500	/NORMAL IMAGE

	.TITLE	ARITHMETIC SUBROUTINES (MULTIPLY, SHIFTS, ETC.)

/ SUBROUTINE TO PERFORM SINGLE PRECESION,POSITIVE INTEGER MULTIPLICATION

/ CALLING SEQUENCE...

/      LAC	MULTIPLICAND

/      JMS	MULT

/      LAC	MULTIPLIER

/	RETURN,	ANSWER IN AC

MULT	CAL	0

	DAC	MULT01	/MULTIPLICAND

	XCT*	MULT	/LAC OR LAC* MULTIPLIER

	CLL

MULCMD	MUL

MULT01	XX

	DAC	MS

LAQCMD	LACQ

	DAC	LS

	JMS	FAO560	/TEST RESULT .GT.(2**17)-1

	ISZ	MULT

	JMP*	MULT

/

/

/

/ SUBROUTINE TO TWOS COMPLEMENT THE ACCUMULATOR

/

TWOCMA	SYN	SHFCTR

	CLL!CMA		/A TWOS COMPLEMENT IS A ONES COMPLEMENT

	TAD	C00001	/PLUS ONE

	JMP*	TWOCMA

	.EJECT

/ SUBROUTINE TO SHIFT ARGUMENT RIGHT OR LEFT N PLACES AND LEAVE IN ACC

/ CALLING SEQUENCE...

/      LAC	COUNT	/COUNT IS NEG FOR RIGHT, POS FOR LEFT

/      JMS	SHIFT	/ AND ZERO FOR NO SHIFT

/      LAC	ARG	/MAY BE  LAC*

/

SHIFT	CAL	0

	SNA		/IF COUNT IS ZERO, EXIT IS SUCH THAT THE

	JMP*	SHIFT	/ARG IS ACCESSED UPON RETURN

	SMA

	JMP	SHFT01

	DAC	SHFCTR

	LAC	SHFT10	/A NEGATIVE COUNT IMPLIES A RIGHT SHIFT

	JMP	SHFT02

SHFT01	JMS	TWOCMA

	DAC	SHFCTR

	LAC	SHFT11	/A POSITIVE COUNT IMPLIES A LEFT SHIFT

SHFT02	DAC	SHFT03

	XCT*	SHIFT	/FETCH ARGUMENT

SHFT03	NOP		/EITHER A RCR OR A RCL

	ISZ	SHFCTR	/COUNT-1

	JMP	SHFT03

	ISZ	SHIFT	/SKIP PARAMETER UPON EXIT

	JMP*	SHIFT

/

/

/

/ SUBROUTINE TO NORMALIZE DOUBLE PRECESION ACCUMULATOR

/

DNORM	CAL	0	/A NUMBER IS SAID TO BE NORMALIZED WHEN

DNRM02	LAC	MS	/THE MOST SIGNIFICANT NON-ZERO BIT OF THE

	SMA		/NUMBER OCCUPIES THE MOST SIGNIFICANT BIT

	JMP	DNRM01	/OF THE WORD FIELD ASSIGNED TO THE NUMBER.

	JMS	DRSHFT	/THESE HUMBERS ARE NORMALIZED TO BIT 1 OF

	ISZ	S	/THE MOST SIGNIFICANT HALF OF THE DOUBLE

PASS2	OPR		/PRECESION NUMBER.

	JMP*	DNORM	/THE ASSOCIATED SCALE FACTOR REPRESENTS THE

DNRM01	AND	U00000	/POSITION OF THE LEAST SIGNIFICANT BIT OF

	SZA		/THE NUMBER (ASSUMING AN INTEGER NUMBER

	JMP*	DNORM	/AND A POSITIVE SCALE FACTOR). A NEGATIVE

	JMS	DLSHFT	/SCALE FACTOR INDICATES A FRACTIONAL

	LAW	-1		/NUMBER AND ITS MAGNITUDE THE NUMBER OF

	TAD	S		/ZERO BITS BETWEEN THE BINARY POINT AND

	DAC	S		/THE FIRST NON-ZERO BIT OF THE

	JMP	DNRM02	/FRACTION.

	.EJECT

/ SUBROUTINE TO ADD THE TWO DOUBLE PRECISION ACCUMULATORS

/ CALLING SEQUENCE...

/      LAC	TLS		/OR ANYTHING ELSE (CHAR)

/      JMS	DADD

/

DADD	CAL	0

CLRLNK	CLL		/CARRY INDICATOR RESET

	TAD	LS

	DAC	LS		/ACC + LS  TO  LS

	GLK		/IF CARRY FROM LS ADDITION,

	TAD	TMS		/ADD ONE TO MS

	TAD	MS

	DAC	MS		/A NEGATIVE ACCUMULATOR INDICATES OVERFLOW

	JMP*	DADD		/ TO THE CALLING PROGRAM

/

/

/

/ SUBROUTINE TO RIGHT SHIFT THE DOUBLE PRECESION ACCUMULATOR ONE PLACE

/

DRSHFT	CAL	0

	LAC	MS

SHFT10	RCR		/MS.RSHFT.(1)

	DAC	MS		/MS17  TO  LINK

	LAC	LS		/LINK  TO  LS0

	RAR		/LS.RSHFT.(1)

	DAC	LS

	JMP*	DRSHFT

/

/

/

/ SUBROUTINE TO LEFT SHIFT THE DOUBLE PRECESION ACCUMULATOR ONE PLACE

/

DLSHFT	CAL	0

	LAC	LS

SHFT11	RCL		/LS.LSHFT.(1)

	DAC	LS		/LS0  TO  LINK

	LAC	MS		/LINK TO  MS17

	RAL		/MS.LSHFT.(1)

	DAC	MS		/A NON-ZERO LINK OR NEGATIVE ACCUMULATOR

	JMP*	DLSHFT	/ INDICATES OVERFLOW TO THE CALLING PROGRAM

	.EJECT

/ SUBROUTINE TO MOVE DOUBLE PRECESION ACCUMULATOR TO TEMPORARY STORAGE

/

MOVE	CAL	0

	LAC	MS

	DAC	TMS		/MS TO TMS

	LAC	LS

	DAC	TLS		/LS TO TLS

	JMP*	MOVE

/

/

/

/ SUBROUTINE TO SET ADDRESSES OF THE WORDS FORMING THE CURRENT ENTRY IN

/ THE SYMBOL TABLE

/

SETADR	CAL	0

	LAC	SYMTBC	/THE ADDRESS OF THE WORDS IN THE CURRENT

	TAD	C00001	/ENTRY ARE SET UP TO MAKE ACCESSING THEM

	DAC	SYMTW2	/EASY.

	TAD	C00001

	DAC	SYMT2A

	TAD	C00001

	DAC	SYMTW3

	TAD	C00001

	DAC	SYMTW4	/EQUIVALENCE (COMMON) CLASS LINKAGE

	TAD	C00001	/ADDRESS (BECOMES ARRAY SIZE)

	DAC	SYMTW5	/FIRST ARRAY DIMENSION WORD (N*IMAX)

	TAD	C00001

	DAC	SYMTW6	/SECOND ARRAY DIMENSION WORD (N*IMAX*JMAX)

	TAD	C00001

	DAC	SYMTW7

	JMP*	SETADR

SYMTW7	.DSA	0

/

/

/

/ SUBROUTINE TO TEMPORARILY SAVE SYMBOL TABLE ENTRY ADDRESSES

/

TSETAD	CAL	0

	LAC	CHRCTR

	DAC	TRELAD

	LAC	SYMTBC	/THE ADDRESSES OF

	DAC	TSMTBC	/  THE FIRST WORD (DESCRIPTION),

	LAC	SYMTW4

	DAC	TSMTW4	/  THE FOURTH WORD (LINKAGE ADDRESS), AND

	LAC	SYMTW7

	DAC	TSMTW7	/  THE SEVENTH WORD (RELATIVE POSITION)

	JMP*	TSETAD		/ARE SAVED TEMPORARILY.

	.TITLE	SOURCE IMAGE INPUT/OUTPUT ROUTINES

/ SUBROUTINE TO INPUT A SOURCE IMAGE

/
SINPUT	CAL	0
	.IFUND	RSX
/      .READ  -11,2,SINBFH,32  /READ IN A SOURCE IMAGE
	CAL	02767		/  DEVICE 3 .. IOPS ALPHA
	.DSA	000010	/  READ CODE
	.DSA	SINBFH	/	INPUT BUFFER ADDRESS (INCLUDES HEADERS)
	-44		/BUFFER SIZE IS 36 WORDS
/      .WAIT  -11	/WAIT UNTIL THE BUFFER HAS BEEN TRANSFERED
	CAL	00767	/	DEVICE 3
	.DSA	000012	/	WAIT CODE
	.ENDC
	.IFDEF	RSX
	CAL	READ11	/READ FROM INPUT DEVICE
	JMS	WFEV	/WAIT FOR EVENT VARIABLE
	LAC	(DAT11)	/LUN IN CASE OF I/O ERROR
	.ENDC
	LAC	SINBFH
	AND	C00015
	SAD	C00005
	JMP	ENDGEN
	SAD	C00006
	JMP	ENDGEN
SINPUX=.
	ISZ	LINMBR		/(RKB-067)
/(RKB-067)
/(RKB-067)	DELETED 16 LINES OF %BOSS CONDITIONALIZED CODE. ALSO
/(RKB-067)	DELETED THE LABEL 'NOCARY'.
/(RKB-067)
	JMS	SINP00	/INITIALIZE BUFFER AND FETCH CONTINUATION
	LAC	TCHAR
	SAD	CHARCR
	JMP	SINPUT+1
	XOR	CHARC
	AND	Z74000	/COMMENTS ARE INDICATED BY THE CHARACTER C
	SZA		/IN THE FIRST CHARACTER POSITION.
	JMP*	SINPUT
	JMS	SOUTPT	/COMMENTS ARE LISTED, BUT NOT PROCESSED.
	JMP	SINPUT+1
ENDGEN	LAC	ENDBFR
	DAC	SINBFH+2
	LAC	ENDBFR+1
	DAC	SINBFH+3
	.IFDEF	RSX
	LAC	HEADER
	DAC	SINBFH
	.ENDC
	JMP	SINPUX
HEADER	.DSA	2002		/HEADER INFO
ENDBFR	.ASCII <11>/END/<15>
	.EJECT
/ SUBROUTINE TO FETCH CONTINUATION FIELD AND POSITION COUNTERS TO THE
/ STATEMENT FIELD
/
SINP00	CAL	0
	JMS	SIN520
	LAC	C00007
	DAC	COL
	LAW	-5
	DAC	LEVEL	/SAVE COLUMN 1 FOR COMMENT TEST
	JMS	SIN500	/THE STATEMENT NUMBER AND CONTINUATION
	DAC	TCHAR	/FIELDS ARE EXAMINED TO DETERMINE THE
	SKP		/CONTENTS OF THE CONTINUATION FIELD AND
SINP02	JMS	SIN500
	SAD	CHARSP	/ALSO THE WORD AND CHARACTER COUNTER VALUES
	JMP	SINP03	/FOR THE BEGINNING OF THE STATEMENT FIELD
	SAD	TABCHR	/(NECESSARY BECAUSE OF VARYING INPUT FORMATS)
	JMP	SINP01	/   ANY CHARACTERS THAT ARE NON-BLANK OR NON-
	LMQ		/TAB AND IN THE FIRST 5 POSITIONS MUST BE 
	LAC	TCHAR	/NUMERIC, UNLESS IT IS A COMMENT STATEMENT
	SAD	CHARC
	JMP	SINP03
	LACQ
	AND	S01700	/TEST IF IS NUMERIC
	SAD	S00100
	JMP	SINP03	/THIS PREVENTS BAD CONTINUATION FROM OCCURING
	JMS	SOUTPT	/OUTPUT THE BAD LINE
	ERX	09N,EN
SINP03	ISZ	LEVEL
	JMP	SINP02
	JMS	SIN500	/COLUMN 6 MUST BE CHECKED HERE FOR A TAB
	SAD	TABCHR	/CHARACTER
	JMP	SINP01
	JMS	SIN530
	JMP	SINP04
SINP01	JMS	SIN530	/A TAB CHARACTER INDICATES A SKIP OF THE
	JMS	SIN500	/REMAINDER OF THE STATEMENT NUMBER FIELD.
	DAC	LSTCHR
	AND	S01700
	SAD	S00100	/THE CONTINUATION FIELD IS ALSO SKIPPED
	JMP	SINP04	/IF THE CHARACTER FOLLOWING THE TAB IS NOT
	DZM	UNFNBC		/A NUMBER.
	ISZ	COL
	JMP*	SINP00
SINP04	LAC*	CHAR
	DAC	COL06	/THE CONTINUATION FIELD (COLUMN SIX) WILL
	JMP*	SINP00	/POINTERS ARE SET TO THE STATEMENT FIELD.
	.EJECT
/ SUBROUTINE TO LIST SOURCE IMAGE
/
SPRINT	CAL	0
/(RKB-067)	DELETED .IFDEF	%BOSS.
	LAC	SINBFH
	TAD	S01000	/ADD 1 TO BUFFER WORD COUNT
	DAC	SINBFH-2
/(RKB-067)	22 LINES DELETED.
	LAC	(SINBFH)		/(RKB-067)
	JMS	SUB980			/(RKB-067) CONVERT LINE NO. TO DECIMAL.
	LAC	LINMBR			/(RKB-067) ASCII CHARACTERS.
	LAC	SINBFH+1		/(RKB-067) LOAD RESULTING WORD PAIR.
	LMQ				/(RKB-067) INTO AC-MQ.
	LAC	SINBFH			/(RKB-067) AND SHIFT MSD OUT,
	CLL				/(RKB-067) MAKING ROOM FOR ...
	LLS	7			/(RKB-067) 4-DIGIT NUMBER,
	DAC	SINBFH			/(RKB-067) PLUS A TAB.
	LACQ				/(RKB-067)
	AAC	22			/(RKB-067)
	DAC	SINBFH+1		/(RKB-067)
	LAW	774000			/(RKB-067) NOW CHECK FOR LEADING LF.
	AND	SINBFH+2		/(RKB-067) WE NEED TO CHANGE LF ...
	SAD	(050000)		/(RKB-067) TO RUBOUT, SINCE A ...
	LAW	774000			/(RKB-067) LF SHUTS OFF LP15, BUT...
	LMQ				/(RKB-067) A RUBOUT IT HARMLESS TO ALL
	LAC	SINBFH+2		/(RKB-067) OR IT IN
	AND	(3777)			/(RKB-067)
	OMQ				/(RKB-067)
	DAC	SINBFH+2		/(RKB-067) PUT IT BACK
	.IFUND	RSX
	LAC	S02766	/USE .DAT -12
	XCT	LIST
	LAC	S02775	/USE .DAT -3
	DAC	SPR.1		/(RKB-067)
	.IFUND	%NOHDG		/(RKB-069)
	DAC	SPR.3		/(RKB-067)
	DAC	SPR.4		/(RKB-067)
	.ENDC			/(RKB-069)
	AND	S00777
	DAC	SPR.2		/(RKB-067)
	.IFUND	%NOHDG		/(RKB-069)
	JMS	SPRHDR		/(RKB-067)
	.ENDC			/(RKB-069)
SPR.1	.WRITE -12,2,SINBFH-2,32  /(RKB-067) PRINT SOURCE IMAGE ON LISTING DEVICE
SPR.2      .WAIT  -12	/WAIT UNTIL THE BUFFER HAS BEEN TRANSFERED
	.ENDC
	.IFDEF	RSX
	XCT	LIST	/LISTING WANTED?
	SKP		/NO
	JMP	.+4
	LAC	VERPNT	/CHECK TO SEE IF PRINTING WANTED
	SNA
	JMP	SPRXIT		/(RKB-070) NO, EXIT
	LAC	(DAT12)	/PICK UP THE LUN FOR THE LISTING DEVICE
	XCT	LIST	/IS IT IN USE?
	LAC	(DAT3)	/NO OUTPUT ON OUTPUT TTY
	DAC	WR3LUN	/SET LUN IN WRITE REQUEST
	.IFUND	%NOHDG		/(RKB-069)
	DAC	SPR.4		/(RKB-068) AND FOR HEADER LINES...
	DAC	SPR.6		/(RKB-068) ...
	JMS	SPRHDR		/(RKB-068) PRINT THE HEADING IF NEEDED
	.ENDC			/(RKB-069)
	CAL	WRIT12	/DO THE WRITE
	JMS	WFEV	/WAIT FOR THE EVENT VARIABLE
	LAC	(DAT12)	/LUN IN CASE OF I/O ERROR
	.ENDC
SPRXIT	LAC	SINBFH-2	/(RKB-070) RESTORE BUFFER HEADER
	TAD	Z77000	/BUMP THE BUFFER WORD COUNT BACK DOWN
	DAC	SINBFH	/AND RESTORE THE BUFFER CONTROL WORD
	JMP*	SPRINT
	.IFUND	%NOHDG		/(RKB-069)
SPRHDR	XX			/(RKB-066) DETERMINE IF WE SHOULD PRINT HEADER
	ISZ	LINCNT		/(RKB-066) HAS LINE COUNT OVERFLOWED?
	JMP*	SPRHDR		/(RKB-066) NO, EXIT WITHOUT PRINTING
	LAW	-70		/(RKB-066) YES, NEED TO PRINT, BUT FIRST RESTORE COUNTER
	DAC	LINCNT		/(RKB-066) GOING TO PUT 56 LINES PER PAGE
	ISZ	PAGCNT		/(RKB-066) KICK PAGE NUMBER
	LAC	PAGCNT		/(RKB-066) GET PAGE NUMBER
	IDIV			/(RKB-066) CONVERT TO DECIMAL
	12
	AAC	60		/(RKB-066) MAKE IT ASCII
	RCL			/(RKB-066)
	DAC	TOF+3		/(RKB-066) BUILD IN HEADER
	DIV+1000		/(RKB-066) DIVIDE MQ
	12			/(RKB-066)
	AAC	60		/(RKB-066)
	ALSS	10		/(RKB-066) POSITION IT
	XOR	TOF+3		/(RKB-066) COMBINE WITH OTHER
	DAC	TOF+3		/(RKB-066)
	LACQ			/(RKB-066) GET LAST CHAR
	RTR			/(RKB-066) THIS ONE IS A LITTLE MESSY
	RTR			/(RKB-066) AS IT IS THE SPLIT CHAR
	XOR	TOF+3		/(RKB-066)
	DAC	TOF+3		/(RKB-066)
	GLK			/(RKB-066) THIS IS THE SPLIT PART
	LMQ			/(RKB-066)
	LAC	TOF+2		/(RKB-066) EVEN THOUGH THE SPLIT PART CAN ONLY BE ONE BIT
	OMQ			/(RKB-066) IT IS A PAIN
	DAC	TOF+2		/(RKB-066)
	.IFUND	RSX		/(RKB-067)
SPR.3	.WRITE	-12,2,TOF-2,40	/(RKB-067) PRINT THE HEADING
SPR.4	.WRITE	-12,2,SPRBLK,4	/(RKB-067) AND ONE BLANK LINE
	.ENDC			/(RKB-066)
	.IFDEF	RSX		/(RKB-066)
	CAL	SPR.3		/(RKB-068) PRINT THE HEADER AT TOF
	JMS	WFEV		/(RKB-068) WAIT
	LAC	(DAT12)		/(RKB-068)
	CAL	SPR.5		/(RKB-068) NOW A BLANK LINE
	JMS	WFEV		/(RKB-068)
	LAC	(DAT12)		/(RKB-068)
	.ENDC			/(RKB-068)
	JMP*	SPRHDR		/(RKB-066) ALL DONE
SPRBLK	002002			/(RKB-066) A BLANK LINE FOR SPACING AFTER HEADING
	0			/(RKB-066)
	.ASCII	' '<15>		/(RKB-066)
	.LOC	.-1		/(RKB-066) RECLAIM THAT WASTED WORD
	.IFDEF	RSX		/(RKB-068)
SPR.3	2700			/(RKB-068) WRITE CPB FOR HEADER
	EVA			/(RKB-068)
SPR.4	XX		/(RKB-068)
	2			/(RKB-068)
	TOF-2			/(RKB-068)
SPR.5	2700			/(RKB-068) WRITE CPB FOR BLANK LINE
	EVA			/(RKB-068)
SPR.6	XX			/(RKB-068)
	2			/(RKB-068)
	SPRBLK			/(RKB-068)
	.ENDC			/(RKB-068)
	.ENDC			/(RKB-069)
	.EJECT
/ SUBROUTINE TO FETCH AND TRANSLATE A SOURCE CHARACTER
/
SIN500	CAL	0
	LAC	CHRCNT	/TWO WORDS AT A TIME (5 CHARACTERS) ARE
SIN507	SZA		/MOVED FROM THE INPUT IMAGE TO A WORKING
	JMP	SIN501	/CHARACTER BUFFER.
	LAC*	SINBUF
	DAC	CHRBUF	/THE INDIVIDUAL CHARACTERS ARE EXTRACTED
	ISZ	SINBUF	/FROM THIS CHARACTER BUFFER.
	LAC*	SINBUF
	DAC	CHRBF1
SIN506	ISZ	SINBUF
	LAW	-4	/THE FIRST CHARACTER OF THE BUFFER IS
	DAC	CHRCNT	/ALREADY IN POSITION FOR TRANSLATION.
	JMP	SIN502
SIN501	TAD	C00001
	DAC	CHRCNT	/EACH TIME A CHARACTER IS REQUIRED (EXCEPT
	JMS	SIN510	/THE FIRST OF THE FIVE) THE CHARACTER
SIN502	LAC	CHRBUF	/BUFFER IS SHIFTED LEFT 7 BITS AND THE CHARACTER
	CLL		/IN THE HIGH ORDER SEVEN BITS IS LOOKED UP
	LRS	13	/IN THE TABLE OF LEGAL ASCII CHARACTERS.
	SAD	S00175	/THE TABLE IS LINEARIZED BY REPLACING
	LAC	C00031	/THE CHARACTERS ALTMODE, CARRIAGE RETURN
	SAD	C00013	/AND TAB BY ARTIFICIAL VALUES.
	LAC	C00030
	SAD	C00010
	JMP	SIN500+1	/LINE FEEDS ARE IGNORED
	SAD	C00009
	LAC	C00029
	TAD	PSTABL
	DAC	CHAR
	LAC*	CHAR
	XOR	CHRBUF	/IF THE HIGH ORDER 7 BITS OF THE INDEXED ENTRY
	AND	Z74000	/MATCH THOSE OF THE INPUT BUFFER,
	SZA		/THE CHARACTER IS LEGAL
	JMP	SIN500+1
	LAC*	CHAR
	JMP*	SIN500
PSTABL	.DSA	TABCHR-35
	.EJECT
/ SUBROUTINE TO SHIFT CHARACTER BUFFER LEFT SEVEN PLACES
/
SIN510	CAL	0
	LAC	CHRBF1
	LMQ		/THE TWO WORD CHARACTER BUFFER IS
	LAC	CHRBUF	/SHIFTED LEFT 7 SPACES
	CLL
	LLS	7
	DAC	CHRBUF
	LACQ
	DAC	CHRBF1
	LAC	CHRBUF	/LEFT MOST CHARACTER IS LEFT ADJ IN AC ON RETURN
	JMP*	SIN510
/
/
/
/ SUBROUTINE TO INITIALIZE SOURCE IMAGE WORD AND CHARACTER COUNTERS
/
SIN520	CAL	0
	LAC	SINBF0	/INITIALIZE...
	DAC	SINBUF	/	WORD COUNT TO FIRST BUFFER WORD.
	DZM	CHRCNT	/	CHARACTER COUNT TO BEGIN WITH A NEW
	LAC	CHARSP	/	SET OF WORDS.
	DAC	COL06	/	SPACE CHARACTER TO COLUMN SIX.
	DZM	COL	/	COLUMN NUMBER
	JMP*	SIN520
/
/
/
/ SUBROUTINE TO SAVE SOURCE IMAGE WORD AND CHARACTER COUNTERS
/
SIN530	CAL	0
	LAC	SINBUF	/SAVE...
	DAC	TSINBF	/	BUFFER WORD ADDRESS
	LAC	CHRCNT
	DAC	TCHCNT	/	CHARACTER COUNTER
	LAC	CHRBUF
	DAC	TCHBUF	/	CHARACTER BUFFER
	LAC	CHRBF1
	DAC	TCHBF1	/	CHARACTER BUFFER
	LAC	COL
	DAC	KOL	/	COLUMN NUMBER
	JMP*	SIN530
	.EJECT
/ SUBROUTINE TO RESTORE SAVED SOURCE IMAGE WORD AND CHARACTER COUNTERS
/
SIN540	CAL	0
	LAC	TSINBF	/RESTORE...
	DAC	SINBUF	/	BUFFER WORD ADDRESS
	LAC	TCHCNT
	DAC	CHRCNT	/	CHARACTER COUNTER
	LAC	TCHBUF
	DAC	CHRBUF	/  CHARACTER BUFFER
	LAC	TCHBF1
	DAC	CHRBF1	/	CHARACTER BUFFER
	LAC	KOL
	DAC	COL	/	COLUMN NUMBER
	JMP*	SIN540
/
/
/
/ SUBROUTINE TO OUTPUT SOURCE IMAGE
/
SOUTPT	CAL	0
SLIST	SKP		/THE SOURCE IMAGE IS LISTED UNLESS NO LIST
	JMP*	SOUTPT	/IS SPECIFICALLY REQUESTED BY THE USER.
	XCT	PASS
	JMS	SPRINT	/THE SOURCE LISTING IS PRODUCED DURING
	JMP*	SOUTPT	/PASS 2 ONLY.
	.TITLE	ERROR ROUTINES
/ERROR ENTRIES
ERRORN	0		/GIVE ERROR IF TEST DOES NOT SKIP
	DAC	ERRAC	/SAVE AC
	LAC	ERRORN	/SAVE EXIT AND ARG. POINTER
	DAC	ERRORS
	LAC*	ERRORN	/FETCH TEST INSTRUCTION TO AVOID DOUBLE EXCT.
	DAC	.+2
	LAC	ERRAC	/RESTORE AC
	XX		/TEST INSTRUCTION
	JMP	EROR1
EROR2	ISZ	ERRORS	/NO ERROR
	ISZ	ERRORS
	JMP*	ERRORS
ERRORS	0
	DAC	ERRAC
	LAC*	ERRORS
	DAC	.+2
	LAC	ERRAC
	XX		/TEST INSTRUCTION
	JMP	EROR2
EROR1	ISZ	ERRORS	/ERROR
	LAC*	ERRORS
	DAC	ERRAC
	JMS	ERROR1
ERRAC	XX		/ERROR MESSAGE AND AC STORE
	LAC	EXPDIR	/SPECIAL SWITCH FOR GEN OF INDIRECT ADDRESSES TO
	DAC	CALLSW	/ARRAY IN SUB. AND FUNC. CALLS IS SET TO DEFAULT.
	LAC	PROCAD
	SAD	K00001	/IF THIS IS THE END STATEMENT, EXIT TO
	JMP	PASS		/TERMINATE THE PASS, OTHERWISE EXIT TO
	JMP	EREXIT	/FETCH THE NEXT SOURCE IMAGE.
/
/
/ SUBROUTINE TO ANNOUNCE AN ERROR
/
ERROR1	SYN	CONTBC
	LAC*	ERROR1
	DAC	MESSY6+1
	ISZ	ERROR1
	ISZ	FILFLG
	SKP
	.IFUND	RSX
	JMP	RSTRT		/CAN NOT OUTPUT ERROR MESSAGE
	.ENDC
	.IFDEF	RSX
	JMP	CMDERR	/COMAND ERROR 
	.ENDC
	LAC	PASS2		/BINARY OUTPUT IS TERMINATED
	DAC	OBINRY
	XCT	PASS		/ALWAYS LIST IN PASS 1
	XCT	SLIST		/LIST IN PASS 2 IF NO SOURCE LIST
	JMS	SPRINT
	.IFUND	RSX
	LAC	S02766	/USE .DAT -12
	XCT	LIST
	LAC	S02775	/USE .DAT -3
	DAC	S990CL
	AND	S00777
	DAC	ERWAIT
	.ENDC
	.IFDEF	RSX
	LAC	(DAT12)	/PRINT ERROR MESSAGE ON
	XCT	LIST	/LUN 12 IF LISTING DEVICE IS OPEN
	LAC	(DAT3)	/NOT OPEN USE OUTPUT TTY
	DAC	S990CL	/SET IN LUN
	.ENDC
	.IFUND	%NOEOC		/(RKB-069)
	ISZ	ERRCNT		/(RKB-067) UP ERROR COUNT
	.ENDC			/(RKB-069)
	.IFUND	%NOHDG		/(RKB-069)
	JMS	SPRHDR		/(RKB-067) PRINT HEADING, IF NEEDED.
	.ENDC			/(RKB-069)
	JMS	SUB990		/PRINT ERROR MSG
	MESSY6-2
	.IFUND	RSX
ERWAIT	CAL
	12
	.ENDC
	.IFDEF	RSX
	JMS	WFEV	/WAIT FOR EVENT VARIABLE TO BE SET
	LAC	S990CL	/LUN IN CASE OF I/O ERROR
	.ENDC
	JMP* ERROR1
	.IFUND	%NOEOC		/(RKB-069)
ERRCNT	0			/(RKB-067)
	.ENDC			/(RKB-069)
	.TITLE	BINARY OUTPUT AND LISTING GENERATION ROUTINES
/ SUBROUTINE TO OUTPUT BINARY OBJECT CODE
/ CALLING SEQUENCE...
/      LAC	DATA WORD
/      JMS	BINOUT
/      XOR	LOADER CODE
/
BINOUT	CAL	0
BINO05	ISZ	BINBUF	/THE DATA STORE ADDRESS IS UPDATED AND THE
	DAC*	BINBUF	/DATA WORD IS STORED IN THE OUTPUT BUFFER
	LAC	C00006	/(3 DATA WORDS FOR EVERY CODE WORD)
	JMS	SHIFT
	LAC*	CODEWD	/THE LOADER CODE WORD IS MERGED INTO THE
	XCT*	BINOUT	/OUTPUT BUFFER (3 LOADER CODES PER WORD).
	DAC*	CODEWD
	AND	S00077	/THE LODER CODE IS EXAMINED TO DETERMINE
	TAD	LDRTAB	/IF THE CORRESPONDING DATA SHOULD BE LISTED
	DAC	.+3
BINO06	JMS	OBJ500	/INITIALIZE LISTING BUFFER
	LAC*	BINBUF
	JMP
	.EJECT
/ TABLE OF ADDRESSES OF OBJECT CODE LISTING ROUTINES
/
LDRTAB	JMP	LDRTAB	/CODE	TYPE
	JMP	BINO01	/01	PROGRAM SIZE
	JMP	OBJ020	/02	LOAD ADDRESS
	JMP	OBJ030	/03	RELOCATABLE INSTRUCTION
	JMP	OBJ040	/04	ABSOLUTE INSTRUCTION, CONSTANT
	JMP	OBJ050	/05	RELOCATABLE VECTOR
	JMP	OBJ060	/06	DATA STORAGE BLOCK
	JMP	BINO01	/07	SYMBOL - FIRST WORD
	JMP	BINO01	/08	SYMBOL - SECOND WORD
	JMP	BINO01	/09	VIRTUAL GLOBAL SYMBOL DEFINITION
	JMP	BINO01	/10	INTERNAL GLOBAL SYMBOL DEFINITION
	JMP	BINO01	/11	BLOCK DATA DECLARATION
	JMP	BINO01	/12	COMMON BLOCK DEFINITION
	JMP	BINO01	/13	COMMON SYMBOL DEFINITION
	JMP	BINO01	/14	COMMON SYMBOL REFERENCE DEFINITION
	JMP	OBJ150	/15	DATA INITIALIZATION CONSTANT-WORD 1
	JMP	OBJ171	/16	DATA INITIALIZATION CONSTANT-WORD 2
	JMP	OBJ171	/17	DATA INITIALIZATION CONSTANT-WORD 3
	JMP	OBJ180	/18	DATA INITIALIZATION CONSTANT-DEFINIT
	JMP	BINO01	/19	INTERNAL SYMBOL DEFINITION
	JMP	OBJ200	/20	STRING CODE - REFERENCE ADDRESS
	JMP	OBJ210	/21	STRING CODE - DEFINITION
	JMP	BINO01	/22	INPUT/OUTPUT DEVICE ROUTINE REQUEST
	JMP	BINO01	/23	END
/
/
/
	.IFDEF	%FPP
OBJ020	LAC	C00042
	JMS	OBJ510
	LAC*	BINBUF
	JMS	OBJ640
	JMP	OBJ037	/PRINT "*ORIGIN"
	.ENDC
	.EJECT
/ ROUTINE TO LIST RELOCATABLE INSTRUCTIONS
/
OBJ030	JMS	OBJ530	/OUTPUT PROGRAM COUNTER.
	JMP	OBJ036	/EXIT IF PASS 1 OR NO LISTING
	LAC	OBJ400
	DAC	OBJB01
	LAC*	BINBUF	/TRANSLATE OCTAL OPCODE TO ITS
	AND	Z40000	/MNEMONIC COUNTERPART
OBJ031	SAD*	OBJB01
	JMP	OBJ032
	ISZ	OBJB01
	ISZ	OBJB01
	JMP	OBJ031
OBJ032	ISZ	OBJB01
	LAC*	OBJB01
	JMS	OBJ580	/PACK MNEMONIC INTO THE OUTPUT BUFFER.
	LAC*	BINBUF
	AND	S20000
	SZA		/AN ASTERISK WILL FOLLOW THE MNEMONIC IF
	LAC	C00010	/THE MEMORY REFERENCE IS INDIRECT,
	TAD	S00040	/THERWISE A SPACE WILL FOLLOW.
	JMS	OBJ510
	JMS	OBJ630	/FORMAT A SPACE BEFORE THE ADDRESS FIELD.
	LAC*	BINBUF
	JMS	FAKE
	XOR*	SYMTBC
	AND	S17777	/THE ADDRESS FIELD IS PRINTED AS EITHER
	SNA		/A SYMBOLIC REFERENCE, A PROGRAM ADDRESS,
	JMP	OBJ033	/OR AS AN UNDEFINED STRING ADDRESS.
	LAC*	BINBUF
	AND	S17777
	SAD	PC
	SKP
	JMP	OBJ035
OBJ034	LAC	C00036	/A STRING ADDRESS IS OUTPUT AS $NNNNN
	JMS	OBJ510	/WHERE NNNNN IS THE PROGRAM COUNTER
	LAC	PC
OBJ035	JMS	OBJ640	/A PROGRAM ADDRESS IS OUTPUT AS NNNNN
	JMP	OBJ036
OBJ033	LAC	SYMTBC
	AND	S77777
	JMS	TWOCMA
	TAD	SYMTBN
	SMA
	JMP	OBJ036-1
OBJ038	JMS	FAKE
	LAC*	SYMTBC
	SPA
	JMP	OBJ03A	/RELOC. LITERAL
	JMS	SETN
	JMS	TWOCMA
	DAC	NAME0
	LAC	S00050
	JMS	OBJ510
OBJ039	LAC	SYMTBC
	TAD	K00001
	DAC	SYMTBC
	JMS	FAKE
	LAC*	SYMTBC
	JMS	OBJ650	/OUTPUT LITERAL
	ISZ	NAME0
	JMP	OBJ039
	JMP	OBJ036
OBJ03A	LAC	SYMTBC
	TAD	K00001
	DAC	SYMTBC
	LAC*	SYMTBC	/GET POINTER TO REAL SYMTAB ENTRY
	DAC	SYMTBC
	LAC	S00050
	JMS	OBJ510	/OUTPUT OPEN PAREN AND SYMBOL NAME
	JMS	OBJ550	/OUTPUT SYMBOL NAME
OBJ036	JMS	INCRPC
	TAD	C00001	/INCREMENT PROGRAM COUNTER BY ONE.
OBJ037	XCT	PASS
OLIST	SKP		/OBJECT CODE IS PRINTED WHEN REQUESTED AND
	JMP	BINO01	/DURING PASS 2 ONLY.
	JMS	OBJ520
	.EJECT
/ BINARY BUFFER POINTER UPDATE
/
	.IFUND	%FPP
OBJ020=.
	.ENDC
/
BINO01	JMS	SIN540
	ISZ	WRDCTR
	JMP	BINO02
	XCT	PASS	/BINARY CODE IS NOT OUTPUT IF AN ERROR HAS
OBINRY	SKP		/OCCURED OR IF THE USER REQUESTED NONE, OR
	JMP	BINO03	/IF IT IS PASS 1.
	.IFUND	RSX
/      .WRITE 0,-13,BINBFH,50  /WRITE THE BINARY CODE TO THE OUTPUT DEVICE
	CAL	765	/	DEVICE 5 .. IOPS BINARY
	.DSA	000011	/	WRITE CODE
	.DSA	BINBFH	/	BINARY CODE BUFFER ADDRESS
Z77577	.DSA	777577	/	50 WORDS OF OUTPUT
/      .WAIT  -13	/WAIT UNTIL BUFFER HAS BEEN TRANSFERRED
	CAL	00765	/	DEVICE 5
	.DSA	000012	/	WAIT CODE
	.ENDC
	.IFDEF	RSX
	CAL	WRIT13	/WRITE BINARY FILE
	JMS	WFEV	/WAIT FOR EVENT VARIABLE TO BE SET
	LAC	(DAT13)	/LUN IN CASE OF I/O ERROR
	.ENDC
BINO03	JMS	BIN500	/INITIALIZE BINARY BUFFER AND COUNTERS.
	JMP*	BINOUT
BINO02	ISZ	CODCTR
	SKP
	JMS	BIN510	/INITIALIZE FOR NEXT LOADER CODE GROUP.
	LAC	C00023
	XCT*	BINOUT
	SZA		/THE BUFFER IS FILLED AND WRITTEN WHEN
	JMP*	BINOUT	/THE END CODE IS ENCOUNTERED.
	JMP	BINO05
	.EJECT
/ ROUTINE TO LIST ABSOLUTE INSTRUCTIONS AND CONSTANTS
/
OBJ040	JMS	OBJ530	/FORMAT PROGRAM COUNTER
	JMP	OBJ036	/EXIT IF PASS 1 OR NO LISTING
	.IFDEF	%FPP
	LAC*	ABSBIN
	SAD	FPPTST		/IS THIS A FLOATING INSTRUCTION
	JMS	OBJ554		/YES OUTPUT IT IN SYMBOLIC IF TABLE HAS IT
	SKP			/EITHER NOT FLOATING INSTRUCTION OR 
				/IT IS NOT IN THE TABLE
	JMP	OBJ036		/OUTPUT BUFFER AND UPDATE PC
	.ENDC
	LAC*	ABSBIN		/IS THIS A CONSTANT
	SAD	FPPTST
	JMP	OBJ041		/YES
	LAC*	BINBUF
	JMS	OBJ610
	SAD*	BINBUF
	SKP		/WHEN THE COMMAND HAS BEEN FORMATTED FOR
	JMP	OBJ036	/OUTPUT, THE PROGRAM COUNTER IS UPDATED.
	AND	Z67777
OBJ044	DAC	OBJB03	/ABSOLUTE COMMANDS MAY BE MICRO-CODED.
	JMS	OBJ610
	SAD	OBJB03	/THE COMPILER GENERATES COMBINATIONS OF...
	JMP	OBJ043	/	SPA OR SMA
	LAC	S00041	/	QNA OR SZA
	JMS	OBJ510	/	CLA
	LAC	CLAMNE
	JMS	OBJ580
	JMP	OBJ036
OBJ043	AND	Z77577
	DAC	OBJ620
	JMS	OBJ610
	SAD	OBJ620	/IF WE CAN'T MAKE HEADS OR TAILS OF THE WORD
	JMP	OBJ041	/SIMPLY OUTPUT IT AS A .DSA
	LAC	S00041
	JMS	OBJ510	/OUTPUT ! CHARACTER.
	LAC	OBJB03
	AND	Z77677
	JMP	OBJ044
OBJ041	JMS	OBJ620	/OUTPUT .DSA
	LAC	DSAMNE
	LAC*	BINBUF
	JMS	OBJ650	/OUTPUT CONSTANT
	JMP	OBJ036	/INCREMENT PC AND OUTPUT BUFFER
	.EJECT
/ ROUTINE TO LIST RELOCATABLE VECTORS
/
OBJ050	JMS	OBJ530	/FORMAT PROGRAM COUNTER
	JMP	OBJ036	/EXIT IF PASS 1 OR NO LISTING
	JMS	OBJ620	/FORMAT .DSA
	LAC	DSAMNE
	LAC	OBJB04
	SNA		/VECTORS ARE EITHER FUNCTION PARAMETER
	JMP	OBJ051	/ADDRESSES OR TRANSFER VECTORS FOR
	DAC	SYMTBC
	AND	Z00000	/EXTERNAL VARIABLES
	SAD	U00000	/THE ADDRESS OF A CONSTANT PARAMETER IS
	JMP	OBJ038	/OUTPUT.
	SAD	W00000
	JMP	OBJ034	/FORMAT STRING ADDRESS
	JMS	SETADR
OBJ051	LAC*	BINBUF	/SYMBOLIC VECTORS MAY REPRESENT
	AND	Z00000		/DIRECT OR INDIRECT PARAMETER ADDRESSES
	SNA			/WITH OR WITHOUT MODE BITS
	JMP	OBJ033
	JMS	OBJ650		/OUTPUT N00000
	LAC	S00053		/       +
	JMS	OBJ510
	JMP	OBJ033		/ SYMBOL NAME
/
/
/
/ ROUTINE TO LIST BLOCK STORAGE
/
OBJ060	JMS	OBJ530	/FORMAT-PROGRAM COUNTER
	JMP	OBJ061	/EXIT IF PASS 1 OR NO LISTING
	JMS	OBJ620
	LAC	BLKMNE	/FORMAT .BLK
	LAC*	BINBUF
	JMS	OBJ650	/FORMAT DATA WORD
OBJ061	JMS	INCRPC
	TAD*	BINBUF	/UPDATE PC BY DATA WORD
	JMP	OBJ037
	.EJECT
/ ROUTINE TO LIST DATA INITIALIZATION CONSTANTS
/
OBJ150	DZM	ARG
OBJ171	LAC	ARG
	TAD	K00001
	DAC	ARG		/COUNT CONSTANTS
	JMP	BINO01
OBJ180	JMS	OBJ640	/FORMAT CONSTANT ADDRESS
	LAC	S
	JMS	OBJ650	/FORMAT FIRST CONSTANT
	ISZ	ARG
	SKP
	JMP	OBJ037	/OUPUT OBJECT IMAGE
	LAC	NAME1
	JMS	OBJ650	/FORMAT SECOND CONSTANT
	ISZ	ARG
	SKP
	JMP	OBJ037	/OUTPUT OBJECT IMAGE
	LAC	NAME2
	JMS	OBJ650	/FORMAT THIRD CONSTANT, AND
	JMP	OBJ037	/OUTPUT OBJECT IMAGE
/
/
/
/ ROUTINE TO LIST STRING DEFINITIONS
/
OBJ200	DAC	OBJB01	/SAVE REFERENCE ADDRESS
	JMP	BINO01
OBJ210	LAC	C00036
	JMS	OBJ510	/OUTPUT PERIOD
	LAC	OBJB01
	JMS	OBJ640	/OUTPUT REFERENCE ADDRESS
	LAC	S00075
	JMS	OBJ510	/OUTPUT  =
	JMS	OBJ630	/OUTPUT  SPACE
	LAC*	BINBUF	/OUTPUT DEFINITION ADDRESS
	JMS	OBJ640	/...I.E...
	JMP	OBJ037	/         .REFAD = DEFAD
	.EJECT
/ SUBROUTINE TO INITIALIZE BINARY OUTPUT BUFFER
/
BIN500	CAL	0		/INITIALIZE...
	LAW	-22
	DAC	WRDCTR	/  WORD COUNTER
	LAC	BINBF0
	DAC	BINBUF	/  BUFFER STARTING ADDRESS
	JMS	BIN510	/  BUFFER COUNTERS
	JMP*	BIN500
/
/ SUBROUTINE TO UPDATE BINARY BUFFER COUNTERS
/
BIN510	CAL	0		/INITIALIZE...
	ISZ	BINBUF	/  DATA WORD STORAGE ADDRESS
	LAC	BINBUF
	DAC	CODEWD	/  LOADER CODE WORD STORAGE ADDRESS
	LAW	-3
	DAC	CODCTR	/  LOADER CODE GROUPING COUNTER
	JMP*	BIN510
/
/ SUBROUTINE TO OUTPUT SYMBOL NAME
/
OSYMBL	CAL	0
	LAC*	SYMT2A		/GET THE SECOND NAME WORD
	AND	T77777
	SZA!CLL		/IF IT IS NON-ZERO
	CML		/WE WANT TO SET BIT 0
	LAC*	SYMTW2	/OF THE FIRST WORD ON
	AND	T77777
	SZL
	XOR	W00000	/THE FIRST WORD OF THE NAME (CHARACTERS
	JMS	BINOUT	/01 THROUGH 03) ARE OUTPUT AS LOADER CODE
	XOR	C00007	/07.
	LAC*	SYMT2A	/THE SECOND WORD OF THE NAME (CHARACTERS
	AND	T77777
	SZA
	JMS	BINOUT	/04 THROUGH 06) ARE OUTPUT AS LOADER CODE
	XOR	C00008	/08.
	JMP*	OSYMBL
	.EJECT
/ SUBROUTINE TO INITIALIZE OBJECT CODE LISTING OUTPUT BUFFER
/
OBJ500	CAL	0	/INITIALIZE...
	JMS	SIN530	/SAVE CHARACTER BUFFERS AND POINTERS
	LAC	S01502
	DAC	OBJBFH	/  OUTPUT BUFFER SIZE
	LAC	OBJBF0
	DAC	SINBUF	/  OUTPUT BUFFER STARTING ADDRESS
	LAW	-4
	DAC	CHRCNT	/  CHARACTER COUNT
	LAC	S00040
	DAC	CHRBF1	/  CONTROL CHARACTER AND SPACE CHARACTER
	JMP*	OBJ500	/  TO THE OUTPUT BUFFER.
/
/
/
/ SUBROUTINE TO PACK CHARACTER INTO THE OBJECT LISTING OUTPUT BUFFER
/ CALLING SEQUENCE...
/	LAC	CHARACTER	/ASCIT CODE
/	JMS	OBJ510
/
OBJ510	CAL	0
	DAC	TCHAR
	JMS	SIN510	/THE CHARACTER BUFFER IS SHIFTED LEFT
	LAC	CHRBF1	/SEVEN PLACES AND THE CHARACTER IS MERGED
	XOR	TCHAR		/INTO THE BUFFER.
	DAC	CHRBF1
	ISZ	CHRCNT
	JMP*	OBJ510
	LAC	CHRBF1	/WHEN THE CHARACTER BUFFER IS FULL
RCLCMD	RCL		/(FIVE CHARACTERS), IT IS LEFT JUSTIFIED
	LAC	CHRBUF	/AND ENTERED INTO THE OUTPUT BUFFER.
	RAL
	DAC*	SINBUF
	ISZ	SINBUF
	LAC	CHRBF1
	RCL
	DAC*	SINBUF
	ISZ	SINBUF	/THE OUTPUF BUFFER ADDRESS AND CHARACTER
	LAW	-5		/COUNTS ARE UPDATED FOR THE NEXT SET OF
	DAC	CHRCNT	/CHARACTERS.
	LAC	S01000
	TAD	OBJBFH	/THE OUTPUT BUFFER SIZE IS UPDATED
	DAC	OBJBFH	/ACCORDINGLY.
	JMP*	OBJ510
	.EJECT
/ SUBROUTINE TO OUTPUT OBJECT LISTING OUTPUT BUFFER
/
OBJ520	CAL	0
OBJ522	LAW	-1
	SAD	CHRCNT	/SPACES ARE USED TO PAD OUT THE CURRENT
	JMP	OBJ521	/CHARACTER BUFFER AND FORCE ITS ENTRY
	LAC	S00040	/INTO THE OUTPUT BUFFER.
	JMS	OBJ510
	JMP	OBJ522
OBJ521	LAC	C00013	/A CARRIAGE RETURN IS THE LAST CHARACTER
	JMS	OBJ510	/PACKED INTO THE OUTPUT BUFFER.
	.IFUND	%NOHDG		/(RKB-069)
	JMS	SPRHDR		/(RKB-066) SHOULD WE PRINT HEADING?
	.ENDC			/(RKB-069)
	.IFUND	RSX
/      .WRITE 2,-12,OBJBFH,32  /WRITE OUTPUT BUFFER TO LISTING DEVICE
	CAL	02766		/  DEVICE 4 .. IOPS ALFA (517 ASCIT)
	.DSA	000011	/  WRITE CODE
	.DSA	OBJBFH	/  BUFFER ADDRESS
	.ENDC
	.IFUND	RSX
Z67777	.DSA	767777	/  BUFFER LENGTH
	.ENDC
	.IFUND	RSX
/      .WAIT  -12		/WAIT UNTIL THE BUFFER HAS BEEN TRANSFERRED
	CAL	00766		/  DEVICE 4
	.DSA	000012	/  WAIT CODE
	.ENDC
	.IFDEF	RSX
	CAL	WRIA12	/WRITE ON LISTING DEVICE
	JMS	WFEV	/WAIT FOR EVENT VARIABLE
	LAC	(DAT12)	/LUN IN CASE OF I/O ERROR
	.ENDC
	JMS	SIN540	/RESTORE CHARACTER BUFFER AND POINTERS
	JMP*	OBJ520
/
/
/
/ SUBROUTINE TO PACK PROGRAM COUNTER FOR OBJECT CODE LISTING
/ CALLING SEQUENCE...
/	JMS	OBJ530
/	JMP	PASS 1 OR NO LISTING
/
OBJ530	CAL	0
	XCT	PASS
	XCT	OLIST
	JMP*	OBJ530
	ISZ	OBJ530	/BUMP RETURN POINTER IF LISTING IN PROGRESS
	LAC	PC		/THE PROGRAM COUNTER IS LISTED FOR ALL
	JMS	OBJ640	/INTERMEDIATE INSTRUCTIONS AND NON-LABELED
	JMS	OBJ630	/PACK AN EXTRA SPACE.
	JMP*	OBJ530
	.EJECT
/ SUBROUTINE TO PACK N OCTAL DIGITS FOR OBJECT CODE LISTING
/ CALLING SEQUENCE...
/      LAC	OCTAL WORD
/      JMS	OBJ540
/      LAC	-N
/
OBJ540	CAL	0
	DAC	OBJB01	/SAVE OCTAL WORD
	XCT*	OBJ540
	TAD	OBJ545
OBJ541	DAC	OBJB02	/SET ADDRESS OF SHIFT VALUE
	LAC*	OBJB02
	JMS	SHIFT
	LAC	OBJB01	/SHIFT DIGIT TO LEAST SIGNIFICANT POSITION
	AND	C00007	/AND CONVERT IT TO ASCIT CODE.
	TAD	C00048
	JMS	OBJ510	/PACK CHARACTER IN OUTPUT BUFFER.
	LAC	OBJB02
	TAD	C00001
	SAD	OBJ545
	JMP*	OBJ540
	JMP	OBJ541
/
/ TABLE OF RIGHT SHIFT VALUES FOR OCTAL SHIFTING
/
K00015	.DSA	-000017	/15   6 DIGITS
K00012	.DSA	-000014	/12   5 DIGITS
K00009	.DSA	-000011	/09   4 DIGITS
K00006	.DSA	-000006	/06   3 DIGITS
	.DSA	-000003	/03   2 DIGITS
C00000	.DSA	0000000	/00   1 DIGIT
OBJ545	.DSA	OBJ545
LINCNT	-1			/(RKB-066) LINES LEFT ON THIS PAGE
PAGCNT	0			/(RKB-066) CURRENT PAGE NUMBER
	.EJECT
/ SUBROUTINE TO PACK SYMBOL FOR OBJECT CODE LISTING
/
OBJ550	CAL	0
	JMS	SETADR
	LAW	-2	/CHARACTERS 1,2 AND 3 ARE OUTPUT FIRST.
	DAC	SETADR
	LAC*	SYMTW2
OBJ551	DAC	OBJB03
	JMS	OBJ560	/THE MOST SIGNIFICANT CHARACTER IS
	TAD	K01600	/TRANSLATED FROM RADIX 50 TO ASCIT AND
	JMS	OBJ570	/OUTPUT.
	LAC	OBJB02
	JMS	OBJ560	/THE SECOND MOST SIGNIFICANT CHARACTER IS
	TAD	K00040	/TRANSLATED FROM RADIX 50 TO ASCIT AND
	JMS	OBJ570	/OUTPUT
	LAC	OBJB02
	DAC	OBJB01	/THE LEAST SIGNIFICANT CHARACTER IS
	JMS	OBJ570	/TRANSLATED TO ASCIT AND OUTPUT.
	LAC*	SYMT2A
	.IFDEF	%FPP
	AND	Z00000	/IF THE TOP THREE BITS OF THE SECOND NAME WORD
	SAD	Z00000	/ARE ALL ON IT MEANS WE'RE OUTPUTTING A
	JMP*	OBJ550	/FLOATING POINT OPCODE - RETURN NOW
	LAC*	SYMT2A	/NORMAL SYMBOL OUTPUT - RELOAD SECOND WORD
	.ENDC
	ISZ	SETADR
	JMP	OBJ551
	JMP*	OBJ550
	.EJECT
/
/ TABLE OF FPP OPCODES USED BY THE COMPILER AND THEIR MNEMONICS
/
	.IFDEF	%FPP
OBJ555	0
OBJ552	.+1
	713070		/.LOAD. R  -- (.AG)
	502566		/R50:  'UNF'
	045640		/R50: 'LD '
	713170		/.LOAD, D -- (.AO)
	502564		/R50:  'UND'
	045640		/R50: 'LD '
	713100		/.LOAD. J -- (.JG)
	020444		/R50:  'ELD'
	713660		/.STORE.  -- (.AH)
	502566		/R50:  'UNF'
	074740	/R50: 'ST '
	713770		/.STORE. D -- (.AP)
	502564		/R50:  'UND'
	074740		/R50:  'ST '
	713700		/.STORE. J -- (.JH)
	021114		/R50: 'EST'
	710440		/R-R  -- (.AJ)
	024172		/R50:  'FSB'
	710540		/D-D  -- (.AR)
	015772		/R50:  'DSB'
	710500		/J-J  -- (.JJ)
	021072		/R50: 'ESB'
	716040		/R+R  -- (.AI)
	022654		/R50:  'FAD'
	716140		/D+D  -- (.AQ)
	014454		/R50:  'DAD'
	716100		/J+J  -- (.JI)
	017554		/R50:	'EAD'
	712040		/R/R  -- (.AL)
	023066		/R50:  'FDV'
	712140		/D/D  -- (.AT)
	014666		/R50:  -- 'DDV'
	712100		/J/J  -- (.JL)
	017766		/R50:	'EDV'
	711440		/R*R  -- (.AK)
	023630		/R50:  'FMP'
	711540		/D*D  -- (.AS)
	015430		/R50:  'DMP'
	711500		/J*J  -- (.JK)
	020530		/R50:	'EMP'
	713273		/-R -- (.BA)
	023005		/R50:  'FCM'
	713460		/REVERSE REAL DIVIDE -- (.AN)
	024124		/R50:  'FRD'
	712560		/REVERSE DOUBLE DIVIDE -- (.AV)
	015724		/R50:  'DRD'
	712500		/REVERSE DBLINT DIVIDE -- (.JN)
	021024		/R50:	'ERD'
	711040		/REVERSE REAL SUBTRACT -- (.AM)
	024143		/R50:  'FRS'
	711140		/REVERSE DOUBLE SUBTRACT -- (.AU)
	015743		/R50:  'DRS'
	711100		/REVERSE DBLINT SUBTRACT -- (.JM)
	021043		/R50:	'ERS'
	716601		/BRANCH ON 0
	010221		/R50:  'BZA'
	716602		/BRANCH ON NEGATIVE
	007211		/R50:  'BMA'
	716603		/BRANCH ON NEGATIVE OR 0
	007145		/R50:  'BLE'
	714210		/DBLINT TO REAL -- (.JW)
	023541		/R50:	'FLA'
	714670		/REAL TO DBLINT -- (.JX)
	503026		/R50:	'URF'
	113050		/R50:	'XA '
OBJ553=.
	.EJECT
/
/ SUBROUTINE TO PACK AN FPP INSTRUCTION FOR OBJECT CODE LISTING
/
OBJ554	CAL	0
	LAC	OBJ552
	DAC	OBJ560
OBJ556	LAC*	OBJ560		/FETCH FIRST INSTRUCTION IN FLOATING TABLE
	SAD	OBJ553		/IS THIS THE LAST
	JMP*	OBJ554		/YES; NOT FOUND
	SAD*	BINBUF		/IS THIS ENTRY IDENTICAL TO OUTPUT INST.
	JMP	OBJ557		/YES WE HAVE FOUND THE RIGHT SYMBOL
	ISZ	OBJ560		/NO; INCREMENT PASSED THIS ENTRY
	LAC*	OBJ560		/IS THIS SYMBOL TWO WORD SYMBOL
	SPA			/NO
	ISZ	OBJ560		/YES; INCREMENT PASSED 2ND HALF
	ISZ	OBJ560
	JMP	OBJ556		/ITERATE ON NEXT ENTRY IF IT EXISTS
OBJ557	LAC	OBJ560
	DAC	SYMTBC
	JMS	OBJ550
	ISZ	OBJ554		/TAKE SECOND EXIT
	JMP*	OBJ554
	.ENDC
	.EJECT
/ SUBROUTINE TO ISOLATE A CHARACTER IN RADIX 50 MODE
/ CALLING SEQUENCE...
/      LAC	RADIX 50 WORD
/      JMS	OBJ560
/      TAD	-N	/CHARACTER POSITION..1)1600, 2)40
/
OBJ560	CAL	0
	AND	T77777
	DZM	OBJB01
	DZM	OBJB02
OBJ561	XCT*	OBJ560	/THE CHARACTER IS ISOLATED BY DIVISION
	SPA			/(REPETITIVE SUBTRACTION).
	JMP*	OBJ560
	DAC	OBJB02
	ISZ	OBJB01
	JMP	OBJ561
/
/
/
/ SUBROUTINE TO CONVERT A RADIX 50 CHARACTER TO ASCIT AND PACK IT
/
OBJ570	CAL	0
	LAC	OBJB01	/A SPACE WHICH IS.
	SZA			/ZERO (RADIX 50) TRANSLATES TO 40 (ASCIT)
	JMP	OBJ571
	LAC	S00040
	JMP	OBJ572
OBJ571	TAD	Z77744
	SNA!CMA
	LAW		/.=56
	SNA!CMA
	LAW	111	/%=45
	SMA
	TAD	K00045	/NUMBERS AND .
	TAD	S00134
	AND	S00177
OBJ572	JMS	OBJ510	/35-46 (RADIX 50) TRANSLATE TO 60-71 (ASCIT
	JMP*	OBJ570
K00045	777723
	.EJECT
/ SUBROUTINE TO PACK MNEMONIC OPCODE FOR OBJECT CODE LISTING
/ CALLING SEQUENCE...
/      LAC	MNEMONIC CODE
/      JMS	OBJ580
/
OBJ580	CAL	0
	TAD	U02020	/THE MNEMONIC IS PARTIALLY CONVERTED TO
	DAC	OBJB02	/ASCIT BEFORE IT IS PACKED FOR OUTPUT.
	JMS	OBJ590
	JMP*	OBJ580
/
/
/
/ SUBROUTINE TO TRANSLATE MODIFIED SIXBT TO ASCII AND PACK IT
/ CALLING SEQUENCE...
/      LAC	SIXBT
/      JMS	OBJ590
/
OBJ590	CAL	0
	LAC	K00012
	JMS	OBJ600	/PACK FIRST CHARACTER
	LAC	K00006
	JMS	OBJ600	/PACK SECOND CHARACTER
	LAC	C00000
	JMS	OBJ600	/PACK THIRD CHARACTER
	JMP*	OBJ590
/
/
/
/ SUBROUTINE TO POSITION, TRANSLATE, AND PACK 6-BIT CHARACTER
/ CALLING SEQUENCE...
/      LAC	SHIFT VALUE
/      JMS	OBJ600
/
OBJ600	CAL	0
	JMS	SHIFT
	LAC	OBJB02
	AND	S00077	/POSITION CHARACTER
	TAD	C00048	/TRANSLATE TO ASCIT
	JMS	OBJ510	/PACK IN OUTPUT BUFFER
	JMP*	OBJ600
	.EJECT
/ SUBROUTINE TO TRANSLATE AND OUTPUT AN ABSOUTE COMMAND
/ CALLING SEQUENCE...
/      LAC	COMMAND
/      JMS	OBJ610
/
OBJ610	CAL	0
	SAD	SNACMD
	LAC	SNAMNE
	SAD	SPACMD
	LAC	SPAMNE
	SAD	SZACMD
	LAC	SZAMNE
	SAD	CMACMD
	LAC	CMAMNE
	SAD	CLACMD
	LAC	CLAMNE
	SAD	PASS1	/SKP
	LAC	SKPMNE
	SAD	SMACMD
	LAC	SMAMNE
	SAD	RCLCMD
	LAC	RCLMNE
	SAD	LAQCMD
	LAC	LAQMNE
	SAD	TCACMD
	LAC	TCAMNE
	SAD	IACCMD
	LAC	IACMNE
	.IFUND	%FPP
	SAD	NORM18
	LAC	NRMMNE
	SAD	LRSS18
	LAC	LRSMNE
	.ENDC
	SAD	LMQCMD	/(RKB-063) CHECK FOR LMQ FROM .OR.
	LAC	LMQMNE	/(RKB-063)
	SAD	OMQCMD	/(RKB-063) CHECK FOR OMQ FROM .OR.
	LAC	OMQMNE	/(RKB-063)
SMACMD	SMA		/IF RECOGNIZABLE, PRINT IT AND EXIT WITH
	JMS	OBJ580	/SOMETHING OTHER THAN THE INSTRUCTION IN
	JMP*	OBJ610	/THE ACCUMULATOR.
/
LMQCMD	LMQ		/(RKB-063) LMQ INSTRUCTION FOR .OR.
OMQCMD	OMQ		/(RKB-063) OMQ INSTRUCTION FOR .OR.
	.EJECT
/ SUBROUTINE TO OUTPUT A PSEUDO OP
/ CALLING SEQUENCE...
/     JMS	OBJ620
/      LAC	MNEMONIC
/
OBJ620	CAL	0
	LAC	C00046
	JMS	OBJ510	/FORMAT PERIOD
	XCT*	OBJ620
	JMS	OBJ580	/FORMAT OPCODE
	JMS	OBJ630	/FORMAT 3 SPACES
	JMP*	OBJ620
/
/
/
/ SUBROUTINE TO PACK A SPACE INTO THE OUTPUT BUFFER
/
OBJ630	CAL	0
	LAC	S00040
	JMS	OBJ510	/PACK A SPACE,
	JMP*	OBJ630
/
/
/
/ SUBROUTINE TO FORMAT 13-BIT ADDRESS AND A SPACE
/ CALLING SEQUENCE...
/      LAC	ADDRESS
/      JMS	OBJ640
/
OBJ640	CAL	0
	AND	S17777
	JMS	OBJ540	/FORMAT THE ADDRESS
	LAC	K00005
	JMS	OBJ630	/FORMAT A SPACE
	JMP*	OBJ640
/
/
/
/ SUBROUTINE TO FORMAT FULL CONSTANT AND A SPACE
/ CALLING SEQUENCE...
/      LAC	CONSTANT
/      JMS	OBJ650
/
OBJ650	CAL	0
	JMS	OBJ540	/FORMAT CONSTANT
	LAC	K00006
	JMS	OBJ630	/FORMAT SPACE
	JMP*	OBJ650
	.EJECT
/ TABLE OF MEMORY REFERENCING INSTRUCTIONS GENERATED BY THE COMPILER
/
OBJ400	.DSA	DACCMD
S40000	OPCOD	DAC
U00000	OPCOD	LAC
V40000	OPCOD	TAD
X00000	OPCOD	AND
Y00000	OPCOD	JMP
T00000	OPCOD	JMS
U40000	OPCOD	XOR
JMPICM	JMP*
/
/ TABLE OF OTHER MNEMONICS
/
DSAMNE	.SIXBT	/DSA/
BLKMNE	.SIXBT	/BLK/
CMAMNE	.SIXBT	/CMA/
SKPMNE	.SIXBT	/SKP/
SNAMNE	.SIXBT	/SNA/
SMAMNE	.SIXBT	/SMA/
SPAMNE	.SIXBT	/SPA/
SZAMNE	.SIXBT	/SZA/
CLAMNE	.SIXBT	/CLA/
LAQMNE	.SIXBT	/LAQ/
RCLMNE	.SIXBT	/RCL/
CLCMNE	.SIXBT	/CLC/
TCAMNE	.SIXBT	'TCA'
IACMNE	.SIXBT	'IAC'
LMQMNE	.SIXBT	'LMQ'	/(RKB-063)
OMQMNE	.SIXBT	'OMQ'	/(RKB-063)
	.IFUND	%FPP
NRMMNE	.SIXBT	'NRM'
LRSMNE	.SIXBT	'LRS'
	.ENDC
	.TITLE	COMPILER TABLES
/ OPCODE TRANSLATION TABLE
/ INDEXED BY OPERATOR NUMBER
/ INSTRUCTION(S) GENENERATED IS EITHER A MACHINE-LEVEL INSTRUCTION OR
/ A CALL TO AN INSTRUCTIONAL SUBROUTINE.
/ FLOATING HARDWARE INSTRUCTIONS ARE RECOGNIZED BY A 71 IN BITS 0-5
/ THE ARGUMENT OF A FLOATING INSTRUCTION IS A TRANSFER VECTOR IN 
/ THE FOLLOWING LOCATION
/ A SUBROUTINE CALL IS GENERATED IF BITS 5-17 .NE. ZERO.
/      B5-17 CONTAIN THE CONCATENATED FORM OF THE SUBROUTINE NAME
/	(LESS THE FIRST CHARACTER WHICH IS A PERIOD)
/      B0 INDICATES WHETHER THE ARGUMENT IS AN ADDRESS OR A LAC ADDRESS
/	(B0 .EQ. ONE CAUSES THE LAC TO BE GENERATED)
/ THE SUBROUTINE CALLING SEQUENCE IS...
/      JMS*	NAME
/      .DSA	ARGUMENT ADDR  (+400000 IF INDIRECT)
/ OR   JMS*	NAME
/      LAC	ARGUMENT ADDR  (LAC*  IF INDIRECT)
/ A MACHINE-LEVEL INSTRUCTION IS GENERATED IF BITS 5-17 .EQ. ZERO.
/      B0-4 CONTAINS THE OPERATION CODE
/ A MACHINE-LEVEL INSTRUCTION IS....
/      XXX    ARGUMENT ADDR  (XXX*  IF INDIRECT)
/
/
OPTEMP	0			/REPLACEABLE OPERATOR TO SAVE SOME SPACE
OPTRAN	.DSA	.+1
	127477			/.AW FIX TO FLOAT SUBROUTINE
GETARG	127641			/.DA ..FETCH ARGUMENT ADDR EXTERNAL SUBR
C00045	55			/UNUSED SLOT IN TABLE
	AND			/.AND.
	LAC			/.LOAD. I
	FPPIN	000057,713070	/.LOAD. R	-- .AG
	FPPIN   000067,713170	/.LOAD. D	-- .AO
C00046	56			/UNUSED SLOT IN TABLE
	DAC			/.STORE. I
	FPPIN	000060,713660	/.STORE. R	-- .AH
	FPPIN   000070,713770	/.STORE. D	-- .AP
	XOR			/.XOR.
	.DSA	400101		/ I - I	-- .AY
	FPPIN   000062,710440	/ R - R	-- .AJ
	FPPIN   000072,710540	/ D - D	-- .AR
	TAD			/ I + I
	FPPIN	000061,716040	/ R + R -- .AI
	FPPIN   000071,716140	/ D + D	-- .AQ
	.DSA	400055		/ I / I	-- .AE
	FPPIN   000064,712040	/ R / R	-- .AL
	FPPIN 000074,712140	/ D / D -- .AT
	.DSA	400054		/ I * I	-- .AD
	FPPIN   000063,711440	/ R * R	-- .AK
	FPPIN   000073,711540	/ D * D	-- .AS
CMACMD	CMA			/- I
OPTR25	FPPIN   127521,713273	/- R	-- .BA
/
RELOPC	.DSA	.-4		/RELATIONAL OP TABLE - BASE VALUE IS 5
	SPA!CLA			/.LT.
	SPA!SNA!CLA		/.LE.
	SNA!CLA			/.EQ.
	SMA!CLA			/.GE.
	SMA!SZA!CLA		/.GT.
	SZA!CLA			/.NE.
/
FNCMNE	127740			/.EX ..FUNCTION RETURN PSEUDO STATE. NO.
	130000			/.FP OTS I/O INITIALIZE SUBR
	.DSA	000404		/BACKSPACE   -- .FT
	.DSA	000405		/REWIND	-- .FU
	.DSA	000406		/END FILE	-- .FV
SSCALC	.DSA	131013		/SUBSCRIPT CALCULATION ROUTINE  -- .SS
/
	.DSA	400056		/REVERSE DIVIDE		I-I .AF
	FPPIN   000066,712440	/REVERSE DIVIDE		R/R .AN
	FPPIN   000076,712540	/REVERSE DIVIDE		D/D .AV
	.DSA	400102		/REVERSE SUBTRACT	I-I .AZ
	FPPIN   000065,711040	/REVERSE SUBTRACT	R-R .AM
	FPPIN	000075,711140	/REVERSE SUBTRACT	D-D .AU
/
PAMNE	.DSA	130601		/.PA  PAUSE ROUTINE
STMNE	.DSA	131014		/.ST  STOP ROUTINE
CGOMNE	.DSA	130047		/.GO COMPUTED GOTO OBJECT TIME SUBROUTINE
BLANKC	.DSA	131330		/.XX BLANK COMMON LABEL
TSIMNE	.DSA	125050		/%I  INTEGER TEMP STORE MNEMONIC
TSRMNE	.DSA	125620		/%R  REAL    TEMP STORE MNEMONIC
TSDMNE	.DSA	124540		/%D  DOUBLE  TEMP STORE MNEMONIC
ACCMNE	FPPIN	127452,131421	/.AB OR .ZA -- LOC OR SUBR
	.DSA	127500		/.AX  FLOAT TO FIX SUBROUTINE
/
BCDINT	000402			/BCD READ   -- .FR
	000403			/BIN READ  -- .FS
	000407			/BCD WRITE  -- .FW
	000410			/BIN WRITE  -- .FX
BCDAIO	000361			/BCD ARRAY I/O  -- .FA
	000362			/BIN ARRAY I/O  -- .FB
	000365			/BCD ELEMENT I/O  -- .FE
	000372			/BIN ELEMENT I/O -- .FJ
BCDCLN	127766			/BCD I/O CLEANUP  -- .FF
	127767			/BIN I/O CLEANUP  -- .FG
	001342			/BCD RANDOM READ  -- .RR
	001343			/BIN RANDOM READ  -- .RS
	001347			/BCD RANDOM WRITE  -- .RW
	001350			/BIN RANDOM WRITE  -- .RX
	001321			/BCD RANDOM ARRAY I/O  -- .RA
	001322			/BIN RANDOM ARRAY I/O  -- .RB
	001325			/BCD RANDOM ELEMENT I/O  -- .RE
	001332			/BIN RANDOM ELEMENT I/O  -- .RJ
	130726			/BCD RANDON I/O CLEANUP  -- .RF
	130727			/BIN RANDOM I/O CLEANUP  -- .RG
DBLNEG	FPPIN	130221,713273	/D.I. NEGATION	.JA
DIOPS	FPPIN	000627,713100	/D.I. LOAD	.JG
S00700	700
S00600	600
S01000	1000
	FPPIN	000630,713700	/D.I. STORE	.JH
S01100	1100
S00100	100
S00500	500
	FPPIN	000632,710500	/D.I. SUBT	.JJ
S00104	104
S00105	105
	FPPIN	000631,716100	/D.I. ADD	.JI
S00106	106
S00107	107
	FPPIN 000634,712100	/D.I. DIVIDE	.JL
S00110	110
S00300	300
	FPPIN	000633,711500	/D.I. MULTIPLY	.JK
/
PWRTAB	LAC	.+1	/EXPONENTIATION TABLE - FILLS GAPING HOLE
	00122	/I**I	.BB
	0	/I**R ILLEGAL
	0	/I**D ILLEGAL
	60131	/I**J	.BI
	20123	/R**I	.BC
	20125	/R**R	.BE
	40126	/R**D	.BF
	20134	/R**J	.BL
	40124	/D**I	.BD
	40127	/D**R	.BG
	40130	/D**D	.BH
	40135	/D**J	.BM
	60133	/J**I	.BK
	0	/J**R ILLEGAL
	0	/J**D ILLEGAL
	60132	/J**J	.BJ
/
	FPPIN	000636,712500	/D.I. REV DIV.	.JN
S00400	400
S00200	200
	FPPIN	000635,711100	/D.I. REV SUBT.	.JM
PARTLD	1202	/PARTWORD LOAD	.PB
PARTST	1203	/PARTWORD STORE	.PC
DDRDSC	130034	/DATA-DIRECTED READ ELEMENT	.GD
DOTGD	130034	/DATA-DIRECTED READ S.S. VAR	.GD
	130031	/DATA-DIRECTED WRITE ELEMENT	.GA
	130033	/DATA-DIRECTED WRITE S.S. VAR	.GC
	130035	/DATA-DIRECTED READ ARRAY	.GE
	0	/HOLE IN TABLE STRUCTURE
	130032	/DATA-DIRECTED WRITE ARRAY	.GB
DOTGF	437	/DECODE .GG
	436	/ENCODE	.GF
	.EJECT
/
/ RECOGNITION TABLE FOR LOCICAL AND RELATIONAL OPERATORS (ARGUMENTS)
/
LOCTAB	.DSA	.+1	/OP-ARG   OPVALU  LEVEL
	.DSA	723775	/.FALSE.  1       (ARGUMENT)
	.DSA	775715	/.TRUE.   0       (ARGUMENT)
	.DSA	001152	/.OR.     2       2
	.DSA	004164	/.AND.    3       3
	.DSA	054754	/.NOT.    4       4
	.DSA	000764	/.LT.     5       5
	.DSA	000745	/.LE.     6       5
	.DSA	000331	/.EQ.     7       5
	.DSA	000435	/.GE.     8       5
	.DSA	000454	/.GT.     9       5
	.DSA	001065	/.NE.     10      5
	.DSA	114152	/.XOR.    11      1
LOCTBM	.DSA	LOCTBM
	.EJECT
/ CHARACTER TRANSLATION TABLE
/
/ EACH ENTRY IN THIS TABLE CONTAINS THREE FIELDS OF INFORMATION
/      1) BITS 00-06  ASCIT CHARACTER CODE
/      2) BITS 07-11  CHARACTER TYPE CODE
/      3) BITS 12-17  INTERNAL CHARACTER CODE
/
			/CHAR  ASCII  TYPE  INTERNAL
TABCHR	.DSA	044000	/ TAB  011    00	00
CHARCR	.DSA	065200	/ C/R  015    12	00
CHARLT	.DSA	765200	/ALT   175    12	00
CHARSP	.DSA	201300	/ SP   040    13	00
	.DSA	204000	/ !    041    00	00
	.DSA	211450	/ "    042    14	50
CHAROC	.DSA	215647	/ #    043    16	47
	.DSA	221450	/ $    044    14	50
	.DSA	224033	/ %    045    00	33
	.DSA	230000	/ &    046    00	00
	.DSA	235440	/ '    047    14	40
	.DSA	241042	/ (    050    10	42
	.DSA	245137	/ )    051    11	37
	.DSA	250625	/ *    052    06	25
	.DSA	254517	/ +    053    05	17
	.DSA	261236	/ ,    054    12	36
	.DSA	264514	/ -    055    05	14
	.DSA	270734	/ .    056    07	34
	.DSA	274622	/ /    057    06	22
CHAR0	.DSA	300135	/ 0    060    01	35
	.DSA	304136	/ 1    061    01	36
	.DSA	310137	/ 2    062    01	37
	.DSA	314140	/ 3    063    01	40
	.DSA	320141	/ 4    064    01	41
	.DSA	324142	/ 5    065    01	42
	.DSA	330143	/ 6    066    01	43
	.DSA	334144	/ 7    067    01	44
	.DSA	340145	/ 8    070    01	45
	.DSA	344146	/ 9    071    01	46
	.DSA	351651	/ :    072    16	51
	.DSA	355655	/ ;    073    16	55
	.DSA	360000	/ <    074    00	00
	.DSA	365201	/ =    075    12	01
	.DSA	370000	/ >    076    00	00
	.DSA	374000	/ ?    077    00	00
	.DSA	401654	/ @    100    16	54
	.DSA	404201	/ A    101    02	01
CHARB	.DSA	410202	/ B    102    02	02
CHARC	.DSA	414203	/ C    103    02	03
CHARD	.DSA	420304	/ D    104    03	04
	.DSA	424305	/ E    105    03	05
	.DSA	430406	/ F    106    04	06
	.DSA	434407	/ G    107    04	07
CHARH	.DSA	440410	/ H    110    04	10
	.DSA	444411	/ I    111    04	11
	.DSA	450212	/ J    112    02	12
	.DSA	454213	/ K    113    02	13
CHARL	.DSA	460414	/ L    114    04	14
	.DSA	464215	/ M    115    02	15
	.DSA	470216	/ N    116    02	16
CHARO	.DSA	474417	/ O    117    04	17
	.DSA	500420	/ P    120    04	20
	.DSA	504221	/ Q    121    02	21
CHARR	.DSA	510422	/ R    122    04	22
CHARS	.DSA	514223	/ S    123    02	23
	.DSA	520424	/ T    124    04	24
CHARU	.DSA	524225	/ U    125    02	25
	.DSA	530226	/ V    126    02	26
	.DSA	534227	/ W    127    02	27
	.DSA	540430	/ X    130    04	30
	.DSA	544231	/ Y    131    02	31
	.DSA	550232	/ Z    132    02	32
	.DSA	555552	/ [    133    15	52
	.DSA	560000	/ \    134    00	00
	.DSA	565653	/ ]    135    16	53
	.DSA	570000	/ ^    136    00	00
ARROW	.DSA	574000	/ _    137    00	00
/
CHR1	.DSA	065236
CHR2	.DSA	765236
CHR3	.DSA	065200
CHR4	.DSA	765200
	.EJECT
/ TABLE OF CONSTANTS
/ POSITIVE DECIMAL INTEGERS WHOSE VALUE IS LESS THAN 100000 ARE
/ IDENTIFIED BY THE LABEL CXXXXX WHERE XXXXX IS THE MAGNITUDE OF THE
/ CONSTANT. NEGATIVE INTEGERS WHOSE VALUE IS LESS THAN 100000 ARE
/ IDENTIFIED BY THE LABEL KXXXXX WHERE XXXXX IS THE MAGNITUDE.
/
	.DEC
C00002	.DSA	000002
C00003	.DSA	000003
C00004	.DSA	000004
C00006	.DSA	000006
C00007	.DSA	000007
C00009	.DSA	000009
C00011	.DSA	000011
C00014	.DSA	000014
C00017	.DSA	000017
C00019	.DSA	000019
C00020	.DSA	000020
C00021	.DSA	000021
C00022	.DSA	000022
C00023	.DSA	000023
C00024	.DSA	000024
C00026	.DSA	000026
C00028	.DSA	000028
C00029	.DSA	000029
C00030	.DSA	000030
C00031	.DSA	000031
C00032	.DSA	000032
C00034	.DSA	000034
C00035	.DSA	000035
C00036	.DSA	000036
C00039	.DSA	000039	/REVERSE DIVIDE OPERATOR
C00042	.DSA	000042	/REVERSE SUBTRACT OPERATOR
C00047	.DSA	000047
C00048	.DSA	000048
DECPNT	.DSA	044800	/CONCATENATION OF . SP SP
K00010	.DSA	-000010
K00040	.DSA	-000040
K00077	.DSA	-000077
K01600	.DSA	-001600
K08177	.DSA	-008177
K08192	.DSA	-008192
K08191	.DSA	-008191
K24576	.DSA	-024576
K04081	.DSA	-004081
	.EJECT
/ LOGICAL CONSTANTS ARE IDENTIFIED BY THE LABEL LXXXXX WHERE L IS S,T,U,
/ V,W,X,Y,Z REPRESENTING 0,1,2,3,4,5,6,7 RESPECTIVELY AND THE MOST
/ SIGNIFICANT OCTAL DIGIT AND XXXXX IS THE REMAINING FIVE DIGITS.
	.OCT
W00000	.DSA	400000
Z00000	.DSA	700000
S01200	.DSA	001200
V00000	.DSA	300000
S00777	.DSA	000777
S20000	.DSA	020000
S17777	.DSA	017777
S00077	.DSA	000077
T77700	.DSA	177700
S60000	.DSA	060000
T77777	.DSA	177777
Y77777	.DSA	677777
V60000	.DSA	360000
S00051	.DSA	000051
S00054	.DSA	000054
S00075	.DSA	000075
S00050	.DSA	000050
S00114	.DSA	000114
S00117	.DSA	000117
S00120	.DSA	000120
S00124	.DSA	000124
S00130	.DSA	000130
S00133	.DSA	000133
S00175	.DSA	000175
Z77750	.DSA	777750
S00122	.DSA	000122
S02766	.DSA	002766
S02775	.DSA	002775
S00177	.DSA	000177
S00101	.DSA	000101
S70000	.DSA	070000
	.IFDEF	%FPP
Z70000	.DSA	770000
Z10000	.DSA	710000
T31422	.DSA	131422
	.ENDC
T31442	.DSA	131442
S20564	.DSA	020564
S21042	.DSA	021042
X40000	.DSA	540000
W17777	.DSA	417777
V77777	.DSA	377777
S00111	.DSA	000111
Z77770	.DSA	777770
S00121	.DSA	000121
S07700	.DSA	007700
Z74000	.DSA	774000
Z77706	.DSA	777706
S00041	.DSA	000041
S00053	.DSA	000053
S00134	.DSA	000134
U02020	.DSA	202020
S01700	.DSA	001700
S01502	.DSA	001502
S77777	.DSA	077777
S00377	.DSA	000377
W77777	.DSA	477777
	.IFDEF	RSX
	.TITLE	RSX I/O CPB'S
/
/	RSX I/O CPB'S AND I/O SUBROUTINES
/
PARSIZ	27	/PARTITION SIZE REQUEST
	ENDPAR	/EVENT VARIABLE RETURNS LAST WORD OF PARTITION
/
PREA11	2300	/PREALLOCATE BUFFER'S
	EVA	/EVENT VARIABLE ADDRESS
	DAT11	/LUN
/
PREA12	2300	/PREALLOCATE BUFFER'S
	EVA
	DAT12
/
PREA13	2300	/PREALLOCATE BUFFER'S
	EVA
	DAT13
/
/
PARTDV	37	/READ FROM TDV
	PAREV	/EVENT VARIABLE
	SINBFH	/BUFFER ADDRESS
	45
/
REQTDV	1	/REQUEST CPB
	0	/NO EVENT VARIABLE REQUESTED
	.SIXBT	'TDV...'
	0
/
PAREV	0
PARCNT	0
VERPNT	0
SKPSWC	NOP
PARSAV	.BLOCK	52
/
/
ENDPAR	0	/LAST WORD IN PARTITION
ATTACH	0
	DAC	ATTLUN	/ATTACH TO A LUN -- SAVE LUN NUMBER
	CAL	ATACH	/ATTACH CAL
	JMP*	ATTACH	/RETURN
/
ATACH	2400	/ATTACH FUNCTION
	0	/EVENT VARIABLE ADDRESS
ATTLUN	0	/LOGCAL UNIT NUMBER
/
DETACH	0
	DAC	DETLUN	/DETACH FROM A LUN -- SAVE LUN NUMBER
	CAL	DETCH	/DETACH CAL
	JMP*	DETACH	/RETURN
/
DETCH	2500	/DETACH FUNCTION
	0	/EVENT VARIABLE ADDRESS
DETLUN	0	/LOGICAL UNIT NUMBER
/
ENTERR	0
	DAC	ENTLUN	/ENTER A FILE
	LAC	FILE	/MOVE THE FILE NAME
	DAC	ENTFIL	/TO THE ENTER CPB
	LAC	FILE+1
	DAC	ENTFIL+1
	LAC	FILE+2
	DAC	ENTFIL+2
	CAL	ENTR	/ISSUE ENTER CAL
	CAL	WFEVA	/WAIT FOR EVENT VARIABLE
	LAC	EVA	/PICK UP EVENT VARIABLE
	SMA		/WAS IT LEGAL?
	JMP*	ENTERR	/YES RETURN
	SAD	K00006	/NO -- HANDLER FILE STRUCTURED?
	JMP*	ENTERR	/NO -- REQUEST OK RETURN
	JMS	IOERR	/YES -- MUST BE AN I/O ERROR
	LAC	ENTLUN	/LUN IN CASE OF I/O ERROR
/
ENTR	3300	/ENTER CAL
	EVA	/EVENT VARIABLE ADDRESS
ENTLUN	0	/ENTER LUN
ENTFIL	.BLOCK	3	/FILE NAME
/
CLOSEL	0		/LUN PASSED IN AC, EXCEPT IS CMA'D IF ERROR
	SPA!CLL	 /CLOSE. LINK SET = 0 IF POS AC, BUT SET = 1 IF
	CML!CMA  /NEG AC, ALONG WITH MAKING NEG AC POS
	DAC	CLOLUN	/PUT LUN INTO CLOSE FUNCTION
	LAC	TADCMD  /GET CLOSE FUNCTION CODE, NOT YET JUSTIFIED,
	RTR		/AND SHIFT IN LINK - IF WAS ON, A 13400 CLOSE
	LRS	4	/FUNCTION, I.E. ERROR CLOSE, IS DEFINED.
	DAC	CLOSDT	/CLOSE FUNCTION IS DEFINED.
	CAL	CLOSDT	/ISSUE CLOSE REQUEST
	CAL	WFEVA	/WAIT FOR EVENT VARIABLE
	LAC	EVA	/PICK UP EVENT VARIABLE
	SMA		/WAS IT LEGAL?
	JMP*	CLOSEL	/RETURN
	SAD	K00006	/NO IF NOT -6
	JMP*	CLOSEL	/YES LEGAL RETURN
	SAD	K00009	/NO IF NOT -11 ALSO
	JMP*	CLOSEL
	JMS	IOERR	/I/O ERROR
	LAC	CLOLUN	/LUN OF I/O ERROR
/
CLOSDT	0		/CLOSE, ERR CLOSE, SEEK, OR DELETE
	EVA		/EVENT VARIABLE ADDRESS
CLOLUN	0		/LOGICAL UNIT NUMBER
	0		/FILE NAME
	0		/FILE NAME NOT USED IF CLOSE OR ERR CLOSE
	0		/EXT
/
SEEK	0		/LOOKS FOR EXISTING BINARY FILE WHEN
	DAC	CLOLUN	/(LUN NUMBER IN AC) BINARY IS TO BE OUTPUT.
	LAC	S03200	/IF NOT FOUND, THEN THE BINARY FILE LEFT BY
	DAC	CLOSDT	/AN ERROR CLOSE MUST BE DELETED
	LAC	FILE	/ESTABLISH FILE NAME
	DAC	CLOLUN+1
	LAC	FILE+1
	DAC	CLOLUN+2
	LAC	FILE+2	/ESTABLISH 'BIN' EXTENSION; REMAINS THAT WAY
	DAC	CLOLUN+3	/IF DELETE IS PERFORMED.
	CAL	CLOSDT	/DO SEEK TO FILENAM BIN
	CAL	WFEVA	/WAITFOR
	LAC	EVA	/GET EVENT VARIABLE
	AAC	13	/ IS -13 IF FILE NOT FOUND
	SNA!CLA
	LAC	S01000	/GET SKP BIT
	TAD	PASS2	/ADD NOP
	DAC	DELETE	/SAVE; SKP IF NO BIN FOUND, NOP OTHERWISE
	LAC	EVA
	SMA		/IF THE EVENT VARIABLE IS POSITIVE, AN EXISTING
	JMP	CLSEEK	/BIN WAS FOUND, AND IT MUST BE CLOSED
	XCT	DELETE	/ONLY NEGATIVE EV ALLOWED IS -13, FOR WHICH
	SKP		/DELETE IS A NOP
	JMP*	SEEK	/RETURN WITHOUT CLOSE WHEN BIN FILE NOT FOUND
	JMS	IOERR	/REPORT IOERR FOR ANY NEG EV OTHER THAN -13
CLSEEK	LAC	CLOLUN	/THIS LAC MUST FOLLOW IOERR AND PRECEED CLOSEL
	JMS	CLOSEL	/CLOSE SEEK'D BINARY FILE
	JMP*	SEEK
/
DELETE	NOP
/
DELBIN	0		/DELETES BINARY FILE JUST ERR CLOSED
	LAC	S03500	/SO ONLY NEED TO SET DELETE CODE
	DAC	CLOSDT	/FILENAME AND EXTENSION ARE RETAINED
	CAL	CLOSDT	/FROM WHEN SEEK WAS DONE
	JMS	WFEV	/WAITFOR, EXIT IF I/O ERROR
	LAC	CLOLUN	/PICKED UP BY WFEV IF ERROR, ELSE IS HARMLESS
	JMP*	DELBIN
/
/
WFEV	0
	CAL	WFEVA	/WAIT FOR EVENT VARIABLE
	LAC	EVA	/PICK UP EVENT VARIABLE
	SMA		/WAS IT OK?
	JMP*	WFEV	/YES -- RETURN
	XCT*	WFEV	/PICK UP THE LUN
WFEVL	DAC	.	/SAVE IT
	LAC	EVA	/PICK UP EVENT VARIABLE AGAIN
	JMS	IOERR	/GO REPORT ERROR
	LAC	WFEVL	/PICK UP THE LUN
/
/
/	I/O ERROR HAS OCCURRED OUTPUT TO USER
/		FOR-I/O ERROR LUN XX EVENT VARIABLE YYYYYY
/
IOERR	0
	TCA		/COMPLEMENT ERROR TO MAKE IT POSITIVE
	LMQ		/SAVE IT IN MQ
	LAW	-6	/DECODE 6 DIGITS
	DAC	ENDPAR	/SAVE TEMPORARILY
	LAC	(IOER-1)	/SET UP MESSAGE POINTER
	DAC*	C00008
DECOD	ECLA!LLS 3	/DECODE MQ - EVENT VARIABLE
	AAC	60	/ADD 60 TO DIGIT
DECODS	SAD	C00048	/IS IT A ZERO? C00048=60 OCTAL
	JMP	NDECOD	/YES -- SUPPRESS LEADING ZEROES
	PAL		/SAVE AC
	LAC	DECRRA	/SET UP TO JUMP OVER ZERO SUPPRESS
	DAC	DECODS	/SET JUMP
	PLA		/RESTORE AC
DECODR	DAC*	10	/STORE CHARACTER
	ISZ	ENDPAR	/FINISHED?
	JMP	DECOD	/NO DECODE IT
	LAC	(IOERL-1)	/SET UP TO DECODE THE LUN
	DAC*	C00008
	XCT*	IOERR	/PICK UP THE LUN SLOT
	IDIV		/DIVIDE BY 10 TO FIND DECIMAL LUN
	12
	PAX		/SAVE REMAINDER
	LACQ		/PICK UP QUOTENT
	AND	C00015	/MASK OFF NUMBER
	AAC	60	/ADD 60
	DAC*	10	/STORE IT
	PXA		/PICK UP REMAINDER AGAIN
	AND	C00015	/MASK IT OFF ALSO
	AAC	60	/ADD 60
	DAC*	10	/STORE IT IN THE MESSAGE
	CAL	WRIOER	/WRITE ERROR ON OUTPUT TTY
	CAL	WFEVA	/WAIT FOR MESSAGE TO COMPLETE
	LAC	C00013	/FORCE TDV TO BE CALLED
	DAC	TITLEA
	JMP	EXITR	/EXIT
/
NDECOD	CLA		/SUPPRESS PRINTING
DECRRA	JMP	DECODR	/RETURN
/
/
IOERMS	ERMSE-IOERMS+1/2*1000+3
	0
	106	/F
	117	/O
	122	/R
	055	/-
	111	/I
	057	//
	117	/O
	040	/SP
	105	/E
	122	/R
	122	/R
	117	/O
	122	/R
	040	/SP
	114	/L
	125	/U
	116	/N
	040	/SP
IOERL	0	/LUN XX
	0
	040	/SP
IOER	.BLOCK	6	/EVENT VARIABLE
	000	/NULL
	015	/CR
ERMSE	012	/LF
/
WRIOER	2700	/WRITE I/O ERROR MESSAGE
	EVA	/EVENT VARIABLE ADDRESS
	DAT3	/OUTPUT DEVICE
	3	/IMAGE ASCII
	IOERMS	/BUFFER ADDRESS
/
WFEVA	20		/WAITFOR REQEUEST
	EVA		/EVENT VARIABLE ADDRESS
EVA	0		/EVENT VARIABLE
/
/
READ11	2600	/READ REQUEST
	EVA	/EVENT VARIABLE ADDRESS
	DAT11	/LOGICAL UNIT NUMBER
	2	/MODE -- IOPS ASCII
	SINBFH	/BUFFER ADDRESS
	45	/MAX WORD COUNT
/
HINF	3600	/HANDLER INFORMATION REQUEST
	EVA	/EVENT VARIABLE ADDRESS
	DAT11	/LOGICAL UNIT NUMBER
/
WRIT3	2700	/WRITE REQUEST
	EVA	/EVENT VARIABLE ADDRESS
S990CL	DAT3	/LOGICAL UNIT NUMBER
	2	/MODE -- IOPS ASCII
DA3MSG	0	/BUFFER ADDRESS
/
WRIT12	2700	/WRITE REQUEST
	EVA	/EVENT VARIABLE ADDRESS
WR3LUN	0	/LOGICAL UNIT NUMBER
	2	/MODE -- IOPS ASCII
	SINBFH-2	/(RKB-070) BUFFER ADDRESS
/
WRFF	2700	/WRITE A FORM FEED ON THE OUTPUT DEVICE
	0	/EVENT VARIABLE NOT NECESSARY
	DAT12	/OUTPUT DEVICE
	2	/MODE IOPS ASCII
	FFMSG	/BUFFER
/
FFMSG	2002	/FORM FEED
	0
	.ASCII	''<14><175>	/FORM FEED
/
WRIT13	2700	/WRITE REQUEST
	EVA	/EVENT VARIABLE ADDRESS
	DAT13	/LOGICAL UNIT NUMBER
	0	/MODE -- IOPS BINARY
	BINBFH	/BUFFER
/
SEEK11	3200	/SEEK REQUEST FOR INPUT LUN
	EVA	/EVENT VARIABLE ADDRESS
	DAT11	/LUN
FILE	.BLOCK	3	/FILE NAME
/
WRIA12	2700	/WRITE REQUEST
	EVA	/EVENT VARIABLE ADDRESS
	DAT12	/LUN
	2	/MODE -- IOPS ASCII
	OBJBFH	/BUFFER ADDRESS
/
/	CONSTANTS
C00008	.DSA	10
C00010	.DSA	12
C00013	.DSA	15
S03200	.DSA	3200
S03500	.DSA	3500
Z67777	.DSA	767777
Z77000	777000
Z77577	.DSA	777577
Z77677	.DSA	777677
Z77744	.DSA	777744
	.ENDC
TFAO03	.DSA	0	/DIGIT COUNT FOR NUMERIC PROCESSING
BNKBTS	.DSA	0
IACCMD	IAC
TCACMD	TCA
/
Z60001=K08191
S00040=C00032
Z60000=K08192
S00052=C00042
Z40000=PASS2
/
ISUBRR	0
SPASNA	SPA!SNA
	.IFUND	RSX
PATCH	.BLOCK	40	/PATCH AREA
	.ENDC
	.IFDEF	RSX
	.LTORG
SIZECP	.SIZE		/SIZE OF F4 FOR RSX
	.ENDC
	.END	RSTRT
