	.TITLE	XVM FORTRAN IV COMPILER, PART 1
/ 
/ 
/                   FIRST PRINTING, FEBRUARY, 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) 1974, 1975 BY DIGITAL EQUIPMENT CORPORATION
/ 
/ 
        .EJECT
/
/ PART 1 OF TWO PART SOURCE FILE OF FORTRAN IV COMPILER.  THE SAME
/ EDIT NUMBER AND SOURCE FILE EXTENSION IS MAINTAINED FOR BOTH PARTS.
/
/
/EDIT #46 4 FEB 74 *TAM-43 THROUGH 38*37-REF*
/
/FORTRAN 4 COMPILER 
/ EDIT	   DATE		VERSION	PROGRAMMER	FIX
/ 050	24-NOV-74	V3A001	R.K. HYATT	CORRECTED >0E < PROB - IN PART 2
/
/ 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	CHANGED VERSION NUMBER TO V3B000
/					FOR B UPDATE OF DOS - IN PART TWO
/
/ 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
/				REDUNDENT EQUIVALENCE STATEMENTS - NEW ERROR
/				MESSAGE >17C<  - SPR#15-714
/
/ 058	3-FEB-75	V3B003	R.K. HYATT	INSERTED CHECK FOR UNBALANCED  -  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 DEFENITIONS - SPR#15-E737
/
/ 061	20-FEB-75	V3B006	R.K. HYATT	CHANGED 'HELLO' TO XVM 'VERSION' FOR PDP15 
/
/ 062	21-MAY-75		R.K. BLACKETT	REMOVED ANTIQUE CONDITIONAL ASSEMBLY
/					PARAMETERS IN PREPERATION TO XVM VERSIONS.
/
/ 063	22-MAY-75	V1X000	R.K. BLACKETT	CHANGE CODE GENERATED FOR
/					LOGICAL .OR. TO DO A BOOLEAN INCLUSIVE OR.
/
/ 064	22-MAY-75	V1X001	R.K. BLACKETT	FIX FORMAT STATEMENT CHECKER
/					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'.
/
/ 066	29-AUG-75	V1X003	R.K. BLACKETT	GIVE FORTRAN A "HEADER LINE'
/					AT THE TOP OF EACH LISTING PAGE, AND
/					COUNT LINES/PAGE.  ALSO FIXED A BUG
/					SUCH THAT A COMMA IN THE COMMAND STRING
/					WILL NOW GIVE AN ERROR, RATHER THAN
/					SEEK THE WRONG FILE NAME.
/
/ 067	18-SEP-75	V1A000	R.K. BLACKETT	ADD 'SIZE =' AND 'XX ERRORS'
/					MESSAGES. ALSO REMOVED BOSS CONDITIONALS
/					AND CHANGED THE HELLO TO 'XVM V1A000'.
/
/ 068	11-NOV-75	V1A000  R.K. BLACKETT	FIX HEADER LINE FROM GOING
/					TO -12 WHEN NO LISTING REQUIESTED
/					ALSO, COMPLETE RSX CODE IN HEADER.
/
/ 069	17-NOV-75	V1A000	R.K. BLACKETT	PUT IN CONDITIONAL ASSEMBLY
/					PARAMETERS TO ELIMINATE EITHER
/					THE LISTING TOF HEADING LINE, OR
/					END OF COMPILATION SIZE/ERROR
/					COUNT MESSAGE.  THIS IS A TEMPORARY
/					SITUATION DUE TO THE RSX VERSION
/					BEING > 8K WITH THESE FEATURES.
/
	.TITLE	XVM FORTRAN IV, ASSEMBLY PARAMETERS
/	IF RSX DEFINED MAKE RSX VERSION
/	IF %FPP DEFINED MAKE VERSION TO USE FLOATING HARDWARE
/	IF %ARGOP IS DEFINED IT IS TAKEN AS THE LENGTH OF THE ARG-OP TABLE
/
	.EJECT
	.IFDEF	RSX
/
%NOHDG=0			/(RKB-069) NO HEADING FOR NOW WITH RSX
%NOEOC=0			/(RKB-069) NO END OF COMPILATION MSG, EITHER.
ECLA=641000
/	RSX PARAMETER DEFINITIONS
/
	.IFUND	DAT2
DAT2=14
	.ENDC
	.IFUND	DAT3
DAT3=15
	.ENDC
	.IFUND	DAT11
DAT11=17
	.ENDC
	.IFUND	DAT12
DAT12=20
	.ENDC
	.IFUND	DAT13
DAT13=21
	.ENDC
	.ENDC
/
/
/
	.IFUND	%ARGOP
%ARGOP=101
	.ENDC
	.IODEV	-11,-12,-13
	.TITLE	XVM FORTRAN IV, MACRO DEFINITIONS
	.DEFIN	SYN,A
A	.DSA	0	/PUT TWO TAGS ON THIS LOCATION
	.ENDM
	.DEFIN	BLK,N
	.LOC	.+N
	.ENDM
	.DEFIN	OPCOD,A
A@CMD	A
	.SIXBT	+A+
	.ENDM
/
/	ERROR MACROS - TWO SETS, BASIC AND EXPANDED
/
	.DEFIN	ERN,A,B,C
C@A	JMS	ERRORN
	.ASCII +  @A+
	.LOC	.-2
	B
	.LOC	.+1
	.ENDM
/
	.DEFIN	ERS,A,B,C
C@A	JMS	ERRORS
	.ASCII +  @A+
	.LOC	.-2
	B
	.LOC	.+1
	.ENDM
/
	.DEFIN	ERR,A,B,C
C@A	.ASCII +  @A+
	.LOC	.-2
	JMS	ERROR1
	.LOC	.+1
	.ENDM
/
	.DEFIN	ERX,A,C
C@A	JMS	ERRORS
	.ASCII +  @A+
	.LOC	.-2
	SKP
	.LOC	.+1
	.ENDM
/
/  MACROS TO GENERATE FPP INSTRUCTIONS OR SUBROUTINE NAMES
	.IFDEF %FPP
	.DEFIN FPPIN,A,B
	B
	.ENDM
	.ENDC
	.IFUND %FPP
	.DEFIN FPPIN,A,B
	A
	.ENDM
	.ENDC
	.TITLE
	.TITLE	ONCE-ONLY INITIALIZATION CODE
/BANK-BIT INITIALIZATION-OVERLAYED
/
BEGIN=.
	.IFUND	%NOHDG		/(RKB-069) DON'T DO THIS IF WE DON'T WANT IT
	.IFUND	RSX		/(RKB-066)
	LAC*	SC.DATE		/(RKB-066) GET THE DATE
	LRSS	14		/(RKB-066) POSITION TO MONTH
	.ENDC			/(RKB-067)
	.IFDEF	RSX		/(RKB-067)
	CAL	GTDATE		/(RKB-067)
	LAC	GTDATE+2	/(RKB-067)
	.ENDC			/(RKB-067)
	RCL			/(RKB-066) EACH ENTRY IN MONTAB IS TWO WORDS LONG
	TAD	MONTAB		/(RKB-066) FIND THIS MONTH
	DAC	MONTAB		/(RKB-066)
	LAC*	MONTAB		/(RKB-066) MOVE THREE CHARACTER MONTH INTO PRINT LINE
	DAC	TOF+14		/(RKB-066) //
	ISZ	MONTAB		/(RKB-066) //
	LAC*	MONTAB		/(RKB-066) //
	DAC	TOF+15		/(RKB-066) //
	.IFUND	RSX		/(RKB-067)
	LAC*	SC.DATE		/(RKB-066) GET THE DATE BACK
	LRS	6		/(RKB-066) POSITION TO DAY IN 12-17
	AND	S00077		/(RKB-066) CLEAN IT UP
	.ENDC			/(RKB-067)
	.IFDEF	RSX		/(RKB-067)
	LAC	GTDATE+3	/(RKB-067)
	.ENDC			/(RKB-067)
	JMS	GT2D		/(RKB-066) GET TWO DECIMAL CHARACTERS
	DAC	TOF+13		/(RKB-066) PUT DAY IN PRINT LINE
	.IFUND	RSX		/(RKB-067)
	LAC*	SC.DATE		/(RKB-066) NOW GO FOR YEAR
	AND	S00077		/(RKB-066) STRIP IT
	AAC	106		/(RKB-066) YEAR IS HELD AS YEARS SINCE 1970
	.ENDC			/(RKB-067)
	.IFDEF	RSX		/(RKB-067)
	LAC	GTDATE+4	/(RKB-067)
	.ENDC			/(RKB-067)
	JMS	GT2D		/(RKB-066) GET TWO DECIAMAL CHARACTERS
	LLSS	3		/(RKB-066) POSITION ANSWER
	AAC	4		/(RKB-066) PAD WITH BLANK
	DAC	TOF+16		/(RKB-066) AND PUT YEAR IN PRINT LINE
	.IFUND	RSX		/(RKB-067)
	ISZ	SC.DATE		/(RKB-066) NOW WORD POINTS TO TIME
	LAC*	SC.DATE		/(RKB-066) GET TIME OF DAY
	LRSS	14		/(RKB-066) POSITION HOURS
	.ENDC			/(RKB-067)
	.IFDEF	RSX		/(RKB-067)
	LAC	GTDATE+5	/(RKB-067)
	.ENDC			/(RKB-067)
	JMS	GT2D		/(RKB-066) GET 2 CHARACTERS
	ALS	3		/(RKB-066) SLIDE IT
	AAC	7		/(RKB-066) MAKE SURE ':' PRINTS
	DAC	TOF+20		/(RKB-066) PUT HOURS IN PRINT LINE
	.IFUND	RSX		/(RKB-067)
	LAC*	SC.DATE		/(RKB-066) GET THE TIME
	LRS	6		/(RKB-066) POSITION FOR MINUTES
	AND	S00077		/(RKB-066) CLEAN IT UP
	.ENDC			/(RKB-067)
	.IFDEF	RSX		/(RKB-067)
	LAC	GTDATE+6	/(RKB-067)
	.ENDC			/(RKB-067)
	JMS	GT2D		/(RKB-066) CONVERT TO ASCII
	XOR	U00000		/(RKB-066) BUILD IN BOTTOM PART OF ':'
	DAC	TOF+21		/(RKB-066) AND PUT MINUTES IN PRINT LINE
	.ENDC			/(RKB-069)
	LAC	DLNOP
	DAC	RSTRT
	.IFUND	RSX
	LAC*	S00100
	AND	S70000	/GET BANK BITS
	DAC	BNKBTS
/
/ONCE-ONLY INITIALIZATION-OVERLAYED
/
OVRLAY	CAL+775
	1
	INIT02
	0
	LAC*	S00103
	.ENDC
	.IFDEF	RSX
	CAL	PARTDV	/READ THE PARAMETERS FROM  TDV
	LAC	PAREV	/PICK UP THE EVENT VARIABLE
	SPA		/IS IT LEGAL?
	JMP	REQERR	/NO -- ILLEGAL TDV REQUEST ERROR
	CAL	PREA11	/PREALLOCATE INPUT BUFFER
	CAL	WFEVA	/WAIT FOR EVENT VARIABLE
	LAC	EVA
	SMA
	JMP	.+4
	SAD	(-6)	/-6 LEGAL
	SKP
	JMS	IOERR	/OTHER ERROR POSSIBLY NOT ENUF CORE
	LAC	(DAT11)
	JMS	SIN520	/READ THE SWITCHES FOR BUFFER ALLOCKATION
BUFAL1	JMS	SIN500	/READ CHARS THRU THE 1ST SPACE SINCE TDV...
	SAD	CHARSP	/WON'T STRIP OFF THE EXTRA CHARS. IS IT A SPACE?
	JMP	BUFAL	/YES -- PROCEED TO LOOK FOR SWITCHES
	SAD	CHARLT	/NO -- ALTMODE?
	JMP	CMDERR	/YES -- ERROR
	SAD	CHARCR	/NO -- CARRIAGE RETURN?
	JMP	CMDERR	/YES -- ERROR
	JMP	BUFAL1	/NO -- IGNORE THE CHAR AND CONTINUE TO LOOK FOR A SPACE.
BUFAL	JMS	SIN500
	SAD	CHARLT	/ALTMODE?
	JMP	CMDERR	/YES COMMAND ERROR
	SAD	CHARCR	/CRTN?
	JMP	CMDERR	/YES ERRROR
	SAD	CHARB	/B?
	JMP	CHBB	/ALLOCATE A BUFFER FOR IT
	SAD	CHARL	/L?
	JMP	CHLL	/ALLOCATE A  BUFFER FOR IT
	SAD	CHARO	/O?
	JMP	CHLL	/SAME AS L
	SAD	CHARS
	JMP	CHLL	/SAME AS L
	SAD	ARROW	/END OF COMMAND STRING?
	JMP	CMDEND
	JMP	BUFAL	/NO TRY AGAIN
/
CHBB	CAL	PREA13
	LAC	(JMP	BUFAL)	/ONLY DO IT ONCE
	DAC	CHBB
	CAL	WFEVA	/WAIT FOR EVENT VARIABLE
BUFEVC	LAC	EVA	/CHECK EVENT VARIABLE
	SMA		/IS IT LEGAL?
	JMP	BUFAL	/YES GO DECODE AGAIN
	SAD	(-6)	/-6 IS ALSO LEGAL
	JMP	BUFAL
	JMS	IOERR	/OTHER ERROR POSSIBLY NOT ENUF CORE
	LAC	(DAT13)
/
CHLL	CAL	PREA12	/PREALLOCATE LISTING DEVICE
	CAL	WFEVA
	LAC	(JMP	BUFAL)	/ONLY DO IT ONCE
	DAC	CHLL
	JMP	BUFEVC	/CHECK EVENT VARIABLE
CMDEND	CAL	PARSIZ	/FIND THE PARTITION SIZE
	LAC	ENDPAR	/PICK UP THE END OF AVAILABLE MEMORY
	.ENDC
	DAC	ENDINT
	.IFDEF	RSX
	AND	S60000	/GET BANK BITS
	DAC	BNKBTS	/SET IN BANK BITS FLAG
	SNA		/CHECK FOR ZERO
	JMP	HELPP	/BOOBY TRAPED IF BANK BITS ARE 0 !!!!!!!
	.ENDC
	.IFUND	RSX
N00767	CAL 767		/.INIT INPUT (-11)
	1
	INIT02
	0
	LAC	.-1
	AND	S00200
	.ENDC
	.IFDEF	RSX
	LAC	(DAT11)	/ATTACH TO INPUT DEVICE
	JMS	ATTACH
	CAL	HINF	/DO A HANDLER INFORMATION TO FIND OUT IF DIRECTORY DEVICE
	CAL	WFEVA	/WAIT FOR EVENT VARIABLE
	LAC	EVA	/PICK UP THE EVENT VARIABLE
	AND	(040000) /MASK OFF THE DIRECTORY BITS
	.ENDC
	SZA
	LAC	DLJMP	/BULK STORAGE
	SNA
	LAC	DLNOP	/NOT BULK STORAGE
	DAC	EPS1SW	/INTO END PASS 1 SWITCH
	LAC	DLCR
	DAC	SINBFH+44
	CLC
	TAD	ENDINT
	DAC	CONTB0
	.IFUND	RSX
	LAC*	S00102
	.ENDC
	.IFDEF	RSX
	LAC	SIZECP	/PICK UP THE SIZE OF THE PARTITION INDICATOR
	.ENDC
	DAC	.FFREE
	LAC	DL155
	DAC	BINBFH
	.IFDEF	RSX
	JMP	STARTI	/START UP INIT FINISHED
HELPP	CAL	HELPM	/NOT ENUF CORE
	JMS	WFEV	/WAIT FOR EVENT VARIABLE
	LAC	C00013	/LUN INCASE OF I/O ERROR
	CAL	C00008	/EXIT
/
HELPM	2700
	EVA
	15	/ON LUN 13
	2	/IOPS ASCII
	HELPMS	/BUFFER
HELPMS	6002	/HEADER
	0
	.ASCII	/FOR-PARTITION TOO SMALL/<15>
REQERR	CAL	REQMS	/TDV ERROR
	JMS	WFEV	/WAIT FOR EVENT VARIABLE
	LAC	C00013	/LUN IN CASE OF I/O ERROR
	DAC	TITLEA
	JMP	EXITF
/
REQMS	2700
	EVA
	15	/LUN 13 TDV OUTPUT DEVICE
	2	/ASCII
	REQERM	/MESSAGE
REQERM	6002	/HEADER
	0	/CHECKSUM
	.ASCII	/FOR-TDV ERR/<15>
	.ENDC
	.IFUND	RSX
	JMP	INIT02
	.ENDC
DL155	15500
DLCR	64000
ENDINT	BEGIN
	.IFUND	RSX
DLNOP	JMS	SUB990
	.ENDC
	.IFDEF	RSX
DLNOP	NOP
	.ENDC
DLJMP	JMP	INIT01
S00102	102
S00103	103
	.IFUND	%NOHDG		/(RKB-069) DOING HEADING STUFF?
	.IFUND	RSX		/(RKB-067)
SC.DATE	147			/(RKB-066) POINTER TO SCOM DATE/TIME WORDS
	.ENDC			/(RKB-067)
	.IFDEF	RSX		/(RKB-067)
GTDATE	24			/(RKB-067)
	0			/(RKB-067)
	.BLOCK	6		/(RKB-067)
	.ENDC			/(RKB-067)
GT2D	XX			/(RKB-066) SUBROUTINE TO CONVERT TO 2 DECIMAL CHARS
	IDIV			/(RKB-066) DIVIDE INTO TWO DIGITS
	12			/(RKB-066) //
	RCL			/(RKB-066) WE ALWAYS BUILD FOR THE SECOND WORD OF A PAIR
	PAL			/(RKB-066) SAVE THE SECOND DIGIT
	LLSS	10		/(RKB-066) POSITION FIRST DIGIT
	PLA			/(RKB-066) RETURN SECOND
	XOR	(30140)		/(RKB-066) MAKE THEM PRINTING ASCII
	OMQ			/(RKB-066) SMASH THEM ALL TOGETHER
	JMP*	GT2D		/(RKB-066)
MONTAB	.-1			/(RKB-066) THE MONTHS NAMES
	.ASCII	'-JAN-'		/(RKB-066)
	.ASCII	'-FEB-'		/(RKB-066)
	.ASCII	'-MAR-'		/(RKB-066)
	.ASCII	'-APR-'		/(RKB-066)
	.ASCII	'-MAY-'		/(RKB-066)
	.ASCII	'-JUN-'		/(RKB-066)
	.ASCII	'-JUL-'		/(RKB-066)
	.ASCII	'-AUG-'		/(RKB-066)
	.ASCII	'-SEP-'		/(RKB-066)
	.ASCII	'-OCT-'		/(RKB-066)
	.ASCII	'-NOV-'		/(RKB-066)
	.ASCII	'-DEC-'		/(RKB-066)
	.ENDC			/(RKB-069)
	.TITLE	STORAGE ASSIGNMENT - TEMPORARIES AND ARRAYS
	.IFUND	RSX
	.LOC	BEGIN	/NOW SET UP PC FOR OVERLAY STORAGE
	.ENDC
	.IFDEF	RSX
				/**053** REMOVED OVERLAY BY .LOC RELOCATION
LIST	OPR			/**050** LIST MUST NOT SKIP WHEN EXECUTED ON COMMAND DECODE
	.ENDC
	.IFUND	RSX
LIST	BLK 1			/**055** FIX FOR DOS INIT PROBLEMS
	.ENDC
DOTABX	BLK 1		/END ADDRESSE OF DO-TABLE
DOTABC	BLK 1		/SECOND STRING ADDRESS TABLE
DOTABB	BLK 1		/FIRST STRING ADDRESS TABLE
DOTABA	BLK 1		/TERMINAL STATEMENT NO. TABLE
FILFLG	BLK 1
STRNGB	BLK 1		/ADDRESS OF BRANCH AROUND PARAMETERS
SSCTR	BLK 1		/SUBSCRIPT COUNTER
FCNRET	BLK 1		/SYMTAB ADDRESS OF FUNCTION RETURN
FCNFLG	BLK 1		/SUBPROGRAM FLAG - MINUS 1 FOR BLOCK DATA
NAME0	BLK 1		/ARGUMENT MODE
TFAO06	BLK 1		/LOGIC OP MODE ENTRY FLAG (MODE)
TFAO01	BLK 1		/LAST DELIMITER PROCESSED
DOM2	BLK 1
TI	BLK 1		/ADDRESS OF I-TH SUBSCRIPT
TRW2	BLK 1
TRW1	BLK 1
EQUCLS	BLK 1		/ADDR OF LAST ENTRY IN EQV CLASS LIST
RELADR	BLK 1		/ADDRESS RELATIVE TO HEAD OF EQV CLASS
DIFF	BLK 1		/DIFFERENCE IN A VARIABLES ADDR IN TWO EQV CLASSES
SUBADJ	BLK 1		/ADDRESS LINEUP ADJUSTMENT FACTOR
SUBVAL	BLK 1		/RELATIVE ADDRESS WITH RESPECT TO ONE
OLDCLS	BLK 1		/NON-ZERO IF WE ARE MERGING TWO EQV CLASSES
COMCLS	BLK 1		/NON-ZERO IF THIS EQV CLASS IS IN COMMON
HEDCLS	BLK 1		/ADDRESS OF HEAD MEMBER OF EQV CLASS
LSTVAR	BLK 1		/ADDR OF LAST VARIABLES LINKAGE WORD
FSTVAR	BLK 1		/FLAG INDICATING FIRST CLASS MEMBER
DATAFL	BLK 1		/DATA STATEMENT FLAG
TSTRNG	BLK 1		/TEMPORARY HOLD FOR STRING ADDRESS
NOP	BLK 1		/ADDRESS OF NEXT OPERATOR IN OP TABLE
CTRLSW	BLK 1		/FLAG GOVERNING WHETHER CONTINUATION IS ALLOWED
	.IFUND	RSX
FILE	BLK 3		/FILE NAME FROM COMMAND STRING
	.ENDC
STRNGA	BLK 1		/ADDR OF INSTRUCTION REQUIRING A STRING
PROCAD	BLK 1		/ADDRESS OF STATEMENT PROCESSING ROUTINE
TORDER	BLK 1		/ORDER NUMBER OF CURRENT STMT
SORDER	BLK 1		/ORDER NUMBER OF LAST STATEMENT
LABEL	BLK 1		/SYMTAB ADDR OF CURRENT STATEMENT LABEL
LOWRAD	BLK 1		/BLOCK DATA SIZE, ALSO EQV CLASS LOW ADDR
EQUSTR	BLK 1		/AMOUNT OF NON-COMMON EQUIVALENCED STORAGE
TSMTBN	BLK 1		/"STATEMENT FUNCTION" FLAG 
SYMTBN	BLK 1		/NEXT ENTRY ADDRESS IN SYMBOL TABLE
SYMTB0	BLK 1		/FIRST ADDRESS IN SYMBOL TABLE
SYMTBC	BLK 1		/ADDRESS OF CURRENT ENTRY IN SYMTAB
TSMTW7	BLK 1		/TEMP ADDRESS OF WORD 7 OF SYMTAB ENTRY
CONTBN	BLK 1		/NEXT ENTRY ADDRESS IN CONSTANT TABLE
OBJBFH	BLK 22		/PRINTING BUFFER
OBJB04	BLK 1		/TEMP STORAGE
OBJB03	BLK 1		/"
OBJB02	BLK 1		/"
OBJB01	BLK 1		/"
CODCTR	BLK 1		/LOADER CODE COUNTER
WRDCTR	BLK 1		/DATA WORD COUNTER
CODEWD	BLK 1		/LOADER CODE WORD STORAGE ADDRESS
BINBUF	BLK 1		/DATA WORD STORAGE ADDRESS
BINBFH	BLK 32		/BINARY OUTPUT BUFFER
TCHAR	BLK 1		/TEMPORARY CURRENT CHAR
KOL	BLK 1		/TEMP COLUMN COUNTER
TCHCNT	BLK 1		/TEMP CHCRACTER COUNTER
TSINBF	BLK 1		/TEMPORARY ADDRESS OF NEXT 5 CHARACTERS
TCHBF1	BLK 1		/TEMPORARY CHARACTER BUFFER
TCHBUF	BLK 1		/"
BITCTR	BLK 1		/SHIFT COUNTER FOR POSITIONING CHARACTER
COL06	BLK 1		/CONTENTS OF CONTINUATION FIELD(COLUMN 6)
UNFNBC	BLK 1		/RE--USE LAST CHARACTER FETCHED FLAG
LSTCHR	BLK 1		/LAST CHARACTER FETCHED
LEVEL	BLK 1		/CURRENT CHAR, HIERARCHY LEVEL IF OP
CHRTYP	BLK 1		/TYPE CODE OF CURRENT CHARACTER
XCHAR	BLK 1		/ASCII OF CURRENT CHAR
CHAR	BLK 1		/INTERNAL CODE FOR CURRENT CHAR
COL	BLK 1		/COLUMN COUNTER
CHRCNT	BLK 1		/CHARACTER COUNTER (WITHIN BUFFER)
SINBUF	BLK 1		/ADDRESS OF NEXT 5 CHARACTERS
CHRBF1	BLK 1		/SECOND WORD OF DOUBLEWORD CHAR BUFFER
CHRBUF	BLK 1		/FIRST WORD OF CHAR BUFFER
LINMBR	BLK 1		/(RKB-067)
	BLK 2		/(RKB-067) STORAGE FOR LINE NUMBER
SINBFH	BLK 45		/INPUT BUFFER
/
/
/ TABLES WHICH PRECEDE THE COMPILER IN MEMORY
/ DOTAB		DO TABLES
/ SYMTAB	SYMBOL TABLE
/ CONTAB	CONSTANT TABLE
/
.FFREE	0	/START OF DO + SYMTAB
CONTB0	0
	.IFDEF	RSX
PC	0
CTLPSW	0
START	0
FORMST	0
	.ENDC
	.EJECT
/	DESCRIPTION OF VARIABLES DEFINED ELSEWHERE IN THE PROGRAM
/ADDRA1		ADDRESS IN SYMTAB OF ARGUMENT 1
/ADDRA2		ADDRESS IN SYMTAB OF ARGUMENT 2
/ARGI		ADDRESS OF CURRENT ENTRY IN ARG TABLE
/ARG1		ADDRESS OF ARGUMENT 1 IN ARG TABLE
/ARG2		ADDRESS OF ARGUMENT 2 IN ARG TABLE
/ARG		ARGUMENT DESCRIPTOR WORD
/CHRCTR		POSITION NUMBER OF CURRENT SYMBOL IN SYMTAB
/CONTBC		ADDRESS OF CURRENT ENTRY IN CONSTANT TABLE
/FAOMOD		POINTS TO CURRENT JUMP TABLE
/FLS		LOW HALF OF BUFFER FOR PACKING FORMATS AND HOLLERITH CONSTANTS
/FMS		HIGH ORDER HALF OF SAME BUFFER
/FMTCNT		COUNT OF CHARACTERS REMAINING IN ABOVE BUFFER
/HFLG		"HOLLERITH MODE" FLAG FOR FORMAT SCANNER
/IDXNOP		VALUE OF NEXT OPERATOR
/IDXPOP		VALUE OF PREVIOUS OPERATOR
/IFFLAG		ON IF CURRENT STMT IS AN IF STMT
/LEVNOP		PRECEDENCE LEVEL OF NEXT OP
/LEVPOP		PRECEDENCE LEVEL OF PREVIOUS OP
/LOGIF		ON IF LOGICAL IF STMT SEEN
/LS		LOW ORDER WORD FOR NUMBER CONVERSION
/MODE		MODE TYPE FOR SPECIFICATION STMTS
/MODEA1		MODE OF ARG 1
/MODEA2		MODE OF ARG 2
/MS		HIGH ORDER WORD FOR NUMBER CONVERSION
/NAME1		FIRST WORD OF CONCATENATED SYMBOL
/NAME2		SECOND WORD OF SYMBOL
/NUMFLG		"NUMBER COLLECTED" FLAG FOR FORMAT SCANNER
/OP		OPERATOR DESCRIPTOR WORD
/OPI		ADDRESS OF LAST ENTRY IN OPERATOR TABLE
/OPVALU		VALUE OF CURRENT OPERATOR
/POP		ADDRESS OF PREVIOUS OP IN OP TABLE
/RELOPT		RELATIONAL OPERATOR TYPE
/S		HIGH ORDER RESULT OF NUMBER CONVERSION
/SHFCTR		SHIFT COUNTER
/SIGN		ARGUMENT SIGN
/SIGNA1		SIGN OF ARGUMENT 1
/SIGNA2		SIGN OF ARGUMENT 2
/SYMTW2		ADDRESS OF FIRST NAME WORD IN SYMTAB ENTRY
/SYMT2A		ADDRESS OF SECOND NAME WORD IN SYMTAB ENTRY
/SYMTW3		ADDRESS OF LENGTH WORD OF SYMTAB ENTRY
/SYMTW4		ADDRESS OF CHAIN WORD OF SYMTAB ENTRY
/SYMTW5		ADDRESS OF DIM1 WORD IN SYMTAB ENTRY
/SYMTW6		ADDRESS OF DIM2 WORD IN SYMTAB ENTRY
/TARGI		TEMPORARY HOLD FOR ARGI
/TCTR		TEMPORARY COUNTER
/TEMP0		TEMPORARY ADDRESS HOLD
/TFAO04		NUMERIC CONVERSION COMPLETE FLAG
/TFAO05		EXPONENT SIGN
/TLS		TEMP HOLD FOR LS
/TMS		TEMP HOLD FOR MS
/TOPI		TEMP HOLD FOR OPI
/TRELAD		TEMPORARY FOR RELATIVE ADDRESS
/TSI		NAME OF NEXT INTEGER/LOGICAL TEMPORARY
/TSR		NAME OF NEXT REAL/DOUBLE INTEGER TEMPORARY
/TSD		NAME OF NEXT DOUBLE PRECISION TEMPORARY
/TSMTBC		TEMP HOLD FOR CURRENT SYMTAB ADDRESS
/TSMTW4		TEMP HOLD FOR ADDRESS OF CURRENT CHAIN WORD
/TYPEA1		TYPE OF ARGUMENT 1
/TYPEA2		TYPE OF ARGUMENT 2
	.EJECT
/ ARGUMENT/OPERATOR/LEVEL LISTS ... ARG(I), OP(I)
/
/ THE FORMAT OF THE ARG(I) LIST IS....
/ BITS 0-2 IS ARGUMENT TYPE AND BITS 3-17 VARY WITH THE TYPE....
/	0  ACCUMULATOR	B03-04 ACCUMULAYOR MODE  B05-17 UNUSED
/	1  SYMBOLIC	B03-17 ADDRESS OF SYMBOL IN SYMBOL TABLE
/	2  CONSTANT	B03-17 ADDRESS OF CONSTANT IN CONSTANT TABL
/	3  TEMPORARY STORAGE	B03-17 ADDRESS OF CREATED SYMBOL IN SYMTAB
/	4  STRING	B03-04 ORIGINAL ARGUMENT MODE
/			B05-17 STRING ADDRESS
/	5  FUNCTION REFERENCE	B03-17 UNUSED
/	6  SUBSCRIPTED VARIABLE  B03-17 UNUSED
/	7  UNARY OPERATION	B03-17 UNUSED
/
/ MODE IS INDICATED AS...
/	0  INTEGER AND LOGICAL	1  REAL
/	2  DOUBLE PRECISION		3  DOUBLE INTEGER
/
/ A SYMBOL TABLE ENTRY IS EITHER 3 OR 8 WORDS LONG AND LOOKS LIKE THIS:
/
/  WORD 1: BITS 0-2=SYMBOL TYPE, BITS 3-4=MODE, BITS 5-17=DEFINITION
/	THE VALUES FOR THE SYMBOL TYPE ARE:
/	0  SCALAR NON-COMMON VARIABLE
/	1  SCALAR COMMON VARIABLE
/	2  EXTERNAL FUNCTION
/	3  DUMMY ARGUMENT (ALSO USED FOR STATEMENT NUMBERS)
/	4  NON-COMMON ARRAY
/	5  COMMON ARRAY
/	6  INTERNAL (STATEMENT) FUNCTION
/	7  DUMMY ARRAY
/
/  BITS 5-17 CONTAIN THE ACTUAL EXECUTION TIME ADDRESS DURING PASS 2
/  DURING PASS 1 THEY ARE 17777 IF THE SYMBOL HAS NOT BEEN REFERENCED
/  IN AN EXECUTABLE STATEMENT, 17776 OTHERWISE
/
/  WORD 2: FIRST WORD OF SYMBOL NAME -- BIT 0 ON IF 3 WORD SYMBOL
/	BIT 1 ON IF SYMBOL IS A DUMMY ARG USED AS A FUNCTION
/
/  WORD 3: SECOND WORD OF SYMBOL NAME - BIT 0 ON IF MODE="LOGICAL"
/
/  WORD 4: (IF ANY): AMOUNT OF STORAGE USED BY THIS SYMBOL
/
/  WORD 5: (IF ANY): CHAIN POINTER TO NEXT VARIABLE IN EQUIVALENCE BLOCK
/	POINTS TO SELF IF VARIABLE NOT EQUIVALENCED OR IN COMMON
/
/  WORD 6: (IF ANY):FIRST DIMENSION
/  WORD 7: (IF ANY):SECOND DIMENSION
/
/  WORD 8: (IF ANY): OFFSET OF THIS VARIABLE FROM BEGINNING OF THE
/	COMMON OR EQUIVALENCE BLOCK TO WHICH IT BELONGS.  FOR ARRAYS, WORD 8
/	CONTAINS THE ADDRESS OF THE ARRAY WHILE WORD 1 CONTAINS THE ADDRESS
/	OF THE ARRAY DESCRIPTOR BLOCK
/
/
/ THE FORMAT OF THE OP(I) LIST IS....
/ BIT 0 INDICATES THE SIGN OF THE CORRESPONDING ARGUMENT (ARG(I))
/	0  POSITIVE ARGUMENT
/	1  NEGATED ARGUMENT
/
/ BIT 1 INDICATES THE RELATIVE ORDER OF THE ARGUMENTS WITH RESPECT TO
/ THE OPERATOR....(USED ONLY FOR NON-COMMUTATIBE OPERATIONS)....
/	0  NORMAL	ACCUMULATOR .OP. ARGUMENT
/	1  REVERSE  ARGUMENT .OP. ACCUMULATOR
/
/ BITS 02-11 IS THE HEIRARCHY LEVEL OF THE OPERATOR PLUS THE CURRENT
/ PARENTHESIS NESTING LEVEL
/
/ BITS 12-17 IS THE OPERATOR (ENCODED AS A TRANSLATION TABLE INDEX)
/	OPERATOR	HEIRARCHY LEVEL
/	00  (OCTAL)	00  (OCTAL)	TERMINATION
/	01  01		00  00		=
/	02  02		02  02		.OR.
/	03  03		03  03		.AND.
/	04  04		04  04		.NOT.
/	05  05		05  05		.LT.
/	06  06		05  05		.LE.
/	07  07		05  05		.EQ.
/	08  10		05  05		.GE.
/	09  11		05  05		.GT.
/	10  12		05  05		.NE.
/	11  13		01  01		.XOR.
/	12  14		06  06		-
/	15  17		06  06		+
/	18  22		07  07		/
/	21  25		07  07		*
/	24  30		09  11		UNARY NEGATION
/	26  32		08  10		**
/	28  34		10  12		(F	FUNCTION OR SUBSCRIPT OPERATOR
/	30  36		00  00		,
/	31  37		00  00		)
/	32  40		00  00		)F	FUNCTION OR SUBSCRIPT CLOSURE
/	34  42		00  00		(
	.EJECT
ARG0	.DSA	ARG0+1
	.REPT	%ARGOP
	-1
ARGEND	.DSA	ARGEND		/ARG.-OP. OVFLW. ADD.
OP0	.DSA	OP0+1		/OP(I) LIST START
	.REPT	%ARGOP
	-1
EQU0	.DSA	EQU0+1
	.REPT	20
	-1
EQCLSX	.DSA	EQCLSX	/EQUIVALENCE CLASS LIST OVERFLOW ADDRESS
/
/
/ ARRAY DECLARATION SUBSCRIPT STORAGE
T0	0	/WORDS PER ELEMENT
T1	0	/FIRST SUBSCRIPT
T2	0	/SECOND SUBSCRIPT
T3	0	/THIRD SUBSCRIPT
ATX	.DSA	ATX	/LIMIT OF 3 SUBSCRIPTS
AT1	.DSA	T1	/ADDRESS OF FIRST SUBSCRIPT
/
/FILE NAME STORAGE
FILE1	0		/FIRST HALF OF PROGRAM NAME SYMBOL
FILE2	0		/SECOND HALF OF PROGRAM NAME SYMBOL
TITLEA	15		/LINE TERMINATING CHAR FOR BATCH
/
/
/ PARENTHESIS LEVEL COUNTING TABLE
/ THE PARENTHESIS COUNTING ENTRY IS PUSHED DOWN EACH TIME A FUNCTION
/ REFERENCE IS ENCOUNTERED. THE ENTRY IS PUSHED UP AT THE TERMINATION
/ OF EACH FUNCTION REFERENCE.
/	THE LEVEL NUMBER IS CONTAINED IN BITS 0-11
/
BASE0	.DSA	BASE	/INITIAL ENTRY ADDRESS
	.REPT 10
BASE	-1	/TABLE
BASEMX	.DSA	BASEMX	/END OF TABLE
BASEJ	.DSA	0	/ADDRESS OF CURRENT LEVEL COUNTER
/
/
/
/BUFFER POINTERS
/
SINBF0	.DSA	SINBFH+2
BINBF0	.DSA	BINBFH+1	/ADDRESS (-1) OF BINARY BUFFER
OBJBF0	.DSA	OBJBFH+2	/ADDRESS OF OUTPUT BUFFER
	.EJECT
/ FILE EXTENSIONS
/
SRCEXT	.SIXBT	/SRC/
LSTEXT	.SIXBT	/LST/
BINEXT	.SIXBT	/BIN/
/
/	PASS1 INITIALIZATION
/
/
INIT02	LAC	CTLPSW
	SZA
	JMP	INIT01
RSTRT	JMP	BEGIN
	.IFUND	RSX
M1BK	.DSA	400000+MESSY1-2
	JMS	SUB990
M2BK	.DSA	400000+MESSY5-2
/	.READ  -2	/ INPUT COMMAND STRING
	CAL	02776
C00008	.DSA	000010
	.DSA	SINBFH
Z77744	.DSA	777744
/	.WAIT  -2
	CAL	00776
C00010	.DSA	000012
	.ENDC
	.IFDEF	RSX
	LAC	(PARSAV-1)	/RESTORE SAVE AREA
	DAC*	C00008
	LAC	(SINBFH-1)
	DAC*	C00009
	LAW	-45
	DAC	PARCNT
	LAC*	10
	DAC*	11
	ISZ	PARCNT
	JMP	.-3
	LAC*	10	/RESTORE POINTERS ALSO
	DAC	SINBUF
	LAC*	10
	DAC	CHRCNT
	LAC*	10
	DAC	CHRBUF
	LAC*	10
	DAC	CHRBF1
	LAC*	10
	DAC	COL
	LAC	(SKP)	/SET UP TO JUMP OVER SWITCHES
	DAC	SKPSWC
STARTI=.
	.ENDC
	.TITLE	PASS 1 INITIALIZATION
/
	.IFUND	RSX
	CAL	767		/.INIT -11
	1
INM11	INIT02
START	0
	.ENDC
	LAC	CHR1	/INTERNAL FOR CR AND ESC IS 36
	DAC	CHARCR
	LAC	CHR2
	DAC	CHARLT
	.IFDEF	RSX
	LAC	(DAT11)	/ATTACH TO THE INPUT SOURCE FILE
	JMS	ATTACH
	.ENDC
	LAW	-32	/INITIALIZE IMPLICIT MODE TABLE (EDIT# 40)
	DAC	HILET	/RESET ALL ENTRIES IN THE IMPLICIT 
	LAC	DACTAB	/TYPE TABLE TO THE FORTRAN DEFAULT VALUES
	DAC	.+2
	LAC	S10000
	XX		/I THRU N ARE INTEGERS
	ISZ	.-1	/ALL OTHER LETTERS ARE REAL
	ISZ	HILET
	JMP	.-3	/FIRST SET THE ENTIRE TABLE TO REAL
	.REPT	6,1
	DZM	IMTBL+10  /THEN SET I THRU N TO INTEGER
	LAC	PASS1	/INITIALIZE....
	DAC	PASS	/	PASS SWITCH.
	.IFDEF	RSX
	XCT	SKPSWC	/SKIP IF NOT FIRST TIME
	.ENDC
	DAC	SYMMAP	/  NO SYMBOL MAP
	.IFDEF	RSX
	LAC	RSXBIN	/GET PREVIOUS 'B' SWITCH SETTING, BUT
	XCT	SKPSWC	/SKIP IF NOT THE FIRST TIME
	.ENDC
	LAC	OBSPCL	/SPECIAL, POSITIVE NO-OP
	DAC	OBINRY	/OBINRY=+NOP(NO OUTPUT),-NOP(OUTPUT, PASS1) OR SKP
	LAC	PASS2
	DAC	F4K
	.IFDEF	RSX
	XCT	SKPSWC
	.ENDC
	DAC	OPTSWC	/SUBSCRIPT CALCULATION IN-LINE : ON
	.IFDEF	RSX
	XCT	SKPSWC	/SKIP IF NOT THE FIRST TIME
	.ENDC
	DAC	SLIST		/NO SOURCE LIST
	.IFDEF	RSX
	XCT	SKPSWC	/SKIP IF NOT THE FIRST TIME
	.ENDC
	DAC	LIST		/NO LISTING DEVICE
	DAC	FT2CNG
	.IFDEF	RSX
	XCT	SKPSWC	/SKIP IF NOT THE FIRST TIME
	.ENDC
	DAC	OLIST	/NO OBJECT LIST
	LAC	EQU0
	DAC	EQUCLS	/EQUIVALENCE CLASS LIST
	JMS	INDOTB	/DO TABLE POINTERS
	TAD	C00010
	DAC	DOTABX	/DO TABLE END
	DAC	SYMTB0	/ START SYMBOL TABLE
	DZM	TSMTBN	/ (PERMANENT SYMTAB)
	DAC	SYMTBN	/SYMBOL TABLE NEXT ENTRY ADDRESS
	LAC	CONTB0
	DAC	CONTBN	/ CONSTANT TABLE NEXT ENTRY ADDRESS
	.IFDEF	RSX
	XCT	SKPSWC	/SKIP IF NOT FIRST TIME
	SKP
	JMP	CMDA	/GO DECODE THE FILE NAME
	.ENDC
	.IFUND	%NOHDG		/(RKB-069)
	DZM	PAGCNT		/(RKB-066) ZERO THE PAGE COUNTER
	.ENDC			/(RKB-069)
	.IFUND	%NOEOC		/(RKB-069)
	DZM	ERRCNT		/(RKB-067) ZERO THE ERROR COUNTER.
	.ENDC
	JMS	SIN520
	.IFDEF	RSX
INIT13	JMS	SIN500	/IGNORE UNTIL THE FIRST SPACE
	SAD	CHARSP	/IS IT A SPACE?
	JMP	INIT08	/YES DECODE SWITCHES
	SAD	CHARLT	/ALTMODE?
	JMP	CMDERR	/YES COMMAND ERROR
	SAD	CHARCR	/CRTN?
	JMP	CMDERR	/YES COMMAND ERROR
	JMP	INIT13	/NONE OF ABOVE TRY AGAIN
	.ENDC
INIT08	JMS	SIN500
	SAD	CHARCR	/CR
	JMP	CMDERR
	SAD	CHARLT		/ALT MODE
	JMP	CMDERR
	SAD	CHARB
	JMP	CMDB	/B...BINARY
	SAD	CHARL
	JMP	CMDL	/ L...LIST SOURCE
	.IFDEF	RSX
	SAD	CHARR	/CHECK FOR R SWITCH
	ISZ	VERPNT	/SET OUTPUT ON TTY SWITCH
	.ENDC
	SAD	CHARO
	JMP	CMDO	/ O...OBJECT LIST
	SAD	CHARS
	JMP	CMDS  / S...SYMBOL MAP
	SAD	CHARH	/ H...NO IN-LINE SUBSCRIPT CALCULATION
	JMP	CMDH
	SAD	ARROW
	JMP	CMDA	/_...END OF OPTION LIST
	JMP	INIT08		/ ILLEGAL CHAR...IGNORE
	.IFUND	RSX
CMDERR	JMS	SUB990	/ERROR: CR OR ALT MODE BEFORE _
	CMDERT-2
	LAC*	SCOM52
	SPA
	JMP	END999	/RETURN TO MONITOR IF IN BATCH
	JMP	INIT02
	.ENDC
	.IFDEF	RSX
CMDERR	ISZ	VERPNT	/FORCE PRINTING ON TTY
	JMS	SUB990
	CMDERT-2
	LAC	C00013	/FORCE TDV TO BE CALLED
	DAC	TITLEA
	JMP	EXITF	/EXIT FORTRAN
	.ENDC
CMDB	LAC	PASS1
	DAC	OBINRY	/ SET BINARY OPTION FLAG
	.IFDEF	RSX
	DAC	RSXBIN	/SAVE BINARY OPTION FLAG FOR RSX RE-ENTRIES
	.ENDC
	JMP	INIT08
	.IFDEF	RSX
RSXBIN	XOR	C00000
	.ENDC
CMDH	LAC	PASS1	/PUT A SKIP AT OPTSWC TO PREVENT IN-LINE
	DAC	OPTSWC	/SUBSCRIPT CALCULATION
	JMP	INIT08
CMDL	LAC	PASS1
	DAC	SLIST	/ SET SOURCE LIST OPTION FLAG
LSTSET	DAC	LIST
	JMP	INIT08
CMDO	LAC	PASS1
	DAC	OLIST	/ SET OBJECT LIST OPTION FLAG
	JMP	LSTSET
CMDS	LAC	PASS2
	DAC	SYMMAP	/ SET SYMBOL MAP OPTION FLAG
	LAC	PASS1
	JMP	LSTSET
	.IFDEF	RSX
ENDCMR	LAC	(SINBFH-1)	/SET UP TSAVE BUFFER
	DAC*	C00008
	LAC	(PARSAV-1)
	DAC*	C00009
	LAW	-45	/SAVE ALL 45 WORDS
	DAC	PARCNT
	LAC*	10
	DAC*	11
	ISZ	PARCNT
	JMP	.-3
	LAC	SINBUF	/SAVE THE POINTERS ALSO
	DAC*	11
	LAC	CHRCNT
	DAC*	11
	LAC	CHRBUF
	DAC*	11
	LAC	CHRBF1
	DAC*	11
	LAC	COL
	DAC*	11
	LAC	S00054	/SET LAST CHARACTER READ TO 54
	JMP	CMDRTN
/
ENDCMA	DZM	UNFNBC	/SET THE SWITCH TO STOP CHARACTER SCAN
	ISZ	TCTR	/6 CHARACTERS FOUND?
	JMP	CMDM14	/NO TRY AGAIN
	JMP	ENDCMR	/YES -- SAVE POINTERS
	.ENDC
CMDA	DAC	UNFNBC
	.IFDEF	RSX
	JMS	SUB990	/IDENTIFY IF R SWITCH
	.DSA	400000+MESSY1-2
	.ENDC
	DZM	TITLEA
	JMS	SIN530	/ SAVE POINTERS FOR OTHER CONVERSION
	CLC		/FETCH FILE NAME FOR DDT
	DAC	FILFLG
	JMS	FVARGO
CMDA1	LAC	NAME1
	DAC	FILE1
	LAC	NAME2
	DAC	FILE2
	JMS	SIN540	/ RE-POSITION POINTERS FOR FILE NAME
	LAW	-6
	DAC	TCTR	/ CONVERT NAME TO SIXBIT
	DZM	MS	/ FOR FILE SEARCH
	DZM	LS
CMDM14	LAW	-6
	DAC	TEMP0
	JMS	DLSHFT
	ISZ	TEMP0
	JMP	.-2
	JMS	FNBCHR
	SAD	S00054	/CHECK FOR COMMA
	.IFUND	RSX
	JMP	CMDERR		/(RKB-066) IF YES, ERROR
	.ENDC
	.IFDEF	RSX
	JMP	ENDCMA	/GO SAVE PARAMETERS
	.ENDC
	SAD	C00013	/CR
	JMP	ENDCML
	SAD	S00175	/ALT MODE
	JMP	ENDCML
	AND	S00077
	XOR	LS
	DAC	LS
CMDCNT	ISZ	TCTR
	JMP	CMDM14
	JMP	CMDONE
ENDCML	DAC	TITLEA	/FOR COMMAND BATCHING
	DZM	UNFNBC
	JMP	CMDCNT
CMDONE	LAC	TITLEA	/TEST FOR END COMMAND STRING.
	SZA
	.IFUND	RSX
	JMP	.+10	/FINISHED
	.ENDC
	.IFDEF	RSX
	JMP	.+12
	.ENDC
	JMS	FNBCHR		/FIND TERMINATOR.
	.IFDEF	RSX
	SAD	S00054	/CHECK FOR COMMA TERMINATOR
	JMP	ENDCMR	/SAVE THE BUFFER
	.ENDC
	SAD	C00013
	SKP
	SAD	S00175
	SKP
	.IFUND	RSX
	JMP	.-5
	.ENDC
	.IFDEF	RSX
	JMP	.-7	/NOT FOUND TRY AGAIN
	.ENDC
CMDRTN=.
	DAC	TITLEA
	LAC	MS
	DAC	FILE
	LAC	LS
	DAC	FILE+1	/ SET UP FILE NAME
	LAC	LSTEXT
	DAC	FILE+2	/ SET NAME EXTENSION (LST)
	LAC	CHR3	/INTERNAL FOR CR AND ESC IS 00
	DAC	CHARCR
	LAC	CHR4
	DAC	CHARLT
	LAC	JMPFT2
	DAC	FT2CNG
	XCT	LIST
	JMP	TRYBIN
	.IFUND	RSX
	CAL+5766		/(RKB-067) SUPPRESS LF ON .CLOSE
	1
M3BK	INIT02
PC	0		/PROGRAM COUNTER
/	 .ENTER -12		/ OPEN LISTING FILE
	CAL	00766
	.DSA	000004
	.DSA	FILE
	.ENDC
	.IFDEF	RSX
	LAC	(DAT12)	/ATTACH TO OUTPUT LISTING DEVICE
	JMS	ATTACH
	LAC	(DAT12)	/ENTER ON 12
	JMS	ENTERR	/ENTER FILE
	.ENDC
TRYBIN	LAC	BINEXT
	DAC	FILE+2	/ SET NAME EXTENSION (BIN)
	XCT	OBINRY
	JMP	INIT01
	.IFUND	RSX
	CAL+1765
	1
	INIT02
FORMST	0
/	 .ENTER -13		/ OPEN BINARY FILE
	CAL	00765
	.DSA	000004
	.DSA	FILE
	.ENDC
	.IFDEF	RSX
	LAC	(DAT13)	/ATTACH TO THE OUTPUT BINARY DEVICE
	JMS	ATTACH
	LAC	(DAT13)	/LOOK FOR AN EXISTING BINARY FILE; IF NONE,
	JMS	SEEK	/'DELETE' IS SET TO KILL BAD BINARY
	LAC	(DAT13)	/ENTER THE BINARY FILE
	JMS	ENTERR	/ENTER FILE
	.ENDC
	.TITLE	PASS 1 / PASS 2 COMMON INITIALIZATION
/
INIT01	JMS	INDOTB	/INITIALIZE DO TABLE POINTERS
	.IFUND	RSX
	.CLOSE	-3	/TYPE CR/LF
	.ENDC
	.IFDEF	RSX
	JMS	SUB990	/WRITE A CR LF ON THE OUTPUT TTY
	.DSA	400000+MESSY7-2
	.ENDC
	DZM	CTLPSW
	LAC	SRCEXT
	DAC	FILE+2	/ SET NAME EXTENSION (SRC)
	.IFUND	RSX
/	.SEEK  -11,FILE
	CAL	00767		/ LOCATE INPUT FILE
	.DSA	000003
	.DSA	FILE
	.ENDC
	.IFUND	%NOHDG		/(RKB-069)
	CLC			/(RKB-067)
	DAC	LINCNT		/(RKB-067)
	LAC	FILE		/(RKB-066) PUT FILE NAME IN HEADER
	LMQ			/(RKB-066) 
	JMS	CV6A		/(RKB-066) CONVERT NEXT .SIXBT CHAR TO ASCII
	ALSS	13		/(RKB-066) PACK IT TO 5/7
	DAC	TOF+6		/(RKB-066)
	JMS	CV6A		/(RKB-066) GET CHAR 2
	ALSS	4		/(RKB-066) PACK IT
	XOR	TOF+6		/(RKB-066) WITH CHAR 1
	DAC	TOF+6		/(RKB-066) //
	JMS	CV6A		/(RKB-066) DO THE THIRD
	CLQ!LRSS 3		/(RKB-066) THIS IS THE SPLIT CHAR
	XOR	TOF+6		/(RKB-066) PUT FIRST 4 BITS WITH OTHER 2 CHARS
	DAC	TOF+6		/(RKB-066) //
	LACQ			/(RKB-066) RECAL LOW 3 BITS OF THIRD CHAR
	DAC	TOF+7		/(RKB-066) PUT IT IN HEADER
	LAC	FILE+1		/(RKB-066) GET SECOND HALF OF FILE NAME
	LMQ			/(RKB-066)
	JMS	CV6A		/(RKB-066) CONVERT CHAR 4
	ALSS	10		/(RKB-066) POSITION IT
	XOR	TOF+7		/(RKB-066) COMBINE IT
	DAC	TOF+7		/(RKB-066) //
	JMS	CV6A		/(RKB-066) DO CHAR 5
	RCL			/(RKB-066) POSITION IT
	XOR	TOF+7		/(RKB-066) //
	DAC	TOF+7		/(RKB-066) //
	JMS	CV6A		/(RKB-066) SIXTH AND FINAL CHAR
	ALSS	13		/(RKB-066) SLIDE IT ALL THE WAY OVER
	XOR	(001012)	/(RKB-066) COMBINE WITH A SPACE AND 'S' FOR SRC
	DAC	TOF+10		/(RKB-066)
	.ENDC			/(RKB-069)
	.IFDEF	RSX
	CAL	SEEK11	/SEEK THE FILE
	CAL	WFEVA	/WAIT FOR EVENT VARIABLE
	LAC	EVA
	SMA		/LEGAL?
	JMP	SKOKA	/YES CONTINUE
	SAD	(-6)
	JMP	SKOKA	/YES
	JMS	IOERR	/NO I/O ERROR
SKOKA	LAC	(DAT11	/LUN IN CASE OF I/O ERROR
	.ENDC
	DZM	SORDER	/	STATEMENT ORDERING COUNTER
	DZM	LINMBR		/(RKB-067)
	JMS	BIN500	/BINARY OUTPUT BUFFER
	DZM	XCHAR	/	SOURCE IMAGE REQUIRED
	LAC	END23+1
	DAC	BINO06	/OBJECT LISTING BUFFER INITIALIZATION
	LAC	FCNFLG
	SAD	K00001
	JMP	.+4
	LAC	PC
	JMS	BINOUT	/OUTPUT PROGRAM SIZE FOR EVERYTHING
	XOR	C00001	/BUT BLOCK DATA SUBPROGRAMS.
	DZM	PC	/RESET PROGRAM COUNTER
	DZM	FCNFLG	/RESET SUBPROGRAM FLAG
	DZM	FCNRET	/AND POINTER TO SYMBOL DEFINED AS RETURN CODE
	DZM	PROCAD
	DZM	STAF	/RESET TEMPORARY STORAGE LETTER FOR STATEMEMTFUNCTIONS
	DZM	START	/INITIALIZE STARTING ADDRESS
	.TITLE	STATEMENT INITIALIZATION,RECOGNITION,EXECUTION,TERMINATION
/
CONTRL	LAC	K00001	/INITIALIZE....
	DAC	UNFNBC	/ FETCH NEXT CHARACTER INDICATOR
	DZM	LOGIF	/ LOGICAL IF STATEMENT
	DZM	RWEXPF		/ZERO "I/O LIST" FLAG
	DZM	LOGFLG		/INITIALIZE "LOGICAL VARIABLE" FLAG
	DZM	IMPLFG	/ZERO "IMPLICIT STATEMENT" FLAG
	DZM	LABEL	/ LABEL FIELD ENTRY
	DZM	OBJB04	/VECTOR IS (IS NOT) A PARAMETER (OBJ LIST)
	DZM	DATAFL
	DAC	IFFLAG	/ IF STATEMENT
	DAC	STRNGA	/STRING CLEAN-UP REQUIRED
	DAC	MODE	/EXPLICIT MODE TYPING FLAG.
	LAC	DOTABX	/THE ORIGIN OF THE NON-ERASEABLE PORTION
	DAC	SYMTB0	/OF THE SYMBOL TABLE IS RE-INSTATED.
	DZM	TSMTBN	/TEMPORARY NEXT SYMBOL TABLE ENTRY ADDRESS
/			/A NEW IMAGE IS INPUT IF THE LAST IMAGE
/			/WAS NOT FULLY PROCESSED (LAST CHARACTER
	JMS	CTRL60	/EXAMINED IS NOT THE STATEMENT TERMINATION
	JMS	SINPUT	/CHARACTER).
	JMS	SOUTPT	/THE CURRENT SOURCE IMAGE IS LISTED BEFORE
	JMS	FTC500	/PROCESSING OCCURS.
	JMP	.-3	/CONTINUATION IMAGES FOUND HERE CAN ONLY
	JMS	SINP00	/EXIST DUE TO AN ERRONEOUS LAST STATEMENT
	SKP
CTRL41	JMS	SIN530	/THE STARTING COLUMN COUNT IS SAVED TO
	DZM	TCTR		/ALLOW ITS PROPER RETURN (THIS LOGIC IS
	DZM	OP		/USED TO DECODE THE STATEMENT FOLLOWING
CTRL13	LAC	CTRLIM	/A LOGICAL DO). THE SCAN MODE IS SET TO
CTRL06	DAC	FAOMOD	/INITIAL AND PROCESSING BEGINS.
	DAC	CTRLSW	/(IMAGE RECOGNITION ALLOWS NO CONTINUATION)
CTRL18	JMS	FETCHR
	SKP		/THE SCAN IS TERMINATED WHEN THE LAST
	JMP	CTRL19	/CHARACTER HAS BEEN EXAMINED.
	SNA		/(BLANK CHARACTERS ARE IGNORED.)
	JMP	CTRL18
	TAD	FAOMOD	/PROCESSING IS DETERMINED BY THE CURRENT
	DAC	.+1		/SCAN MODE AND THE CURRENT CHARACTER UNDER
	JMP*	/CONSIDERATION.
	.IFUND	%NOHDG		/(RKB-069)
CV6A	XX			/(RKB-066) ROUTINE TO CONVERT SIXBIT TO ASCII
	LLSS!1000 6		/(RKB-066) GET NEXT CHAR
	SNA			/(RKB-066) IS IT NULL?
	AAC	40		/(RKB-066) YES, MAP IT TO SPACE
	AAC	40		/(RKB-066) DO THE CONVERTION
	XOR	(140)		/(RKB-066) //
	JMP*	CV6A		/(RKB-066) THATS IT
	.ENDC			/(RKB-069)
	.EJECT
/SUBROUTINE TO FETCH STATEMENT LABEL
/
CTRL00	SYN	ARGI
	LAC	LOGIF	/DO NOT PROCESS THE STATEMENT
	SZA		/FIELD A SECOND TIME
	JMP*	CTRL00
	JMS	SIN520
	JMS	FETSNO	/COLUMNS 1 THRU 5 MAY CONTAIN A STATEMENT
	ISZ	UNFNBC	/LABEL CONSISTING OF 1-5 DECIMAL DIGITS
	DAC	FETSNO
	LAC	XCHAR		/IF THE STATEMENT NUMBER DID NOT
	SAD	C00009		/TERMINATE WITH A TAB, THEN WE MUST
	JMP	CTRL01		/CHECK THE COLUMN COUNTER TO MAKE SURE
	LAW	-7		/THAT THE NON-DIGIT, NON-SPACE CHARACTER
	TAD	COL		/OCCURRED IN OR AFTER COLUMN SEVEN
	ERN	08N,SPA,EN	/OTHERWISE ILLEGAL ST. NO.
CTRL01	LAC	FETSNO	/RESTORE AC
	SMA		/AC NEGATIVE MEANS NO DIGITS FOUND
	JMP	CTR01
	CLA
	JMP	CTRL03
CTR01	AND	S60000	/WHEN A STATEMENT LABEL IS PRESENT, ITS
	SNA		/ASSIGNMENT WORD IS EXAMINED TO DETERMINE
	JMP	CTRL04	/IF THE LABEL HAS PREVIOUSLY BEEN
	LAC*	SYMTBC	/ASSIGNED.
	AND	S17777	/A PREVIOUS ASSIGNMENT MAY HAVE OCCURED
	SAD	PC	/DURING THIS PASS OR IT MAY HAVE OCCURED
	JMP	CTRL05	/LAST PASS. THE DEFINITION OF THE LABEL
	DAC	PC	/IS CHECKED AGAINST THE OLD DEFINITION
	ERR	01N,16340,EN	/AND AN ERROR IS SIGNALLED IF DIFFERENT
	JMP	CTRL05	/USED MORE THAN ONCE AS A STATEMENT LABEL.
CTRL04	LAC	PC	/THE LABEL IS DEFINED EQUAL TO THE CURRENT
	XOR	V60000	/PROGRAM COUNTER IF THIS IS ITS FIRST
	DAC*	SYMTBC	/OCCURANCE IN A LABEL FIELD.
CTRL05	LAC	SYMTBC	/THE LABEL-NO LABEL FLAG IS SET WITH THE
CTRL03	DAC	LABEL		/ADDRESS OF THE LABELS ENTRY IN THE SYMTAB
	JMS	SIN540	/(OR ZERO) TO INDICATE A LABEL (NO LABEL).
	JMP*	CTRL00
	.EJECT
/ SUBROUTINE TO AVOID ILLEGAL MEM REFS
/
FAKE	CAL	0
	DAC	BINBFH+1	/SAVE AC
	LAC*	FAKE
	AND	S17777	/(17777
	XOR	LACCMD	/(200000
	DAC	.+1
	XX
	.IFUND	RSX
	AND	S60000	/MAKE SURE
	JMS	TWOCMA	/OF LEGAL ADDR.
	TAD	BNKBTS
	SNL
	.ENDC
	.IFDEF	RSX
	AND	(77777)
	TCA		/THIS IS THE RIGHT WAY I HOPE !!
	TAD	ENDPAR
	SPA
	.ENDC
	ISZ	FAKE		/DO NOT EXECUTE INSTRUCTION
	LAC	BINBFH+1
	JMP*	FAKE
	.EJECT
/ STATEMENT RECOGNITION DECODING MATRIX
/
/	INITIAL MODE ROW
CTRLIM	JMP	CTRLIM	/TYPE	CHARACTER
	JMP	CTRL11	/01	NUMERIC		0123456789
	JMP	CTRL12	/02	ALPHABETIC	BCJKMNQSUVWYZ
	JMP	CTRL12	/03	ALPHABETIC	ED
	JMP	CTRL12	/04	ALPHABETIC	AEFGHILPXORT
	JMP	CTRL13	/05	OPERATOR	+-
	JMP	CTRL13	/06	OPERATOR	*/
	JMP	CTRL13	/07	PERIOD		.
	JMP	CTRL14	/08	PARENTHESIS	(
	JMP	CTRL15	/09	PARENTHESIS	)
	JMP	CTRL16	/10	DELIMETER	,=
	JMP	CTRL13	/11	SPACE
	JMP	CTRL55	/12	QUOTES		"$
	JMP	CTRL13	/13	PARTWD		[
	JMP	CTRL13	/14	MISC		:];#@
/
/	SYMBOLIC MODE ROW
CTRLSM	JMP	CTRLSM	/TYPE	CHARACTER
	JMP	CTRL18	/01	NUMERIC		0123456789
	JMP	CTRL18	/02	ALPHABETIC	BCJKMNQSUVWYZ
	JMP	CTRL18	/03	ALPHABETIC	ED
	JMP	CTRL18	/04	ALPHABETIC	AFGHILPXORT
	JMP	CTRL13	/05	OPERATOR	+-
	JMP	CTRL13	/06	OPERATOR	*/
	JMP	CTRL13	/07	PERIOD		.
	JMP	CTRL14	/08	PARENTHESIS	(
	JMP	CTRL15	/09	PARENTHESIS	)
	JMP	CTRL16	/10	DELIMITER	,=
	JMP	CTRL18	/11	SPACE
	JMP	CTRL55	/12	QUOTES		"$
	JMP	CTRL13	/13	PARTWD		[
	JMP	CTRL13	/14	MISC		:];#@
/
/	NUMERIC MODE ROW
CTRLNM	JMP	CTRLNM	/TYPE	CHARACTER
	JMP	CTRL18	/01	NUMERIC		0123456789
	JMP	CTRL13	/02	ALPHABETIC	BCJKMNQSUVWYZ
	JMP	CTRL13	/03	ALPHABETIC	ED
	JMP	CTRL19	/04	ALPHABETIC	AFGHILPXORT
	JMP	CTRL13	/05	OPERATOR	+-
	JMP	CTRL13	/06	OPERATOR	*/
	JMP	CTRL13	/07	PERIOD		.
	JMP	CTRL14	/08	PARENTHSEIS	(
	JMP	CTRL15	/09	PARENTHESIS	)
	JMP	CTRL16	/10	DELIMETER	,=
	JMP	CTRL18	/11	SPACE
	JMP	CTRL55	/12	QUOTES		"$
	JMP	CTRL13	/13	PARTWD		[
	JMP	CTRL13	/14	MISC		:];#@
	.EJECT
/ NUMERIC CHARACTER IN INITIAL MODE
CTRL11	LAC	CTRLNM	/THE SCAN CONTINUES IN THE NUMERIC MODE.
	JMP	CTRL06
/ ALPHABETIC CHARACTER IN INITIAL MODE
CTRL12	LAC	CTRLSM	/THE SCAN CONTINUES IN THE SYMBOLIC MODE
	JMP	CTRL06
/ LEFT PARENTHESIS IN ALL MODES
CTRL14	ISZ	TCTR		/THE PARENTHESIS COUNTER IS UPDATED (+1).
	JMP	CTRL13	/THE SCAN CONTINUES IN THE INITIAL MODE.
	JMP	CTRL13
/ RIGHT PARENTHESIS IN ALL MODES
CTRL15	JMS	CNSE50	/THE PARENTHESIS COUNTER IS UPDATED (-1).
	ERS	19X,<SMA>,EX1	/**058** IF PAREN COUNT GOES NEGITIVE
				/TELL THE USER HE'S MESSED UP AND HAS
				/TOO MANY RIGHT PARENS
	JMP	CTRL13	/THE SCAN CONTINUES IN THE INITIAL MODE.
/ DELIMETER IN ALL MODES
CTRL16	LAC	CHAR		/THE DELIMETER IS EITHER A COMMA OR AN
	SAD	C00001	/EQUAL SIGN.
	JMP	CTRL17
/ COMMA IN ALL MODES
	LAC	TCTR		/COMMAS INSIDE PARENTHESIS SEPARATE EITHER
	SZA		/SUBSCRIPTS OR FUNCTION PARAMETERS.
	JMP	CTRL13
	LAC	OP		/COMMAS OUTSIDE OF PARENTHESIS SEPARATE
	SNA		/LIST ITEMS WHEN NO EQUAL SIGN HAS BEEN
	JMP	CTRL13	/FOUND.
	JMS	SIN540	/A STATEMENT WITH A COMMA OUTSIDE OF
	LAC	W00000	/PARENTHESIS AND FOLLOWING AN EQUAL SIGN
	JMS	CTRL50	/CAN ONLY BE A DO STATEMENT.
	ERS	01D,<SAD DOMNE>,ED	/ERROR IF OTHERWISE
	LAC	DOADDR	/THE STATEMENT HAS BEEN IDENTIFIED AS A
	JMP	CTRL21	/DO STATEMENT.
/ EQUAL SIGN IN ALL MODES
CTRL17	LAC	TCTR		/AN EQUAL SIGN INSIDE PARENTHESIS CAN ONLY
	SZA		/BE PART OF AN IMPLIED DO WHICH
	JMP	CTRL19	/CANNOT BE PART OF AN ASSIGNMENT STATEMENT.
	ISZ	OP		/AN EQUAL SIGN OUTSIDE OF PARENTHESIS
	JMP	CTRL13	/INDICATED A DO OR AN ASSIGNMENT STATEMENT.
	.EJECT
/ STATEMENT RECOGNITION WRAP-UP
CTRL19	JMS	SIN540	/THE USE OF THE NAME .IF. IS RESERVED FOR
	DZM	ASSTMT	/GETS ISZ'D IF ASSMNT STATEMENT 
	LAC	LOGIF
	SZA
	JMP	CTRL29
CTRL07	LAC	Y00000
	JMS	CTRL50	/BECAUSE A LOGICAL IF STATEMENT MAY
	SAD	IFMNE		/CONTAIN AN ASSIGNMENT STATEMENT, THE
	SKP			/**59** CHECK IF REALLY PAREN
	JMP	CTRLXX		/**059** THIS IS NECESSARY BECAUSE
	LAC	S00050		/**059** SOMEBODY DEFINED THE INTERNAL
	SAD	XCHAR		/**59**	CODES FOR '5' AND '(' AS THE SAME
	JMP	CTRL22	/**059** IT'S A '(' - PAREN
CTRLXX	NOP	/**059** STATEMENT IS FIRST EXAMINED TO DETERMINE
	LAC	OP		/IF IT IS AN IF STATEMENT. OTHERWISE THE
	SNA		/STATEMENT IS DETERMINED TO BE EITHER AN
	JMP	CTRL23	/ASSIGNMENT STATEMENT (INCLUDING STATEMENT
CTRL29	LAC	OP
	SNA
	JMP	CTRL07
	JMS	CTRL80	/FUNCTIONS) OR A NON-ASSIGNMENT STATEMENT.
	JMS	SIN540	/AFTER THE STORAGE ASSIGNMENTS HAVE BEEN
	JMS	CTRL00	/(FETCH STATEMENT LABEL)
	LAC	V40000
	DAC	TORDER	/SET ORDER (TENTATIVELY) TO EXECUTABLE STMT
	JMS	FVARGO	/THE ASSIGNMENT
	DZM	CTRLSW	/VARIABLE AND ITS DELIMETER ARE FETCHED.
	DAC	UNFNBC	/RESET "BACKUP CHARACTER" FLAG
	DZM	PROCAD	/INDICATE ASSIGNMENT OR FUNCTION STATEMENT.
	SAD	C00028	/THE STATEMENT IS IDENTIFIED AS A
	LAC*	ARG	/STATEMENT FUNCTION WHEN THE DELIMITER
	AND	V00000	/INDICATES A FUNCTION OR SUBSCRIPT AS THE FIRST
	SAD	U00000	/OPERATOR AND THE FIRST VARIABLE TYPE
	JMP	STAFCN	/IS THAT OF A FUNCTION
	JMS	SIN540	/EXECUTABLE STATEMENT-
	DZM	STAF	/RE-INITIALIZE TEMPORARY SUFFIX
	ISZ	ASSTMT	/SET TO 1, TESTED IN EXPRSN FOR VALID =
	JMS	EXPRSN	/ASSIGNMENT STATEMENT IS DECODED.
	LAW	-110		/**052** ARE WE INBOUNDS? LIKE WITHIN
	TAD	COL		/**052** COL. 73??
	SMA!CLA			/**052** IF NOT FORGET ABOUT THE TEST
	JMP	STEXIT		/**052** WE'RE NOT IN BOUNDS SO GET ON WITH THE WORK
	LAC	XCHAR		/**052** IN BOUNDS - CHECK LAST NON BLANK FOR A C/R
	ERS	34X,<SAD C00013>,EX	/**052** IF NOT A C/R THEN GIVE AN ERROR
	.EJECT
/ STATEMENT PROCESSING COMPLETED (TERMINATED) RETURN
STEXIT	LAC	TORDER	/THE NEW STATEMENT ORDER IS SET BASED ON
	DAC	SORDER	/THE ORDER OF THE LAST STATEMENT.
EREXIT	LAC	STRNGA	/ALL STATEMENT PROCESSORS AND THE ERROR
	SMA		/ROUTINE EXIT THIS POINT.
	JMS	STRING	/THE CURRENT PROGRAM COUNTER IS STRUNG
			/(WHEN NECESSARY) TO A STATEMENT ADDRESS.
DOCLEN	LAC	DOTABA
	SAD	.FFREE	/IF THERE ARE NO ENTRIES IN THE DO TABLE,
	JMP	CONTRL	/DO NOT SEARCH FOR TERMINATION
	TAD	K00001	/IF ONE OR MORE DO LOOPS ARE STILL OPEN,
	DAC	TRW2	/CHECK WHETHER
	LAC	LABEL	/THE LABEL ON THE CURRENT STATEMENT
	SNA
	JMP	CONTRL	/(IF THERE IS ONE)
	SAD*	TRW2	/IS THE TERMINATING LABEL OF THE HIGHEST
	JMP	DO23	/LEVEL DO LOOP.
DO21	LAC	TRW2	/IF NOT, CHECK ALL OTHER DO LOOPS TO SEE
	SAD	.FFREE	/IF THIS IS THE TERMINATING LABEL
	JMP	CONTRL	/OF ANY LOWER LEVEL DO LOOP
	TAD	K00001
	DAC	TRW2
	LAC*	TRW2	/IF IT IS, A DO LOOP NESTING ERROR EXISTS.
	SAD	LABEL
	JMP	DO22
	JMP	DO21	/LOOP FOR ALL CURRENT DO LOOPS
DO23	LAC	PROCAD	/COMPARE STATEMENT TYPES.
	SAD	GOTOAD	/GO TO
	JMP	DO24
	SAD	RETADR	/RETURN
	JMP	DO24
	SAD	STOPAD	/STOP
	JMP	DO24
	SAD	PAUSAD	/PAUSE
	JMP	DO24
	SAD	IFADDR	/IF
	JMP	DO24
	JMS	DECDTP
	LAC*	DOTABB	/STATEMENT TYPE O.K. -- OUTPUT DO CLEANUP
	XOR	JMPCMD
	JMS	RELBIN	/OUTPUT THE JUMP BACK INTO THE LOOP
	LAC*	DOTABC
	JMS	STRING	/AND STRING THE EXIT JUMP
	JMP	DOCLEN	/TEST NEXT LOWER NESTING LEVEL.
DO24	ERN	09D,<DZM LABEL>,ED	/ERROR: ILLEGAL TERMINATING STMT
DO22	ERN	02L,<DZM LABEL>,EL	/ERROR: ILLEGAL DO NESTING
	.EJECT
/ NON-ASSIGNMENT STATEMENT RECOGNITION
CTRL22	LAC	IFADDR	/THIS STATEMENT HAS BEEN IDENTIFIED AS AN
	JMP	CTRL21	/IF STATEMENT.
CTRL23	LAC	NAME2		/THE STATEMENTS REAL AND READ AND END AND
	SAD	ENDMNE	/ENDFILE MUST BE RECOGNIZED SEPARATELY AS
	JMP	CTRL37	/THE FIRST 3 CHARACTERS OF EACH PAIR ARE IDENTICAL
IMCTRL	SAD	REAMNE	/(ENTRY HERE FROM "IMPLICIT" STATEMENT)
	JMP	CTRL36
	JMP	CTRL38
CTRL36	JMS	FNBCHR	/WHEN THE FIRST THREE CHARACTERS ARE REA,
	SAD	S00114		/AN ERROR IS ANNOUNCED IF THE CHARACTER
	JMP	CTRL40		/IS NEITHER D NOR L
	ERS	13I,<SAD S00104>,EI
	LAC	READAD
	JMP	CTRL21	/THE ADDRESS OF THE READ OR REAL PROCESSING
CTRL40	LAC	REALAD	/ROUTINE IS SET ACCORDINGLY.
	JMP	CTRL21
CTRL37	LAC	U00000	/WHEN THE FIRST THREE CHARACTERS ARE END,
	JMS	CTRL50	/THE NEXT NON-BLANK CHARACTER IS FETCHED.
	SNA		/IF ITS A CARRIAGE RETURN, THE STATEMENT IS
	JMP	END	/AN END STATEMENT - OTHERWISE WE CHECK FOR
	ERS	14I,<SAD C00006>,EI	/AN "ENDFILE" STATEMENT.
	LAC	Y00000
	JMS	CTRL50	/CHECK THE NEXT 3 CHARACTERS FOR "ILE"
	ERS	15I,<SAD ILEMNE>,EI	/ERROR: MISSPELLED STATEMENT.
	LAC	ENDFAD	/OTHERWISE THE STATEMENT IS IDENTIFIED AS
	JMP	CTRL21	/ENDFILE.
CTRL38	LAC	PIDTB0	/ALL OTHER
	DAC	TCTR	/NON-ASSIGNMENT STATEMENTS ARE IDENTIFIED
	LAC*	TCTR	/BY THEIR RESPECTIVE NAMES
	ERN	01I,<SAD ENDMNE>,EI	/RAN OUT OF NAMES - ERROR
	AND	T77777	/STOP, CALL, ETC.).
	SAD	NAME2
	JMP	CTRL24	/THE FIRST THREE CHARACTERS OF THE NAME
	LAC	TCTR		/ARE USED TO OBTAIN A PRELIMINARY
	TAD	C00002	/IDENTIFICATION OF THE STATEMENT.
	JMP	CTRL38+1
CTRL24	LAC*	TCTR
	DAC	NAME2		/THE RECOGNITION OF THE FIRST THREE
	ISZ	TCTR		/CHARACTERS IS ENOUGH TO IDENTIFY THE
	LAC*	TCTR		/STATEMENT (ALMOST ALWAYS TRUE). THE
	DAC	PROCAD	/PROCESSOR ADDRESS AND OTHER PERTANENT
	LAC	PIDTB0	/INFORMATION IS OBTAINED FROM THE PRIMARY
	JMS	TWOCMA	/IDENTIFICATION TABLE.
	TAD	TCTR		/THE RELATIVE POSITION OF THIS ENTRY IS
	RCR		/CALCULATED SO THAT IT MAY BE USED TO
	DAC	OP		/COMPUTE THE ADDRESS OF THE
	LAC	CTRL90	/CORRESPONDING ENTRY IN THE SECONDARY
	DAC	TEMP0	/TABLES.
CTRL31	LAC*	TEMP0
	TAD	OP		/THE SECONDARY INDENTIFICATION TABLES ARE
	DAC	TCTR		/SEARCHED WHEN THE STATEMENT NAME CONSISTS
	LAC	NAME2		/OF MORE THAN THREE CHARACTERS.
	AND	Y00000	/A SECONDARY TABLE ENTRY CONTAINS THE
	SNA		/CONCATENATION OF THE NEXT N CHARACTERS
	JMP	CTRL27	/(N = 1,2,OR 3) OF THE NAME IN BITS 2-17
	JMS	CTRL50	/AND THE NUMBER OF CHARACTERS TO EXAMINE
			/NEXT TIME IN BITS 0-1
			/THE STATEMENT IS IDENTIFIED WHEN ALL CHARACTERS
	LAC*	TCTR	/TO DATE HAVE BEEN RECOGNIZED AND THE NUMBER OF
	AND	T77777	/CHARACTERS TO EXAMINE NEXT TIME IS ZERO.
	ERS	02I,<SAD NAME2>,EI	/ERROR: CHARACTERS NOT MATCHED
	LAC*	TCTR
	DAC	NAME2		/WHEN THE CHARACTERS MATCH, THE NUMBER OF
	ISZ	TEMP0		/REMAINING CHARACTERS IS FETCHED AND THE
	JMP	CTRL31	/NEXT SECONDARY TABLE REFERENCED.
CTRL21	DAC	PROCAD	/STORE DO OR IF PROCESSOR ADDRESSES.
CTRL27	LAC	PROCAD
	SNA		/CHECK FOR "DOUBLE" STATEMENT
	JMP	DBLEXX	/WHICH IS A FUDGE
	LAC	IMPLFG
	SZA!CLL	/ARE WE IN AN "IMPLICIT" STATEMENT?
	JMP	IMPL01	/YES - GO CHECK THE KIND OF STATEMENT WE
	LAC	PROCAD	/FOUND
	SAD	IMPLAD
	SKP		/KLUDGE - "IMPLICIT" STMT HAS ORDER 1/2
	AND	Z00000	/THE SPECIFICATION STATEMENTS MUST BE
	RCR		/PROCESSED IN A PRESCRIBED MANNER.
	DAC	TORDER	/THEREFORE THE ORDER NUMBER OF THE CURRENT
	JMS	TWOCMA	/STATEMENT IS COMPARED AGAINST THE ORDER
	TAD	SORDER	/OF THE LAST STATEMENT.
	ERN	03I,SMA!SZA,EI	/ERROR: STATEMENT OUT OF ORDER.
	JMS	TSTORD	/STATEMENTS ARE ORDERED AS FOLLOWS...
	JMP	CTRL33	/ 00  BLOCK DATA, FUNCTION, SUBROUTINE
			/ 01  INTEGER, REAL, LOGICAL, DBL PREC, DBL INT.
	LAC	TORDER	/ 02  DIMENSION
	TAD	Z00000	/ 03  COMMON
	SPA		/ 04  EQUIVALENCE, EXTERNAL (FLOATS)
	JMP	CTRL34	/ 05 DATA STATEMENT
	XCT	PASS	/ 06 STATEMENT FUNCTIONS
			/ 07  ALL OTHERS
	JMP	SEMI00	/CHECK FOR COMMON-DATA ';' OR DIMEN, PASS 2
	JMP	CTRL34	/STORAGE ASSIGNMENT STATEMENTS ARE NOT
CTRL33	SZA		/PROCESSED DURING PASS 2.
	JMS	CTRL80	/ONLY DATA STATEMENTS AND STORAGE
			/ASSIGNMENT STATEMENTS MAY APPEAR IN A
CTRL34	JMS	SIN530
	JMS	CTRL00
	JMS	TSTORD
	SNA
	JMS	CTRL70
	JMS	INAOPI	/BLOCK DATA SUBPROGRAM.
	CLA		/APPEAR IN BLOCK DATA SUBPROGRAMS.
	JMP*	PROCAD
DBLEXX	LAC	U00000	/"DOUBLE" STATEMENT CAN EITHER BE "DOUBLE INTEGER"
	JMS	CTRL50	/OR "DOUBLE PRECISION" - GET A CHARACTER AND
	JMP	CTRL38	/KEEP DECODING THE STATEMENT
SEMI00	LAC	TORDER	/WANT TO TRAP DIMENSION STATEMENTS IN PASS 2
	SAD	T00000	/SUCH THAT ADJUSTABLE DIMENSION MAY BE
	JMP	DIMENS	/PROCESSED TO OUTPUT ADJUSTMENT ROUTINES
	SAD	T40000
	JMP	SEMI01	/LOOK FOR COMMON SEMICOLON FUDGE
	JMP	CONTRL	/IF NOT A COMMON STMT, FORGET IT
SEMI01	JMS	FNBCHR	/GET A CHAR
	SAD	S00073	/IF ITS A SEMICOLON,
	JMP	SEMI02	/WE'VE FOUND OUR KLUDGE
	SAD	C00013
	JMP	CONTRL	/AHHH... AN ORDINARY COMMON STATEMENT
	JMP	SEMI01	/KEEP LOOKING
SEMI02	LAC	U40000	/CHANGE THE STATEMENT ORDER
	DAC	TORDER	/TO THAT OF A DATA STATEMENT
	LAC	FCNFLG	/THE SEMICOLON CONSTRUCTION
	ERS	11I,<SAD K00001>,EI	/IS ONLY GOOD IN A BLOCK DATA
	JMP	DATA		/SUBPROGRAM
T40000	140000
S00073	73
ASSTMT	XX
	.EJECT
/ PRIMARY STATEMENT IDENTIFICATION TABLE
/ EACH ENTRY IN THIS TABLE CONSISTS OF TWO WORDS. THE FIRST WORD
/ CONTAINS IN BITS 2-17 THE CONCATENATED FORM OF THE FIRST THREE
/ CHARACTERS OF THE NAME. BITS 0-1 CONTAIN THE NUMBER OF CHARACTERS TO
/ BE EXAMINED AGAINST THE FIRST SECONDARY IDENTIFICATION TABLE.
/ THE SECOND WORD CONTAINS IN BITS 3-17 THE ADDRESS OF THE CORRESPONDING
/ STATEMENT PROCESSING ROUTINE. BITS 0-2 CONTAIN A NUMBER INDICATING
/ THE PRESCRIBED ORDER OF APPEARANCE FOR THE STATEMENT.
/
PIDTB0	.DSA	.+1
	.DSA	620775	/EQU
	.DSA	400000+EQUIVA  /EQUIVALENCE
	.DSA	600020		/P (FUDGE)
DBPRAD	.DSA	100000+DBLPRC	/DOUBLE PRECISION
	.DSA	675012	/SUB
	.DSA	000000+SUBROU  /SUBROUTINE
	.DSA	615165	/DIM
	.DSA	200000+DIMENS  /DIMENSION
	.DSA	607157	/BLO
	.DSA	000000+BLOCKD  /BLOCK DATA
	.DSA	606253	/BAC
	.DSA	700000+BACKSP  /BACKSPACE
	.DSA	600011		/I (FUDGE)
DBINAD	.DSA	100000+DBLINT	/DOUBLE INTEGER
	.DSA	621424	/EXT
	.DSA	400000+EXTERN  /EXTERNAL
	.DSA	612446	/CON
	.DSA	700000+CONTIN  /CONTINUE
FUNMNE	.DSA	624326	/FUN
	.DSA	000000+FUNCTI  /FUNCTION
	.DSA	635130		/IMP
IMPLAD	.DSA	000000+IMPLIC	/IMPLICIT
	.DSA	635204	/INT
INTEAD	.DSA	100000+INTEGE  /INTEGER
	.DSA	646537	/LOG
LOGIAD	.DSA	100000+LOGICA  /LOGICAL
	.DSA	612445	/COM
	.DSA	300000+COMMON  /COMMON
	.DSA	670534	/RET
RETADR	.DSA	700000+RETURN  /RETURN
	.DSA	620563		/ENC
	.DSA	700000+ENCODE	/ENCODE
	.DSA	614713		/DEC
	.DSA	700000+DECODE	/DECODE
	.DSA	615555		/DOU
	.DSA	0		/DOUBLE SOMETHING
	.DSA	623752	/FOR
	.DSA	700000+FORMAT  /FORMAT
	.DSA	604513	/ASS
	.DSA	700000+ASSIGN  /ASSIGN
	.DSA	670537	/REW
	.DSA	700000+REWIND  /REWIND
	.DSA	511231	/WRI
	.DSA	700000+WRITE	/WRITE
	.DSA	462075	/PAU
PAUSAD	.DSA	700000+PAUSE	/PAUSE
	.DSA	463331		/PRI
	.DSA	700000+WRITE	/PRINT
	.DSA	420604		/ENT
	.DSA	700000+ENTRY	/ENTRY
	.DSA	211364	/CAL
	.DSA	700000+CALL	/CALL
	.DSA	214474	/DAT
DATAAD	.DSA	500000+DATA	/DATA
	.DSA	274757	/STO
STOPAD	.DSA	700000+STOP	/STOP
	.DSA	300370		/TYP
	.DSA	700000+WRITE	/TYPE
	.DSA	227054	/GOT
GOTOAD	.DSA	700000+GOTO	/GOTO
IFMNE	.DSA	034522	/IF(
IFADDR	.DSA	700000+IF	/IF
ENDMNE	.DSA	020564	/END
ILEMNE	.DSA	035045	/ILE
ENDFAD	.DSA	700000+ENDFIL  /ENDFILE
REAMNE	.DSA	070511	/REA
REALAD	.DSA	100000+REAL	/REAL
READAD	.DSA	700000+READ	/READ
DOMNE	.DSA	000257	/DO
DOADDR	.DSA	700000+DO	/DO
	.EJECT
/ SECONDARY STATEMENT IDENTIFICATION TABLES
/
CTRL90	.DSA	.+1
	.DSA	SIDTB1	/FIRST SECONDARY TABLE..CHARACTERS 04-06
	.DSA	SIDTB2	/SECOND SECONDARY TABLE.CHARACTERS 07-09
	.DSA	SIDTB3	/THIRD SECONDARY TABLE..CHARACTERS 10-12
/
/ A SECONDARY TABLE ENTRY CONTAINS IN BITS 2-17 THE CONCATENATED FORM
/ OF CHARACTERS N THRU N+2 OF THE NAME AND IN BITS 0-1 THE NUMBER OF
/ CHARACTERS TO BE EXAMINED IN THE FOLLOWING TABLE.
/
SIDTB1=.
	.DSA	635661	/IVA  EQUIVALENCE
	.DSA	670513	/REC	DOUBLE PRECISION
	.DSA	671355	/ROU  SUBROUTINE
	.DSA	620603	/ENS  DIMENSION
	.DSA	612174	/CKD  BLOCK DATA
	.DSA	643710	/KSP  BACKSPACE
	.DSA	655245	/NTE	DOUBLE INTEGER
	.DSA	421036	/ERN  EXTERNAL
	.DSA	477166	/TIN  CONTINUE
CTIMNE	.DSA	412751	/CTI  FUNCTION
	.DSA	446153	/LIC	IMPLICIT
	.DSA	220135	/EGE  INTEGER
	.DSA	234271	/ICA  LOGICAL
	.DSA	051646	/MON  COMMON
	.DSA	103036	/URN  RETURN
	.DSA	057145	/ODE	ENCODE
	.DSA	057145	/ODE	DECODE
	.DSA	007145	/BLE	DOUBLE
	.DSA	050574	/MAT  FORMAT
	.DSA	034546	/IGN  ASSIGN
	.DSA	035164	/IND  REWIND
	.DSA	001445	/TE	WRITE
	.DSA	001375	/SE	PAUSE
	.DSA	001104	/NT	PRINT
	.DSA	001351	/RY	ENTRY
C00012	.DSA	000014	/L	CALL
C00001	.DSA	000001	/A	DATA
C00016	.DSA	000020	/P	STOP
	.DSA	000005	/E	TYPE
C00015	.DSA	000017	/O	GOTO
/
SIDTB2=.
	.DSA	445726	/LEN  EQUIVALENCE
	.DSA	435501	/ISI	DOUBLE PRECISION
	.DSA	277166	/TIN  SUBROUTINE
	.DSA	035246	/ION  DIMENSION
	.DSA	004541	/ATA  BLOCK DATA
	.DSA	003275	/ACE  BACKSPACE
	.DSA	026232	/GER	DOUBLE INTEGER
	.DSA	000064	/AL	EXTERNAL
	.DSA	001515	/UE	CONTINUE
ONMNE	.DSA	001146	/ON	FUNCTION
	.DSA	000574	/IT	IMPLICIT
C00018	.DSA	000022	/R	INTEGER
	.DSA	000014	/L	LOGICAL
/
SIDTB3=.
	.DSA	000175	/CE	EQUIVALENCE
	.DSA	001146	/ON	DOUBLE PRECISION
C00005	.DSA	000005	/E	SUBROUTINE
/
	.EJECT
/ SUBROUTINE TO CONCATENATE N NON-BLANK CHARACTERS
/ CALLING SEQUENCE...
/	LAC	N		/N IS CONTAINED IN BITS 0 AND 1
/	JMS	CTRL50
/
CTRL50	SYN	ARG1
	DZM	NAME2
	RCR
CTRL52	DAC	NAME1
	DAC	CTRLSW
	SNA
	JMP	CTRL51
	LAC	LOGIF
	SZA
	DZM	CTRLSW
CTRL54	JMS	FETCHR
	JMP	CTRL53
CTRL51	LAC	NAME2		/WHEN FINISHED, THE CONCATENATED
	JMP*	CTRL50	/CHARACTERS ARE RETURNED TO THE CALLING PROGRAM
CTRL53	SAD	C00011
	JMP	CTRL54	/ONLY NON-BLANK CHARACTERS FROM THIS IMAGE
	JMS	CAT		/ARE CONCATENATED.
	LAC	NAME1
	TAD	Z00000	/  N-1 TO N (ALSO TO SWITCH WHICH ALLOWS
	JMP	CTRL52	/		IMAGE CONTINUATION)
/
/ PROCESS " AND ' AND $ DURING STATEMENT SCAN
/
CTRL55	LAC	XCHAR
	DAC	CTRL50	/SAVE OPENING QUOTE
CTRL56	JMS	FETCHR
	SKP
	JMP	CTRL19	/LINE DONE
	LAC	XCHAR
	SAD	CTRL50
	JMP	CTRL13	/CLOSE QUOTE - RETURN TO MAIN SCAN
	JMP	CTRL56	/KEEP LOOKING
	.EJECT
/ SUBROUTINE TO TEST FOR STATEMENT TERMINATION CHARACTER
/ CALLING SEQUENCE...
/	JMS	CTRL60
/	JMP	NO
/	XXX    YES
/
CTRL60	SYN	RELOPT
	LAC	XCHAR		/THE LAST CHARACTER FETCHED IS EXAMINED
	SAD	C00013	/TO DETERMINE IF IT IS A CARRIAGE RETURN
	ISZ	CTRL60	/CHARACTER (LINE TERMINATION CHARACTER).
	JMP*	CTRL60
/
/
/
/ SUBROUTINE TO DETERMINE IF STATEMENT IS ERRONEOUSLY LABELED
/
CTRL70	SYN	ARG2
	LAC	LABEL
	SNA		/NO ACTION IS TAKEN IF THE STATEMENT IS
	JMP*	CTRL70	/NOT LABELED.
	ERR	02N,16340,EN	/A RECOVERABLE ERROR IS ANNOUNCED
	LAC	V77777		/IF THE STATEMENT IS LABELED.
	DAC*	LABEL		/THE STATEMENT NUMBER IS FLAGGED AS BEING
	DZM	LABEL		/PERMANENTLY UNDEFINEABLE AND THE NO-LABEL
	JMP*	CTRL70	/FLAG IS INDICATED FOR THE STATEMENT.
/
/
/
/ SUBROUTINE TO ANNOUNCE AN ERROR WHEN A BLOCK DATA SUBPROGRAM CONTAINS
/ EXECUTABLE STATEMENTS
/
CTRL80	SYN	OPI		/NO ACTION IS TAKEN WHEN THE CURRENT
	LAC	FCNFLG	/SOURCE PROGRAM IS NOT A BLOCK DATA
	ERN	04I,<SAD K00001>,EI	/SUBPROGRAM
	JMP*	CTRL80
	.TITLE	STORAGE ALLOCATION STATEMENTS
IMPLIC	LAC	S40000	/IMPLICIT IS OF ORDER 3/2 - I.E.
	DAC	TORDER	/IT COMES AFTER A "SUBROUTINE" STATEMENT
	ISZ	IMPLFG	/BUT BEFORE ANY TYPE STATEMENT
	XCT	PASS	/LIKE THE TYPE STATEMENTS,
	JMP	CONTRL	/IT IS IGNORED ON PASS 2
IMPGRP	LAC	Y00000	/BEGINNING OF IMPLICIT GROUP: GET THE
	JMS	CTRL50	/NEXT THREE CHARACTERS
	JMP	IMCTRL	/AND DECODE THE RESULTING ATATEMENT
IMPL01	LAC	PROCAD	/STATEMENT DECODER COMES HERE WHEN ITS DONE
	SAD	REALAD
	LAC	S20000	/DETERMINE IF THE STATEMENT IS A TYPE STATEMENT
	SAD	INTEAD	/AND SET THE MODE ACCORDINGLY
	CLA
	SAD	DBPRAD
	LAC	S40000
	SAD	DBINAD
	LAC	S60000
	SAD	LOGIAD
	CLA!CML
	RAR		/THE IMPLICIT MODE TABLE CONSISTS OF THE MODE
	DAC	MODE	/SHIFTED RIGHT 1 AND THE LOGICAL FLAG IN THE SIGN
	AND	SI7777	/NOW TEST IF WE GOT SOMETHING
	ERN	08I,SZA,EI	/THE STATEMENT WASN'T A TYPE STATEMENT
	JMS	FNBCHR
	ERS	12I,<SAD S00050>,EI	/NEXT CHAR BETTER BE (
IMPCMA	JMS	GETLET	/GET A LETTER AND FORM A POINTER
	DAC	LOLET	/SET LOWER LIMIT
	DAC	HILET	/HIGHER LIMIT = LOWER LIMIT
	JMS	FNBCHR
	SAD	C00045	/IS IT A RANGE OR A SINGLE VALUE?
	JMP	IMDASH	/A RANGE
IMPCMN	LAC	HILET	/THIS IS WHERE WE SET THE TABLE -
	CMA		/COMPUTE THE NUMBER OF ENTRIES IN THE RANGE
	TAD	LOLET
	DAC	HILET
	ERN	21I,SMA,EI	/HIGHER LIMIT < LOWER LIMIT - ERROR
	LAC	MODE
LOLET	XX		/STORE THE MODE INTO THE TABLE
	ISZ	LOLET
	ISZ	HILET
	JMP	LOLET	/AS MANY TIMES AS NECESSARY
	LAC	XCHAR
	SAD	S00054	/WAS TERMINATOR A COMMA?
	JMP	IMPCMA	/YES - GET ANOTHER RANGE
	ERS	22I,<SAD S00051>,EI	/BETTER BE A )
	JMS	FNBCHR
	SAD	S00054	/IS THERE ANOTHER GROUP?
	JMP	IMPGRP	/YES
	XCT	PASS
	JMP	CRTEST	/ONLY REDEFINE VARIABLES DURING PASS 1
	LAC	SYMTB0	/NOW GO THROUGH THE SYMBOL TABLE
IMPSLP	DAC	SYMTBC	/AND RE-TYPE ALL VARIABLES
	SAD	SYMTBN	/WHICH ARE NOT ALREADY EXPLICITLY TYPED
	JMP	CRTEST
	JMS	SETADR
	LAC*	SYMTW2	/GET THE HIGH ORDER NAME WORD
	JMS	OBJ560	/EXTRACT THE FIRST CHARACTER
	TAD	K01600
	LAC	OBJB01	/OBJB01 CONTAINS FIRST RADIX 50 CHARACTER
	SAD	C00028	/PERIOD?
	JMP	IMNEXT	/YES - SYSTEM SYMBOL - DON'T TYPE IT
	TAD	LACTAB
	DAC	.+1	/INDEX INTO THE TABLE OF IMPLICIT MODES
	XX
	RCL		/DECOMPOSE THE TABLE ENTRY INTO THE MODE
	DAC	MODE	/AND THE "LOGICAL VARIABLE" FLAG
	CLA!RAR
	DAC	LOGFLG
	LAC*	SYMTW6
	RAL		/EXPLICIT TYPE BIT IN SIGN OF SYMTW6
	LAC*	SYMTBC
	AND	Z17777	/AND OUT MODE BITS
	XOR	MODE
	SNL
	DAC*	SYMTBC	/RE-STORE IF NOT EXPLICITLY DEFINED
	LAC*	SYMT2A
	XOR	LOGFLG
	SNL
	DAC*	SYMT2A	/SIMILIARLY RESTORE LOGICAL FLAG
IMNEXT	JMS	SBSE50	/GO TO NEXT ENTRY
	JMP	IMPSLP	/AND LOOP
IMDASH	JMS	GETLET	/RANGE INDICATED - GET UPPER LIMIT
	DAC	HILET
	JMS	FNBCHR	/GET TERMINATOR
	JMP	IMPCMN
/
GETLET	CAL	0	/SUBROUTINE TO GET A LETTER
	JMS	FNBCHR
	TAD	K00133
	CLL
	TAD	C00026	/TEST FOR CHARACTER IN THE RANGE 101-132 OCTAL
	ERN	20I,SNL,EI
	TAD	DACTAB	/FORM AN INSTRUCTION
	JMP*	GETLET
K00133	.DSA	777645
DACTAB	DAC	IMTBL
LACTAB	LAC	IMTBL-1
IMTBL	.BLOCK	32	/IMPLICIT TABLE - 26 WORDS LONG
HILET	0
S10000	.DSA	10000
IMPLFG	.DSA	0
SI7777	.DSA	7777
	.EJECT
/ EXTERNAL STATEMENT PROCESSOR
/
EXTERN	JMS	CTRL80	/EXTERNAL CANNOT APPEAR IN BLOCK DATA SUBR.
EXTE03	JMS	FVARGO	/THE EXTERNAL STATEMENT IS USED TO DECLARE
	LAC*	SYMTBC	/THE NAMES OF EXTERNAL FUNCTIONS WHICH
	AND	Z00000	/WILL APPEAR AS FUNCTION PARAMETERS WITHOUT
	SAD	V00000	/(BY SETTING SPECIAL BIT IN SYMTAB, DUMMY
	JMP	EXTE02	/VARIABLES CAN BE EXTERNAL)
	ERN	01E,SZA,EE	/PARAMETER LISTS SO THAT THEY MAY BE
EXTE01	LAC*	SYMTBC	/DISTINGUISHED FROM SIMPLE VARIABLES.
	AND	S60000	/GET THE SYMTAB ENTRY FOR THE FUNCTION, SAVE ITS
	XOR	U17777	/MODE, AND TYPE IT AS A FUNCTION.
	DAC*	SYMTBC	/THE LISTED NAMES CANNOT REPRESENT...
	LAC	OPVALU	/  (1) ALREADY DECLARED FUNCTION NAMES
	SAD	C00030	/  (X) DUMMY VARIABLES ARE ALLOWED
	JMP	EXTE03	/  (2) VARIABLES ASSIGNED TO A COMMON BLOCK
	LAC	SORDER	/  (3) ARRAYS
	DAC	TORDER
	JMP	CRTEST
EXTE02	LAC*	SYMTW2	/BIT 1 OF SECOND SYMTAB WORD IS 
	AND	U00000	/SET IF A DUMMY ARG USED AS A FUNCTION
	SZA		/MUST NOT ALREADY BE SET
	JMP	EE01E
	LAC*	SYMTW2	/SET THE SPECIAL BIT
	XOR	U00000
	DAC*	SYMTW2
	JMP	EXTE01
U17777	.DSA	217777		/UNDEFINED EXTERNAL
	.EJECT
/ DOUBLE INTEGER STATEMENT PROCESSOR
/
DBLINT	TAD	S20000	/MODE IS INDICATED BY 3
/
/ DOUBLE PRECESION STATEMENT PROCESSOR
/
DBLPRC	TAD	S20000	/MODE IS INDICATED BY 2
/
/ REAL STATEMENT PROCESSOR
/
REAL	TAD	S20000	/MODE IS INDICATED BY 1
/
/ INTEGER STATEMENT PROCESSOR (AND THE OTHER MODE SETTING STATEMENTS)
/
INTEGE	SKP!CLL
LOGICA	CLA!CLL!CML	/LOGICAL=INTEGER BUT SET A FLAG
	DAC	MODE		/MODE IS INDICATED BY 0
	CLA!RAR
	DAC	LOGFGX	/SAVE LOGICAL-INTEGER FLAG
	JMS	SIN530	/SAVE POSITION IN SOURCE IMAGE.
	LAC	Y00000	/THE WORDS LOGICAL, DOUBLE PRECESION,
	JMS	CTRL50	/REAL OR INTEGER MAY OR MAY NOT IDENTIFY
	XOR	Y00000
	SAD	FUNMNE	/THE STATEMENTS BY THE SAME NAMES.
	SKP		/IF THE FIRST WORD FOLLOWING ANY ONE OF
	JMP	INTG02	/THESE WORDS IS THE WORD FUNCTION, THE
	LAC	Y00000	/STATEMENT IS ASSUMED TO BE AN EXPLICITLY
	JMS	CTRL50	/MODE TYPED FUNCTION STATEMENT.
	XOR	W00000
	SAD	CTIMNE	/THE GENERAL FORM OF THE STATEMENT IS....
	SKP		/	T FUNCTION NAME(ARG1,ARG2,..,ARGN)
	JMP	INTG02	/WHERE T IS LOGICAL, DOUBLE PRECESION,
	LAC	W00000	/REAL OR INTEGER.
	JMS	CTRL50
	SAD	ONMNE
	JMP	TFUNCT	/THE MODE-TYPING STATEMENTS ARE
INTG02	JMS	SIN540	/PROCESSED BY THE DIMENSION STATEMENT.
	.EJECT
/ DIMENSION STATEMENT PROCESSOR - ALSO USED BY TYPE STATEMENTS
/ALLOWS PASS2 PROCESSING OF ARRAYS TO GET ADJUSTABLE DIMENSION
DIMENS	JMS	FVARGO	/GET A VARIABLE NAME
	LAC	MODE	/IF WE ARE IN A DIMENSION STATEMENT (MODE=-1)
	SPA		/THEN WE SHOULDN'T CHECK FOR MODE REDEFINITION.
	JMP	DIMN01
	XCT	PASS	/NOR SHOULD WE CHECK FOR MODE REDEFINITION IN
	JMP	DIMN05-3  /PASS 2
	LAC*	SYMTW6	/IF VARIABLE MODE ALREADY EXPLICITLY SET, BIT 0
	ERN	01V,SPA,EV	/OF SYMTW6 WILL BE ON - REPORT AN ERROR.
	LAC	W00000	/THE EXPLICITLY MODE-TYPED FLAG IS SET SO
	DAC*	SYMTW6	/THAT AN ERROR CAN BE ANNOUNCED IF THE
	LAC*	SYMTBC	/NAME SHOWS UP ON ANOTHER SPECIFICATION
	AND	Z17777	/STATEMENT. THE IMPLICIT MODE OF THE NAME
	XOR	MODE	/(BASED ON THE FIRST CHARACTER OF THE NAME) IS
	DAC*	SYMTBC	/OVERRIDDEN AND THE EXPLICIT MODE SUBSTITUTED.
	JMS	SETN	/RECOMPUTE THE ELEMENT LENGTH
	DAC*	SYMTW3	/AND SAVE IT
	LAC*	SYMT2A
	AND	V77777
	XOR	LOGFGX	/THE "LOGICAL FLAG" IN SYMT2A IS PART OF THE MODE
	DAC*	SYMT2A
	LAC	OPVALU
	SAD	C00028	/EITHER SIMPLE VARIABLES OR
	JMP	DIMN03	/ARRAY DECLARATIONS MAY APPEAR ON A
DIMN05	SAD	C00030	/SPECIFICATION STATEMENT. COMMAS ARE USED
	JMP	DIMENS	/TO SEPARATE THE DECLARATIONS.
CRTEST	ERN	01X,<JMS CTRL60>,EX	/CR TERMINATES, OTHERWISE ERROR
	JMP	STEXIT
DIMN01	LAC	OPVALU	/DIMENSION STATEMENTS MAY CONTAIN ONLY
	ERS	01C,<SAD C00028>,EC	/ARRAY DECLARATIONS.
DIMN03	JMS	FEDIMN	/THE ARRAY DIMENSIONS ARE OBTAINED AND
	JMP	DIMN05	/ENTERED INTO THE SYMBOL TABLE.
LOGFLG	.DSA	0
LOGFGX	.DSA	0
	.EJECT
/ COMMON STATEMENT PROCESSOR
/
COMMON	JMS	FNBCHR	/LABELED COMMON IS INDICATED BY ENCLOSING
	SAD	C00047
	JMP	COMN01	/THE LABELING NAME IN SLASHES. THE ABSENCE
	DZM	UNFNBC
COMN03	LAC	BLANKC	/OF SLASHES INDICATES BLANK COMMON.
	DAC	NAME1	/BLANK COMMON IS TREATED IN THE SAME
	DZM	NAME2
	JMS	SYMBSE	/MANNER AS LABELED COMMON AND SO THE
	JMP	COMN02	/COMPILER ASSIGNS A LABEL TO BLANK COMMON.
COMN01	JMS	FNBCHR	/TWO SLASHES WITH NO NAME BETWEEN THEM
	SAD	C00047
	JMP	COMN03	/ALSO INDICATE BLANK COMMON.
	DZM	UNFNBC
	JMS	FVARGO	/FETCH THE BLOCK NAME
	ERS	02C,<SAD C00018>,EC	/NAME MUST END WITH SLASH
COMN02	LAC	NAME1
	SNA		/IF THE DECLARED NAME OF THIS BLOCK HAS
	JMP	COMN04	/BEEN ENTERED INTO THE SYMBOL TABLE
	LAC*	SYMTBC	/PREVIOUSLY, IT MUST HAVE BEEN USED ONLY
	ERS	03C,<SAD K00001>,EC	/AS A COMMON BLOCK NAME
	LAC*	SYMTW7	/CHECK WHETHER THE BLOCK IS EMPTY
	SNA
	JMP	COMN04
	JMS	TSETAD
	LAC*	TSMTW4
	JMS	NTHSYM	/CHAIN THE CURRENT BLOCK TO
	LAC	SYMTW4	/THE EXISTING BLOCK.
	DAC	LSTVAR
	JMP	COMN09
COMN04	LAW	-1	/WHEN THE NAME IS FIRST
	DAC*	SYMTBC	/ENTERED IT IS FLAGGED AS A COMMON BLOCK
	DZM*	SYMTW7	/LABEL AND THE BLOCK SIZE IS RESET TO ZERO
	JMS	TSETAD
COMN09	JMS	FVARGO
	JMS	SYMTYP	/THE NAMES OF THE DATA WORDS (ARRAYS)
OBSPCL	XOR	C00000	/ASSIGNED TO THE COMMON BLOCK MUST
	ERX	04C,EC	/INITIALLY REPRESENT NON-COMMON VARIABLES
	LAC	OPVALU	/OR ALREADY DECLARED TO BE IN COMMON.
	SAD	C00028	/ARRAY DECLARATIONS ARE LEGAL ON COMMON
	JMS	FEDIMN	/STATEMENTS.
	LAC*	TSMTW7	/VARIABLES IN COMMON ARE ASSIGNED RELATIVE
	DAC*	SYMTW7	/POSITIONS IN COMMON IN THE ORDER OF THEIR
	SZA		/APPEARANCE. THE FIRST MEMBER OF THE BLOCK
	JMP	COMN07	/IS INDICATED BY A ZERO BLOCK. IT IS SET
	LAC	CHRCTR	/AS BOTH THE FIRST AND LAST MEMBERS OF THE
	DAC*	TSMTW4	/BLOCK
	LAC	SYMTW4
	DAC	LSTVAR
COMN07	LAC*	SYMTW3	/THE SIZE OF THIS VARIABLE (OR ARRAY) IS
	TAD*	TSMTW7	/ADDED TO THE EXISTING SIZE OF THE COMMON
	DAC*	TSMTW7	/BLOCK TO WHICH IT IS ASSIGNED
	JMS	CHAIN	/THE VARIABLE (ARRAY) IS ADDED TO THE LIST
	LAC*	SYMTBC	/OF VARIABLES ASSIGNED TO THIS COMMON
	XOR	T00000	/BLOCK.
	DAC*	SYMTBC	/THE VARIABLE (ARRAY) IS FLAGGED AS A
	LAC	OPVALU	/COMMON VARIABLE (ARRAY).
	SAD	C00045	/SEMICOLON?
	JMP	SEMI02	/YES - ITS THE COMMON-DATA KLUDGE
	SAD	C00030	/NAMES BELONGING TO THE SAME COMMON BLOCK
	JMP	COMN09	/ARE SEPARATED BY COMMAS. A NEW COMMON
	SAD	C00018	/BLOCK IS DECLARED WHEN THE LIST OF NAMES
	JMP	COMN01	/IS DELIMITED BY A SLASH. IF NEITHER OF
	JMP	CRTEST	/THESE DELIMITERS APPEAR, FINI.
	.EJECT
/ EQUIVALENCE STATEMENT PROCESSOR
/
EQUIVA	JMS	FNBCHR	/GET CHARACTER
	ERS	05C,<SAD S00050>,EC	/BETTER BE (
	DZM	FSTVAR	/THE FIRST CLASS MEMBER FLAG IS INITIALIZED
EQUI07	JMS	FVORAR	/AND A CLASS MEMBER IS OBTAINED.
	LAC	T0	/THE SUBSCRIPT VALUE OF THE VARIABLE IS THE
			/VARIABLES POSITION IN THE ARRAY (SIMPLE
	DAC	SUBVAL	/VARIABLES ARE TREATED AS 1-DIMENSIONAL
	LAC	FSTVAR	/ARRAYS) PLUS THE NUMBER OF MACHINE WORDS
	SZA		/OCCUPIED BY A SINGLE ELEMENT OF THE ARRAY.
	JMP	EQUI02	/THE EQUIVALENCE CLASS IS INITIALIZED UPON
	LAC	OPVALU	/ENCOUNTERING THE FIRST VARIABLE
	ERS	06C,<SAD C00030>,EC	/ERROR: ONLY 1 VAR IN CLASS
	DZM	OLDCLS
	DZM	COMCLS	/INITIALLY, THE CLASS IS SET UP AS A NEW
	LAC	CHRCTR	/CLASS WITH NO MEMBERS IN ANY COMMON BLOCK.
	DAC	HEDCLS	/THE CURRENT VARIABLE IS NAMED BOTH THE
	LAC	SYMTW4	/HEAD OF THE EQUIVALENCE CLASS AND THE
	DAC	LSTVAR	/LAST MEMBER ADDED TO THE CLASS. AS THE
	LAC	SUBVAL	/HEAD OF THE CLASS, IT IS ASSIGNED THE
	DAC	SUBADJ	/RELATIVE ADDRESS ZERO AND ITS SUBSCRIPT
EQUI02	LAC	SUBVAL	/VALUE IS USED AS THE ADJUSTMENT FACTOR TO
	JMS	TWOCMA	/LINE-UP THE RELATIVE ADDRESSES OF THE
	TAD	SUBADJ	/OTHER MEMBERS WITH RESPECT TO ZERO.
	DAC	RELADR
	JMS	SYMTYP
	XOR	T00000	/IS THE VARIABLE IN COMMON?
	JMP	EQUI04	/NO - ADD VARIABLE TO EQUIVALENCE CLASS
	LAC	COMCLS	/WE WILL MERGE THIS EQUIVALENCE CLASS WITH
	ERN	07C,SZA,EC	/THE VARIABLE'S COMMON (UNLESS THE
	LAC	C00001	/CLASS IS ALREADY IN COMMON, IN WHICH CASE AN
	DAC	COMCLS	/ERROR EXISTS.) A COMMON
	DAC	OLDCLS	/BLOCK IS A SPECIAL CASE EQUIVALENCE CLASS.
EQUI01	LAC	RELADR
	JMS	TWOCMA
	TAD*	SYMTW7	/WHEN THE CURRENT VARIABLE IS A MEMBER OF
	DAC	DIFF	/TWO UNIQUE CLASSES (THE CURRENT CLASS AND
	TAD	SUBADJ	/A PREVIOUS CLASS), THE TWO CLASSES ARE
	DAC	SUBADJ	/MERGED TOGETHER INTO ONE CLASS.
	LAC	FSTVAR	/WHEN THE CURRENT VARIABLE IS THE ONLY
	SZA		/MEMBER OF THE CURRENT CLASS, THE PREVIOUS
	JMP	EQUI06	/CLASS IS NAMED THE CURRENT CLASS WITH THE
	LAC*	SYMTW4	/VARIABLE NAMED BY THE CURRENT VARIABLES
	DAC	HEDCLS	/LINKAGE ADDRESS NAME THE HEAD OF THE
	DAC	OLDCLS	/CURRENT CLASS. FLAGS ARE SET TO INDICATE
	DAC	FSTVAR	/THAT A NEW CLASS HAS NOT BEEN CREATED AND
	JMP	EQUI07	/THAT THE CLASS CONTAINS MORE THAN ONE
EQUI04	LAC*	SYMTW4
	SAD	CHRCTR
	JMP	EQUI05
	LAC	COMCLS
	SNA
	JMP	EQUI01
	LAC	CHRCTR
	DAC	FSTVAR
	LAC*	SYMTW7
	JMS	TWOCMA
	TAD	RELADR
	DAC	DIFF
	SKP
EQUI16	JMS	NTHSYM
	LAC*	SYMTW7		/MERGING ANOTHER CLASS INTO A CLASS
	TAD	DIFF		/IN COMMON - ADD IN THE PROPER OFFSET
	DAC*	SYMTW7
	SMA			/CHECK THAT THE NEW OFFSET IS NOT
	JMP	.+4		/NEGATIVE, AS THIS MEANS WE HAVE
	ERR	08C,16060,EC	/UNDERFLOWED THE COMMON BLOCK
	DZM*	SYMTW7		/SET OFFSET TO ZERO AND CONTINUE
	LAC*	SYMTBC
	AND	Y77777
	XOR	T00000		/FORCE THE COMMON INDICATOR ON
	DAC*	SYMTBC		/FOR THIS VARIABLE.
	LAC*	SYMTW4
	SAD	FSTVAR
	JMP	EQUI17
	JMP	EQUI16
EQUI06	JMS	TSETAD
	LAC	HEDCLS	/THE PREVIOUS AND CURRENT CLASSES ARE
EQUI12	JMS	NTHSYM	/MERGED WHEN THE CURRENT CLASS CONTAINS
	LAC*	SYMTW7	/MORE THAN ONE MEMBER. THE PREVIOUS CLASS
	TAD	DIFF
	DAC*	SYMTW7
	LAC	COMCLS	/THESE 7 LINES CORRECT AN EQUIV BUG
	SNA
	JMP	.+5
	LAC*	SYMTBC
	AND	Y77777
	XOR	T00000
	DAC*	SYMTBC
	LAC*	SYMTW4	/CALSS ARE FLAGGED AS VARIABLES IN COMMON
	SAD	TRELAD	/ALL RELATIVE ADDRESSES HAVE BEEN ADJUSTED
	JMP	EQUI11	/WHEN THE LINKAGE ADDRESS POINTS TO THE
	SAD	HEDCLS	/HEAD OF THE CLASS.
	JMP	EQUI10	/THE CURRENT VARIABLE WILL ALREADY BE A
	JMP	EQUI12	/MEMBER OF THE CURRENT CLASS IF THE TWO
EQUI11	LAC	DIFF	/CLASSES HAVE TWO OR MORE MEMBERS IN COMMON
			/IF SO, THE RELATIVE ADDRESS OF THE CURRENT
			/VARIABLE HAS ALREADY BEEN ADJUSTED (WHEN
	ERN	09C,SZA,EC
/**057** THE USER HAS SPECIFIES A REDUNDENT EQUIVALENCE
/**057** WE CAN'T HANDLE THAT SO GIVE HIM AN ERROR
/**057** SINCE WE BREAK THE CHAIN AND THAT RESULTS IN 
/**057** MISS ALLOCATION OF CORE
	ERX	17C,EC		/**057** NEW ERROR 'REDUNDENT EQUIVALENCE'
			/THE OTHER VARIABLE COMMON TO BOTH CAUSED
			/A MERGE). THEREFORE, AN ERROR IS ANNOUNCED
EQUI10	LAC	TRELAD	/IF THE CURRENT ADDRESS DIFFERENCE IS NOT
			/ZERO (THE RELATIONSHIP BETWEEN THE TWO
	DAC	OLDCLS	/VARIABLES IN BOTH CLASSES IS NOT THE SAME)
	JMS	NTHSYM	/A FLAG IS SET TO INDICATE THE DISOLVMENT
	JMP	EQUI17	/OF THE CURRENT CLASS.
EQUI05	LAC	COMCLS
	SNA		/A VARIABLE WHICH IS NOT PRESENTLY
	JMP	EQUI18	/ASSOCIATED WITH ANY OTHER VARIABLES IN AN
	LAC	RELADR	/EQUIVALENCE CLASS OR COMMON BLOCK IS
			/SIMPLY ADDED TO THE CURRENT CLASS.
			/ERROR: RELATIVE ADDRESS OF A VARIABLE
	ERN	10C,SPA,EC	/ASSIGNED TO A COMMON BLOCK THROUGH
			/AN EQUIVALENCE RELATION UNDERFLOWS.
	LAC*	SYMTBC
	AND	Y77777
	XOR	T00000	/THE VARIABLE ASSIGNED TO A COMMON BLICK IS
	DAC*	SYMTBC	/TYPED AS A VARIABLE IN COMMON.
EQUI18	LAC	RELADR	/THE VARIABLE'S RELATIVE ADDRESS IS ADDED TO
	DAC*	SYMTW7	/ITS ENTRY IN THE SYMBOL TABLE.
EQUI17	JMS	CHAIN	/THE CURRENT EQUIVALENCE CHAIN IS BROKEN
	LAC	OPVALU	/AND THE CURRENT VARIABLE INSERTED
	SAD	C00030	/A COMMA HERE INDICATES MORE CLASS MEMBERS TO COME
	JMP	EQUI07
	ERS	11C,<SAD C00031>,EC	/OTHERWISE ONLY ) IS LEGAL
	LAC	OLDCLS
	SZA
	JMP	EQUI14	/A NEW ENTRY IS MADE INTO THE LIST OF
	LAC	EQUCLS	/UNIQUE EQUIVALENCE CLASSED IS THE CURRENT
	TAD	C00001	/CLASS WAS NOT MERGED INTO A PREVIOUS
			/CLASS OR COMMON BLOCK.
	ERN	01M,<SAD EQCLSX>,EM	/ERROR: EQV CLASS LIST FULL
	DAC	EQUCLS	/THE ADDRESS OF THE SYMBOL TABLE ENTRY OF
	LAC	HEDCLS	/THE HEAD OF THE CLASS IS ENTERED INTO THE
	DAC*	EQUCLS	/LIST OF EQUIVALENCE CLASSES.
EQUI14	JMS	FNBCHR
	SAD	S00054	/ANOTHER EQUIVALENCE CLASS IS INDICATED IF
	JMP	EQUIVA	/THE LAST CLASS IS DELIMITED BY A COMMA.
	JMP	CRTEST	/OTHERWISE PROCESSING IS FINISHED.
	.EJECT
/ SUBROUTINE TO CLEAN-UP DATA STORAGE ASSIGNMENTS
/
CLENUP	SYN	TYPEA1	/DATA STORAGE LOCATIONS ARE ASSIGNED AFTER
	XCT	PASS	/THE END STATEMENT IS ENCOUNTERED
	JMP	CLEN02	/THE ASSIGNMENTS ARE MADE DURING PASS 1
	LAC	PC	/AND THE BINARY INFORMATION IS OUTPUT
	DAC	START	/DURING PASS 2.
	DAC	EQUSTR	/THE AMOUNT OF NON-COMMON EQUIVALENCED
	LAC	EQUCLS	/MEMORY IS INITIALLY SET TO ZERO.
CLEN10	SAD	EQU0
	JMP	CLEN03	/MEMORY ALSO ASSIGNED AT THIS TIME IS USED
	LAC*	EQUCLS	/FOR ARRAY DESCRIPTION WORDS, NON-COMMON
	JMS	NTHSYM	/ARRAY STORAGE, AND TRANSFER VECTORS FOR
	LAC*	SYMTW4	/SIMPLE VARIABLES IN COMMON.
	SMA	/EACH EQUIVALENCE CLASS IS EXAMINED BEFORE
	JMS	SYMTYP	/IT IS ADDED TO THE NON-COMMON STORAGE
	XOR	C00000	/AREA. IF A CLASS HAS ALREADY BEEN ASSIGNED
	JMP	CLEN04	/TO THE STORAGE AREA (BY VIRTUE OF THE
	DZM	LOWRAD	/CLASS BEING REDUNDANTLY IN THE LIST TWICE
CLEN07	LAC*	SYMTW7	/DUE TO A DOUBLE MERGE) OR IF THE CLASS IS
	JMS	TWOCMA	/REALLY A COMMON BLOCK, IT IS BY-PASSED.
	TAD	LOWRAD
	SPA		/WHEN A CLASS HAS NOT BEEN ASSIGNED, THE
	JMP	CLEN05	/MEMBER WITH THE LOWEST RELATIVE ADDRESS
	LAC*	SYMTW7	/IS FOUND AND IS ASSIGNED THE PROGRAM
	DAC	LOWRAD	/COUNTER AS ITS TRUE ADDRESS.
CLEN05	LAC*	SYMTW4
	SAD*	EQUCLS	/RELATIVE ADDRESSES MAY BE NEGATIVE AS
	JMP	CLEN06	/THEY REFLECT THE VARIABLES RELATIVE
	JMS	NTHSYM	/POSITION IN THE CLASS WITH RESPECT TO THE
	JMP	CLEN07	/HEAD OF THE CLASS (RELATIVE ADDRESS=ZERO).
CLEN06	JMS	NTHSYM
	LAC	LOWRAD	/THE PROGRAM COUNTER IS ADJUSTED BY THE
	JMS	TWOCMA	/LOWEST RELATIVE ADDRESS OF THE CLASS.
	TAD	PC		/THIS RESULTANT VALUE IS USED TO ASSIGN
	DAC	LOWRAD	/LOCATIONS TO THE CLASS MEMBERS.
CLEN09	LAC*	SYMTW7
	TAD	LOWRAD	/THE MEMBER WITH THE LOWEST RELATIVE
	DAC*	SYMTW7	/ADDRESS WILLBE ASSIGNED THE CURRENT
	JMS	DEFNSM
	XOR*	SYMTW7
	JMS	CLEN60	/PROGRAM COUNTER. THE OTHER MEMBERS OF THE
	TAD	PC		/CLASS ARE ASSIGNED STORAGE LOCATIONS
	SMA		/THAT ARE CONSISTANT WITH THEIR RELATIVE
	JMP	CLEN08	/POSITIONS IN THE CLASS.
	DZM	PC		/THE PROGRAM COUNTER IS UPDATED IF ITS
	JMS	INCRPC	/COURRENT VALUE IS LESS THAN WHAT IT WOULD
	TAD	TEMP0		/BE IF IT WAS UPDATED BY THE AMOUNT OF
CLEN08	LAC*	SYMTW4	/STORAGE OCCUPIED BY THIS MEMBER
	XOR	W00000	/THE CURRENT MEMBER IS FLAGGED AS BEING
	DAC*	SYMTW4	/ASSIGNED
	AND	V77777
	SAD*	EQUCLS	/ALL MEMBERS OF THIS CLASS HAVE BEEN
	JMP	CLEN04	/ASSIGNED WHEN THE CURRENT MEMBERS LINKAGE
	JMS	NTHSYM	/ADDRESS POINTS TO THE HEAD OF THE CLASS
	JMP	CLEN09	/(THE FIRST MEMBER ASSIGNED).
CLEN04	LAC	EQUCLS	/THE EQUIVALENCE CLASS LIST ADDRESS IS
	TAD	K00001	/UPDATED AND THE NEXT ENTRY IS EXAMINED
	DAC	EQUCLS	/TO DETERMINE IF ALL THE CLASSES HAVE BEEN
	JMP	CLEN10	/ASSIGNED MEMORY LOCATIONS.
CLEN03	LAC	EQUSTR
	JMS	TWOCMA	/THE AMOUNT OF NON-COMMON DATA STORAGE
	TAD	PC		/REQUIRED BY THE EQUIVALENCE CLASSES IS
	DAC	EQUSTR	/DETERMINED BY SUBTRACTING THE STARTING
	LAC	START
	DAC	PC
CLEN02	DZM	LOWRAD	/THE AMOUNT OF STORAGE REQUIRED FOR THE
	LAC	PFILE1
	DAC	SYMTW2
	TAD	C00001
	DAC	SYMT2A	/SET UP FAKE NAME POINTERS
	JMS	OSYMBL	/OUTPUT THE FILE NAME
	LAC	W00000
	JMS	BINOUT
	XOR	C00019
	LAC	EQUSTR	/MEMBERS OF THE NON-COMMON EQUIVALENCE
	SZA		/IGNORE ZERO BLOCK
	JMS	BINOUT	/CLASSES IS OUTPUT AS ONE BLOCK OF
	XOR	C00006	/UNINITIALIZED MEMORY.
	LAC	SYMTB0
CLENLP	DAC	SYMTBC
	SAD	SYMTBN		/DONE?
	JMP*	CLENUP	/YUP - EXIT
	JMS	SETADR
	LAC	K00001
	SAD*	SYMTBC		/COMMON BLOCK?
	JMP	CMNBLK		/YES - GO OUTPUT IT AND ITS MEMBERS
	SAD	FCNFLG		/ARE WE IN A BLOCK DATA SUBPROGRAM?
	JMP	CMNCHK		/YES - GO CHECK FOR NON-COMMON VARIABLES
	LAC*	SYMTBC
	AND	Z00000		/EXTRACT TYPE BITS OF SYMBOL TABLE ENTRY
	SAD	W00000		/NON-COMMON ARRAY?
	JMP	CARRAY		/YES - OUTPUT STORAGE AND DESCRIPTOR BLOCK
	SAD	Z00000		/DUMMY ARRAY? IF YES, OUTPUT DES. BLOCK
	JMP	CADB		/(YES) AND DEFINING SYMTAB ENTRY FOR
				/IT SUCH THAT ADDRESSING IS TO THE ADB
	SAD	U00000		/EXTERNAL FUNCTION?
	JMP	CFUNCT		/YES - OUTPUT TRANSFER VECTOR
	SNA			/NON-COMMON SCALAR?
	JMP	CSCLAR		/YES - RESERVE STORAGE FOR IT
CLENNX	JMS	SBSE50		/GO TO NEXT SYMTAB ENTRY
	JMP	CLENLP		/AND LOOP
/
CARRAY	LAC*	SYMTW4		/CHECK THE SIGN BIT OF SYMTW4 - IT IS ONLY
	SPA			/SET ON BY THE EQUIVALENCE RESOLVER.
	JMP	CADB		/STORAGE ALREADY EXISTS IN EQV. AREA
	LAC	PC		/NO STORAGE EXISTS - SAVE PC FOR USE
	DAC*	SYMTW7		/IN ARRAY DESCRIPTOR BLOCK
	LAC*	SYMTW3	/GET LENGTH, CHECK THAT IT IS LESS THAN 8K
	TAD	K08192	/THIS CHECK USED TO BE DONE WHEN DIMENSIONED -
	ERN 03M,SMA,EM  /BUT NOW HAVE TO ALLOW COMMON ARRAYS >8K
	LAC*	SYMTW3		/GET LENGTH
	JMS	BINOUT		/OUTPUT A "BLOCK" COMMAND
	XOR	C00006
CADB	JMS	CLEN50		/OUTPUT FIRST 3 WORDS OF ARRAY DESC. BLOCK
	JMS	VECTOR		/OUTPUT POINTER AND DEFINE ARRAY HERE
	JMP	CLENNX		/BACK TO THE SALT MINES
CFUNCT	AND*	SYMTW2		/AC CONTAINED U00000, REMEMBER?
	SZA			/BIT 1 OF THE LOW-ORDER NAME WORD IS THE
	JMP	CLENNX		/"DUMMY EXTERNAL" FLAG - IGNORE ENTRY IF ON
	JMS	DEFNSM
	XOR	PC		/DEFINE SYMBOL HERE
	JMS	VECBIN		/OUTPUT A ZERO WORD
	JMS	OSYMBL		/PUT OUT SYMBOL NAME
	LAC*	SYMTBC
	AND	S17777
	JMS	BINOUT		/AND GLOBAL DEFINITION CODE
	XOR	C00009
	JMP	CLENNX
/
CSCLAR	LAC*	SYMTW2		/IF THIS ENTRY HAS MORE THAN 3 WORDS,
	CMA
	AND*	SYMTW4		/CHECK WHETHER IT EXISTS IN EQUIVALENCED
	SPA			/STORAGE
	JMP	CLENNX		/GUESS IT DOES - IGNORE IT
	LAC*	SYMTBC
	AND	S17777	/IF A SYMBOL WAS DEFINED IN THE DECLARATION
	SAD	S17777	/STATEMENTS, BUT NEVER REFERENCED IN AN EXECUTEABLE
	JMP	CLENNX	/STATEMENT, DON'T DEFINE IT NOW (OR EVER)
	JMS	DEFNSM
	XOR	PC		/DEFINE THE SYMBOL AS RIGHT HERE
	LAC*	SYMTBC
	JMS	SETN		/FIND THE NUMBER OF WORDS NECESSARY
	JMS	BINOUT
	XOR	C00006		/AND PUT THEM OUT
	JMP	CLENNX
/
CMNCHK	JMS	SYMTYP		/ONLY VARIABLES IN COMMON ARE ALLOWED
	XOR	C00000		/IN A BLOCK DATA SUBPROGRAM
	JMP	CLENNX
	ERR	12C,16060,EC	/NAUGHTY,NAUGHTY
	JMP	CLENNX		/THE SHOW MUST GO ON
/
CMNBLK	JMS	TSETAD		/SAVE AWAY THE IMPORTANT POINTERS
	JMS	OSYMBL		/OUTPUT THE NAME OF THE BLOCK
	LAC*	TSMTW7		/IF THE LENGTH IS ALREADY ZERO,
	SNA			/IGNORE THIS BLOCK AS AN ERROR
	JMP	CLENNX		/WAS DETECTED PROCESSING IT
	DZM*	TSMTW7		/INITIALIZE THE LENGTH
	LAC*	TSMTW4		/GET THE FIRST CHAIN POINTER
BLKLLP	JMS	NTHSYM		/GET THE CHAINED SYMBOL
	JMS	CLEN60		/COMPUTE THE ADDRESS OF THE LAST ELEMENT
	TAD*	TSMTW7		/(COMPLEMENTED) AND COMPARE IT WITH THE
	SMA			/EXISTING LENGTH
	JMP	.+3		/IT FITS WITHIN THE EXISTING LENGTH
	LAC	TEMP0		/IT DOESN'T FIT - CHANGE THE LENGTH
	DAC*	TSMTW7
	LAC*	SYMTW4		/GET THE NEXT CHAIN
	SAD*	TSMTW4		/HAVE WE COME FULL CIRCLE?
	SKP			/YUH
	JMP	BLKLLP		/NAW - KEEP LOOPIN
	LAC*	TSMTW7		/GET THE BLOCK LENGTH
	JMS	BINOUT
	XOR	C00012		/OUTPUT IT AS A COMMON BLOCK DEFINITION
	LAC*	TSMTW4
CMNVLP	JMS	NTHSYM		/NOW GO THROUGH THE ELEMENTS AGAIN
	LAC	FCNFLG
	SAD	K00001		/IF WE ARE IN A BLOCK DATA ROUTINE,
	JMP	BLDCMN		/ALL WE ARE INTERESTED IN IS THE DEFINITION
	LAC*	SYMTBC
	SPA			/IS THE ELEMENT AN ARRAY?
	JMS	CLEN50		/YES - OUTPUT THE FIRST 3 WORDS OF THE ADB
	JMS	VECTOR		/OUTPUT AN OFFSET POINTER INTO THE COMMON
	LAC*	SYMTW7		/BLOCK AND DEFINE THE SYMBOL HERE. THEN
	JMS	BINOUT		/OUTPUT SOME STRANGE LOADER CODES WHICH
	XOR	C00013		/I TAKE ON FAITH
	LAC*	SYMTBC
	AND	S17777
	JMS	BINOUT		/(ANOTHER, EQUALLY STRANGE LOADER CODE)
	XOR	C00014
	SKP
BLDCMN	JMS	DEFNSM		/IN BLOCK DATA SUBRS, ALL WE CARE ABOUT
	XOR*	SYMTW7		/IS THAT THE DATA STATEMENTS WORK PROPERLY
	LAC*	SYMTW4
	SAD*	TSMTW4		/CHECK FOR CIRCUMNAVIGATION
	SKP			/YUP - ALL DONE
	JMP	CMNVLP		/NOPE - KEEP SAILING
	LAC*	TSMTW7	/A CUMULATIVE SUM OF ALL COMMON BLOCK
	TAD	LOWRAD	/SIZES IS OBTAINED FOR USE AS THE PROGRAM
	DAC	LOWRAD	/SIZE OF A BLOCK DATA SUBPROGRAM.
	LAC	TSMTBC
	DAC	SYMTBC
	JMS	SETADR		/SET UP POINTERS
	JMP	CLENNX		/SO WE CAN ADVANCE TO THE NEXT SYMBOL
	.EJECT
/SUBROUTINE TO OUTPUT 5 WORD ARRAY DESCRIPTOR BLOCK (LESS TRANSFER VEC.)
CLEN50	SYN	POP	/THE ADB IS OUTPUT FOR ALL ARRAYS, ALTHOUGH
	LAC*	SYMTBC	/SYMTAB ENTRIES FOR A DUMMY ARRAY MAY NOT BE 
	AND	S60000	/COMPLETE.  WORD 1 CONTAINS THE MODE, RIGHT
	LRSS	34	/ADJUSTED, AND THE NUMBER OF DIMENSIONS-1 IN
	JMS	SUBCT2	/BITS 0,1,2.  SUBCT2 COUNTS THE DIMENSIONS, THEN
	TAD	K00001	/SUBTRACT 1.  THE WORD IS OUTPUT AS AN ABSOLUTE
	LLS	17
	JMS	FPPOUT	/INSTRUCTION.  WORD 2 IS THEN USED FOR SIZE,
	LAC*	SYMTW3	/ALLOWING EASILY ENOUGH BITS FOR A 128K ARRAY,
	JMS	FPPOUT	/IT PRESENTLY BEING THE LOADERS DECISION AS TO
	LAC*	SYMTW5	/HOW BIG AN ARRAY CAN BE (EITHER AS PART OF THE
	JMS	FPPOUT	/PROGRAM SIZE OR A COMMON BLOCK).  WORD 3 
	LAC*	SYMTW6	/= N*IMAX, WORD 4 = N*IMAX*JMAX, WHERE N IS
	JMS	FPPOUT	/THE NO. WORDS PER ELEMENT FOR THIS MODE
	JMP*	CLEN50
/
/ SUBROUTINE TO OUTPUT A TRANSFER VECTOR
/
VECTOR	SYN	ADDRA1
	JMS	DEFNSM		/DEFINE THE SYMBOL
	XOR	PC		/AS THE CURRENT VALUE OF THE PC
	LAC*	SYMTW7		/TRANSFER VECTORS ARE SHEER ADDRESS
	JMS	VECBIN	/THE TRANSFER VECTOR IS INITIALLY SET TO
	JMP*	VECTOR	/REFERENCE THE ARRAY(VAR) ADDRESS.
/
/
/
/ SUBROUTINE TO DEFINE A SYMBOL
/ CALLING SEQUENCE...
/	JMS	DEFNSM
/	XOR	DEFINITION
/
DEFNSM	SYN	ADDRA2
	LAC*	SYMTBC	/THE DEFINITION OF THE SYMBOL IS MERGED
	AND	Z60000	/INTO THE FIRST WORD OF THE SYMBOL TABLE
	XCT*	DEFNSM	/ENTRY.
	DAC*	SYMTBC
	CLA
	JMP*	DEFNSM
	.EJECT
/ SUBROUTINE TO OBTAIN THE NEGATIVE ADDRESS OF THE FIRST WORD FOLLOWING
/ THE WORDS OCCUPIED BY THIS VARIABLE
/
CLEN60	SYN	MODEA1
	LAC*	SYMTW3	/THE NUMBER OF WORDS OCCUPIED BY THIS
	TAD*	SYMTW7	/ASSIGNED TO THIS VARIABLE.
	DAC	TEMP0	/THE POSITIVE ADDRESS IS SAVED AND ITS
	JMS	TWOCMA	/NEGATIVE RETURNED TO THE CALLING PROGRAM.
	JMP*	CLEN60
/
/
/
/ SUBROUTINE TO INCREMENT PROGRAM COUNTER BY N
/ CALLING SEQUENCE...
/	JMS	INCRPC
/	TAD	N
/
INCRPC	CAL	0
	LAC	PC
	XCT*	INCRPC	/THE PROGRAM COUNTER IS INCREMENTED BY THE
	DAC	PC	/SPECIFIED AMOUNT AND COMPARED WITH 8191.
	TAD	K04081
	SPA
	JMP	.+3
	LAC	PASS1		/PROGRAM EXCEEDS 4K
	DAC	F4K
	LAC	PC
	TAD	K08177
	SPA		/THE COMPILER.. 8191 IS USED AS A FLAG.)
	JMP*	INCRPC
	DZM	PC
	ERR	02M,16320,EM	/ERROR: PROGRAM SIZE EXCEEDS A CORE BANK
	JMP*	INCRPC
	.EJECT
/ SUBROUTINE TO FETCH VARIABLE ARGUMENT-OPERATOR/DELIMITER PAIR
/
FVARGO	SYN	NUMFLG
	JMS	INFAOP
	JMS	FARGOP	/THE NEXT ARGUMENT-OPERATOR PAIR IS
	JMS	VARTST	/OBTAINED. THE ARGUMENT TYPE IS EXAMINED
	LAC	OPVALU	/TO MAKE SURE IT IS A VARIABLE.
	JMP*	FVARGO
/
/
/
/SUBROUTINE TO SET ADDRESS OF NTH SYMBOL
/CALLING SEQUENCE
/	LAC	N
/	JMS	NTHSYM
/
NTHSYM	SYN	SIGNA1
	JMS	TWOCMA
	DAC	TCTR
	LAC	SYMTB0
NTHSM1	DAC	SYMTBC
	JMS	SETADR
	ISZ	TCTR
	SKP
	JMP*	NTHSYM
	JMS	SBSE50
	JMP	NTHSM1
	.EJECT
/
/GET DIMENSION DECLARATION SUBSCRIPTS.  ALLOWS INTEGER VARIABLE DIMENS
/IF DUMMY ARRAY.  IN PASS2, GENERATES CALLS TO ARRAY ADJUSTMENT SUBS.
/3D ARRAYS ONLY.
FARDIM	SYN	SIGNA2
	DZM	T2	/INITIALIZE LATTER 2 DIMENSIONS.
	DZM	T3	/ADJFLG IS INITIALIZED TO ZERO, AND IS
	DZM	ADJFLG	/INCREMENTED IF VALID VARIABLE DIMENSION IS
	LAC	SYMTBC	/FOUND.  SAVE PTR TO PRESENT SYMTAB ENTRY, 
	DAC	VARTST	/MAY GET CHANGED.  BUT IS THIS ISN'T A DUMMY
	LAC*	VARTST
	AND	V00000	/ARRAY, A 0 IS SAVED INSTEAD.  IT IS USED TO
	SAD	V00000	/CHECK VALIDITY OF OCCURENCE OF VARIABLE DIMEN
	SKP		/IF SYMTBC IS LOST FOR NON-DUMMY ARRAY (BY FIARGO)
	DZM	VARTST	/IT WAS AN ERROR ANYWAY.
	DZM	SSCTR	/INITIALIZE COUNT OF SUBSCRIPTS.
	LAC	AT1	/GET ADDRESS OF DIMENSION HOLDING WORDS.
FARD05	DAC	TI	/TI GETS BUMPED TO SUCCESSIVELY STORE DIMENS.
	JMS	FIARGO	/GETS ARG, FLAGS ERROR IF NOT INTEGER CONSTANT
	LAC	ARG	/OR VARIABLE.  A CONSTANT IS ACCEPTED IN ALL
	AND	Z00000	/CASES (THIS TEST MODELED AFTER ROUTINE CONTST)
	SAD	U00000	/OTHERWISE THE ARG MUST BE A DUMMY VARIABLE,
	JMP	FARD01	/AND WE MUST BE PROCESSING A DUMMY ARRAY.
	LAC	VARTST	/ERROR "VARIABLE DIMENSION IN NON-DUMMY ARRAY"
	ERS	12S,<SZA>,ES
	LAC*	SYMTBC	/OCCURENCE OF VARIABLE HAS RESET SYMTAB PTR
	AND	Z00000	/TO THAT VAR'S ENTRY; MUST BE TYPE DUMMMY
	ERS	13S,<SAD V00000>,ES	/"VAR DIMEN NOT DUMMY INTEGER"
	LAC	SYMTBC	/WHEN GOOD VAR. DIMEN IS FOUND, ITS POINTER IS
	XOR	X00000	/IS FLAGGED AND SAVED IN PLACE OF ACTUAL VALUE.
	ISZ	ADJFLG	/ALSO PUT BIT 2 ON, TO INDICATE SYMBOLIC TYPE.
	SKP
FARD01	JMS	CONTST	/TRUE INTEGER CONST. SUBSCRIPT ARRIVES HERE ALSO
	DAC*	TI
	ISZ	SSCTR	/ACCOUNT FOR ONE MORE SUBSCRIPT.  DIMENSIONS
	LAC	OPVALU	/ARE SEPARATED BY COMMAS.  THE DIMENSION LIST 
	SAD	C00030	/IS TERMINATED BY A RIGHT PAREN.  ERROR NOTED
	JMP	FARD02
	ERS	01S,<SAD C00032>,ES	/IF OTHERWISE.
	JMS	FARGOP	/THE PSEUDO-ARGUMENT SUBSCRIPTED VARIABLE AND
	LAC	VARTST	/ITS DELIMITER ARE OBTAINED BEFORE RETURN,
	SNA		/AND PASS SPECIFIC CLEANUP MUST BE DONE.
	JMP*	FARDIM	/NO CLEANUP DONE IF NOT DUMMY ARRAY.
	LAC	ADJFLG	/ADJFLG IS > 0 IF VARIABLE DIMEN WAS FOUND
/CLEAN UP FOR ADJUSTABLE ARRAY ONLY.
	SNA!CLA		/1. ENTER WITH CONTST IN AC.  IF ZERO, NO VAR-
	JMP*	FARDIM	/IABLE DIMENSIONS
	LAC	DJMNE
	JMS	EXP580	/JMS* TO .DJ.
	XOR	JMSCMD	/(PASS1 - ONLY DEFINE  .DJ)
	LAC	VARTST	/RESTORE SYMBOL TABLE POINTER
	DAC	SYMTBC	/MAKES SURE OUTPUT ROUTINES WORK
	LAC*	SYMTBC	/2. NOW OUTPUT DIRECT ADDRESS TO ADB WORD 5, 
	AND	S17777	/ADDRESS OF WHOSE SYMBOL TABLE ENTRY WAS 
	JMS	VECBIN	/SAVED IN VARTST (INCR. PC IF PASS 1)
/OCCURENCE OF AT LEAST 1 ADJ. DIMEN. REQUIRES PARAMETERS FOR EACH
	LAC	AT1	/DIMEN. BE OUTPUT, EITHER AS A CONSTANT OR A
FARD09	DAC	CHAIN	/POINTER TO A DUMMY ARGUMENT.
	LAC*	CHAIN	/ CONSTANTS ARE POSITIVE,
	SNA		/AND ARE OUTPUT AS ABSOLUTE BINARY DATA.  IF THEY
	JMP	FARD07	/COME UP ZERO, IT MEANS THAT THIS IS THE END OF
	SPA		/THE PARAMETER LIST, MAX = NO. OF DIMENSIONS
	JMP	.+3	/POINTERS ARE FLAGGED (BIT0=1)
	JMS	FPPOUT	/(ONLY INCREMENTS PC IF PASS1).
	JMP	.+3
	AND	V77777	/ THE FLAG IS REMOVED, AND A VECTOR IS OUTPUT,
	JMS	EXP720	/USING SYMTAB ENTRY ADDRESS PASSED IN AC
	LAC	CHAIN	/INCREMENT FOR T2 AND T3.
	TAD	C00001
	SAD	ATX	/ATX HAS ADDRESS = T3+1
	SKP
	JMP	FARD09
FARD07	LAC	T1	/REMOVE POINTER ENTRIES 
	SPA
	DZM	T1
	LAC	T2
	SPA
	DZM	T2
	LAC	T3
	SPA
	DZM	T3
	LAC	VARTST	/RESET POINTER TO SYMTAB ENTRY TO THAT OF
	DAC	SYMTBC	/THE DUMMY ARRAY.
	JMS	SETADR	/DEFINE THE REST OF THE POINTERS TO THIS ENTRY.
	JMP*	FARDIM
DJMNE	.DSA	127652	/.DJ, RADIX 50
ADJFLG	.DSA	0	/0 IF NO ADJ. DIMENS., >0 OTHERWISE
FARD02	LAC	TI	/CHECK FOR EXCEEDING THREE DIMENSIONS.  ATX HOLDS
	TAD	C00001	/THE ADDRESS OF THE LOCATION FOLLOWING T3.
	ERN 02S,<SAD ATX>,ES	/("MORE THAN THREE DIMENSIONS DECLARED")
	JMP	FARD05
	.EJECT
/FETCH AND ENTER ARRAY DIMENSIONS INTO SYMBOL TABLE.  FOR 3 DIMENS, 
/5 WORD ADB, CALL BY REFERENCE, >8K COMMON ARRAY, EAE MULT ROUTINE.
/NO CHECKING OF ARRAY LENGTH MADE CAUSE DONT'T NECESSARILY YET KNOW IF
/IT WILL BE IN A COMMON BLOCK.
FEDIMN	SYN	LEVPOP
	LAC*	SYMTW3	/ GET NUMBER OF WORDS PER ELEMENT, USE TO CAL-
	DAC	T0	/CULATE TOTAL ARRAY SIZE.
	JMS	FARDIM	/GO GET DIMENS AND FILL IN BLOCK T1,T2,&T3 WITH
	XCT	PASS	/ IF PASS 2, A QUICK EXIT IS TAKEN (ALL FARDIM
	JMP	FPASS2	/DID WAS GENERATE .DJ OR .DK CALL IF DMY ARY)
	LAW	-1	/COMPUTE THE APPROPRIATE SYMTAB ENTRIES THAT
	TAD	AT1	/DESCRIBE THE SIZE OF THIS ARRAY, GOING THROUGH
	DAC	CONTST	/T1,T2,T3 LIST SET UP BY FARDIM. PROPER ACCOUNT
	DAC	VARTST	/MUST BE TAKEN OF THOSE ENTRIES WHICH ARE
FEDNEX	LAC*	VARTST	/ZERO DUE TO DUMMY VARIABLE VS. THOSE ZERO'ED
	ISZ	CONTST	/DUE TO BEING BEYOND NO. OF DIMENS DECLARED.
	JMS	MULT	/CUMULATIVE PRODUCT UP TO N*IMAX*JMAX*KMAX
	LAC*	CONTST	/IS COMPUTED, EACH INTERMEDIATE RESULT BEING
	SNA!CLL		/SAVED.  ANY ZERO PRODUCT SIGNALS DUMMY DIMEN-
	CLA!CMA!CML	/SION, SINCE CALCULATION IS BEING DONE ONLY FOR
	DAC*	CONTST	/AS MANY DIMENSIONS THAT EXIST.  WHEN 0 COMES
	LAC	CONTST	/UP, 777777 IS STORED - SUCH THAT LATER CHECKING
	SNL		/FOR NO. OF DIMENSIONS WILL WORK.  THE POINTER
	DAC	VARTST	/TO PREVIOUS INTERMEDIATE RESULT IS BUMPED
	SAD	TI	/ONLY IF NON-ZERO RESULT. E.G., FOR 'A' REAL,
	SKP		/A(N,M,5) YIELDS T1=T2=777777, T3=10; OR 
	JMP	FEDNEX	/A(N,5,2) YIELDS T1=777777, T2=10, T3=20.
	LAC*	SYMTBC	/ERROR: REDEFINING ARRAY
	ERN	04V,<SPA>,EV
	XOR	W00000	/(400000) THE SYMBOL IS FLAGGED AS AN ARRAY
	DAC*	SYMTBC
	LAC*	TI	/TI WAS LEFT BY FARDIM TO ADDRESS THE LAST
	DAC*	SYMTW3	/DIMENSION OF THE ARRAY, WHICH NOW HOLDS THE
	DZM*	TI	/TOTAL SIZE.  THE REST OF THE SYMBOL
	LAC	T1	/TABLE ENTRIES FOR THIS ARRAY ARE DEFINED.
	DAC*	SYMTW5	/THE FACT THAT THE TRUE SIZE OF A DUMMY ARRAY MAY
	LAC	T2	/NOT YET BE KNOWN IS OF NO CONCERN, SINCE NO
	DAC*	SYMTW6	/SPACE IS TO BE ALLOCATED LOCALLY FOR 
FPASS2	LAC	OPVALU	/SUCH AN ARRAY.  THE TERMINAL DELIMITER IS 
	JMP*	FEDIMN	/RETURNED IN THE AC.
	.EJECT
/ SUBROUTINE TO ANNOUNCE AN ERROR IF THE ARGUMENT IS NOT A VARIABLE
/
VARTST	SYN	HFLG
	LAC	ARG	/THE ARGUMENT TYPE IS ISOLATED AND
	AND	Z00000	/EXAMINED TO DETERMINE IF IT IS A VARIABLE.
	ERS	02V,<SAD T00000>,EV
	JMP*	VARTST
/
/
/
/ SUBROUTINE TO ANNOUNCE AN ERROR IF AN INTEGER ARGUMENT IS NOT A
/ NON-ZERO POSITIVE CONSTANT.
/
CONTST	SYN	FMTCNT
	LAC	S
	SMA!SZA!CLA
	LAC	ARG
	AND	Z00000		/TEST MODE AND VALUE
	ERS	03V,<SAD U00000>,EV  /ERROR: NOT INTEGER CONST>0
	LAC	S
	JMP*	CONTST
/
/
/
/ SUBROUTINE TO CHAIN CLASS MEMBERS (EQUIVALENCE OR COMMON BLOCK)
/
CHAIN	SYN	IDXPOP
	LAC*	LSTVAR	/ALL MEMBERS OF THE SAME CLASS ARE CHAINED
	DAC	FSTVAR	/TOGETHER IN A CIRCULAR FASHION. I.E. EACH
	LAC*	SYMTW4	/MEMBER POINTS TO ANOTHER MEMBER IN TH
	DAC*	LSTVAR	/CLASS AND NO TWO MEMBERS POINT TO THE SAME
	LAC	FSTVAR	/OTHER MEMBER. A ONE MEMBER CLASS POINTS
	DAC*	SYMTW4	/TO ITSELF. A NEW MEMBER IS ADDED BY
	LAC	SYMTW4	/BREADING THE CHAIN AT THE LAST MAMBER
	DAC	LSTVAR	/AND INSERTING THE NEW MEMBER BY EXCHANGING
	JMP*	CHAIN	/POINTERS. (NEW NAMES POINT TO SELF.)
	.EJECT
/ SUBROUTINE TO FETCH VARIABLE OR ARRAY WITH CONSTANT SUBSCRIPTS
/
FVORAR	SYN	MODEA2	/THIS SUBROUTINE IS USED BY THE DATA AND
	JMS	FVARGO	/EQUIVALENCE STATEMENT PROCESSORS. LEGAL
	LAC*	SYMTBC		/NAMES ARE SIMPLE VARIABLES OR ARRAY
	AND	U00000		/ELEMENTS WITH CONSTANT SUBSCRIPTS
	ERN	05V,SZA,EV	/ERROR: DUMMY VAR OR FUNCTION
	DZM	SSCTR	/USED IN DATA STMT
	DZM	T0
	LAC*	SYMTBC	/THE NUMBER OF WORDS PER ITEM
	JMS	SETN	/IS OBTAINED FOR USES BOTH INTERNAL AND
	DAC	MODE	/EXTERNAL TO THIS ROUTINE.
	LAC	OPVALU	/THE APPEARANCE OF A SUBSCRIPTED VARIABLE
			/NEED NOT INDICATE AN ARRAY ELEMENT. IF
			/THE VARIABLE HAS NOT BEEN DECLARED AS AN
	SAD	C00028	/ARRAY IT IS TREATED AS A ONE-ONLY
	JMP	FVAR03	/DIMENSION ARRAY.
	JMP*	FVORAR	/EXIT IS QUICK IF THE VARIABLE IS NOT
FVAR03	JMS	FARDIM	/SUBSCRIPTED AT ALL.
	LAC	SYMTBC
	XOR	T00000
	DAC	ARG
	LAC	T1	/THE CONSTANTSUBSCRIPTS ARE OBTAINED AND
	TAD	K00001	/THE ELEMENTS RELATIVE POSITION IN THE
	JMS	MULT	/ARRAY (PSEUDO-ARRAY) IS CALCULATED AS IF
	LAC	MODE	/THE ARRAY WAS ONE-DIMENSIONAL.
	DAC	T0
	LAC	SSCTR	/A NON-ARRAY VARIABLE MAY BE SINGLY
	SAD	C00001	/SUBSCRIPTED APPEARING ON AN EQUIVALENCE
	JMP	FVAR05	/STATEMENT. (A SIMILARILY WRITTEN VARIABLE
	LAC*	SYMTBC	/ON A DATA STATEMENT WOULD BE INTERPRETED
			/AS A FUNCTION AND AN ERROR WOULD OCCUR).
			/ERROR: MORE THAN 1 DIMENSION INDICATED FOR
	ERN	07V,SMA,EV	/A NON-ARRAY VARIABLE.
	LAC	T2
	TAD	K00001	/THE ELEMENT POSITION IS CALCULATED FOR
	JMS	MULT	/MULTI-DIMENSION ARRAY ELEMENTS AS...
	LAC*	SYMTW5
	TAD	T0	/	FOR  A(I,J,K) DECLARED, AND
	DAC	T0	/	A(M,N,O) STATED
	LAC	T3
	SZA
	TAD	K00001	/	(M-1) + (N-1)*I + (O-1)*I*J
	JMS	MULT
	LAC*	SYMTW6	/EACH TERM OF THE POSITION FORMULAE IS
	TAD	T0	/MULTIPLIED BY THE NUMBER OF WORDS PER
	DAC	T0	/ELEMENT (TO ACCOUNT FOR DIFFERENT DATA
	JMS	SUBCNT	/MODES). A POSITION OF ZERO IS THE FIRST
FVAR05	LAC*	SYMTBC	/ELEMENT. MUST HAVE CORRECT NUMBER OF SUBSCRIPTS,
	AND	Z00000	/(UNLESS # DCL SS = 1), AND THE ELEMENT
	XOR	X00000	/POSITION CANNOT EXCEED 8191 IF A LOCAL ARRAY,
	SNA!CLA		/OR 32767 IF A COMMON ARRAY.
	LAC	K24576	/ -24 K
	TAD	K08192	/ -8 K
	TAD	T0
	ERN  04M,SMA,EM
	JMP*	FVORAR
	.TITLE	STATEMENT PROCESSORS FOR EXECUTABLE STATEMENTS
/ READ AND WRITE STATEMENT PROCESSORS
/	READ ENTRY = READ	WRITE ENTRY = WRITE
WRITE	LAC	C00002	/WRITE ENTRY -- TWO TO RWFLAG
READ	DAC	RWFLAG	/RWFLG= READ/WRITE INDICATOR
	DZM	ENCFLG		/ZERO ENCODE/DECODE FLAG
	JMS	FNBCHR
	ERS	08V,<SAD S00050>,EV	/FIRST CHARACTER MUST BE (
	JMS	IODEV	/FETCH AND RECORD DEVICE NUMBER
	LAC	ARG		/STORE AWAY TEMPORARILY
	DAC	ARTEM
	DZM	RWEOFS		/INITIALIZE OFFSET AND FLAGS
	DZM	RWERRS
	DZM	SYMTMP
	DZM	RWBIN
	LAC	XCHAR	/GET CHARACTER WHICH TERMINATED DEVICE NUMBER
	DZM	RWRAN
	SAD	C00035		/#?
	JMP	RWRA		/YES; RANDOM ACCESS I/O
	SAD	C00039	/'?
	JMP	RWRA	/YES - RANDOM ACCESS
	JMP	RWNRAN	/NOT RANDOM ACCESS - CHECK FOR COMMA OR RPAR
RWRA	LAC	C00024		/READ IN EXPRESSION FOR FIRST RECORD #
	DAC	IFFLAG
	LAC	PASS1		/ACCEPT , AS 0 LEVEL DELIMITER
	DAC	EX23X+1
	JMS	EXPRSN
	LAC	SNACMD		/PUT THINGS BACK TO NORMAL
	DAC	EX23X+1
	LAC	MODEA2		/MUST BE INTEGER EXPRESSION
	ERN	32V,SZA,EV
	LAC	C00010		/(OFFSET FOR RANDOM ACESS
	DAC	RWRAN
	LAC	XCHAR	/GET CHARACTER WHICH TERMINATED RECORD NUMBER
RWNRAN	SAD	S00051	/RIGHT PAREN?
	JMP	RWBIN1	/YES - BINARY I/O, NO EXITS
	ERS	05I,<SAD S00054>,EI	/CHAR BETTER BE COMMA
RWNRA	JMS	SIN530		/SAVE REGISTERS FOR LOOK AHEAD
	LAC	Y00000		/GET NEXT 3 CHARACTERS
	DZM	LOGIF		/DO NOT ALLOW CONTINUATION
	JMS	CTRL50
	SAD	S20564		/(END IN RADIX 50
	JMP	RWEOF
	SAD	S21042		/(ERR IN RADIX 50
	JMP	RWERR
RWNEIO	JMS	SIN540		/RESTORE SOURCE IMAGE
	LAC	SYMTMP		/MAKE SURE THAT THIS POINT REACHED ONLY ONCE
	ERN	36V,SZA,EV
	LAC	RWEOFS		/HAVE ANY SPECIAL EXITS BEEN INDICATED
	TAD	RWERRS
	ERN	37V,SZA,EV
	JMP	RWASC1		/BCD I/O
RWEOF	LAC	DCEOF		/GET ADDRESS TO GO TO ON END OF FILE
	SKP
RWERR	LAC	DCERR		/GET ADDRESS TO GO TO ON ERROR CONDITION
	DAC	STORC
	JMS	FNBCHR		/GET OPERATOR
	SAD	S00075		/=/
	SKP
	JMP	RWNEIO		/MUST NOT BE RIGHT AFTER ALL
	JMS	FDFSNO		/GET THE DEFINED ONLY STATEMENT NUMBER
STORC	XX			/STORE AWAY ADDRESS
	LAC	XCHAR		/TEST OPERATOR FOLLOWING ADDRESS
	JMP	RWNRAN		/BY RE-ENTERING SCAN LOOP
RWBIN1	LAC	SYMTMP
	SNA
	ISZ	RWBIN		/BIN I/O OFFSET
	LAC	RWEOFS		/DO WE NEED EXPANDED I/O?
	TAD	RWERRS
	SNA
	JMP	NEXIO		/NO
	LAC	T31442		/OUTPUT JMS* .ZR
	JMS	EXP580
	XOR	JMSCMD
	LAC	RWEOFS		/GET EOF EXIT
	JMS	ADROR0		/OUTPUT IT
	NOP
	LAC	RWERRS
	JMS	ADROR0		/NOW THE ERROR EXIT
NEXIO	NOP
	LAC	ENCFLG
	SZA		/IF ENCODE/DECODE FLAG IS ON
	JMP	NEXIOX	/IGNORE ALL THE OTHER FLAGS
	LAC	RWINIT	/OUTPUT I/O INITIALIZER
	TAD	RWFLAG		/BUMP FOR READ OR WRITE
	TAD	RWBIN		/BUMP FOR BINARY I/O
	TAD	RWRAN		/BUMP FOR RANDOM ACCESS
NEXIOX	JMS	OPOPA2
	LAC	ARTEM
	LAC	ENCFLG
	SNA			/ENCODE/DECODE?
	JMP	.+3		/NO
	LAC	ENCVAR		/YES - OUTPUT VARIABLE NAME
	JMS	EXP720
	LAC	RWBIN
	SZA
	JMP	RW13		/SKIP READING OF FORMAT LABEL IF BIN
	LAC	SYMTMP		/UNSAVE SYMBOL TABLE POINTER
	AND	V77777
	JMS	ADROR0		/OUTPUT THE FORMAT POINTER
	TAD	C00001
RW13	JMS	FNBCHR	/FETCH FIRST CHARACTER OF THE I/O LIST.
	DZM	RWDLVL		/ZERO IMPLIED DO LEVEL
	ISZ	RWEXPF		/SET FLAG FOR EXPRESSION ANALYZER
	JMS	CTRL60
	JMP	RW14	/IF CHAR NOT A CARRIAGE RETURN, THERE IS
	LAC	RWBIN		/IF I/O OPERATION IS A WRITE
	TAD	RWFLAG		/IN BCD MODE GO OUTPUT CLEANUP CODE
	ERN	02X,<SAD C00003>,EX	/ELSE ERROR
	JMP	RWENDL
/
ADROR0	SYN	LEVNOP	/SUBROUTINE TO PUT OUT A RELOCATABLE ADDR OR 0
	SNA		/IS IT 0?
	JMP	OUTPT0	/YES - USE FPPOUT
	DAC	SYMTBC
	LAC*	SYMTBC	/GET SYMTAB ENTRY
	SMA		/IS IT AN ARRAY?
	XCT*	ADROR0	/THIS IS EITHER A "NOP" OR A "TAD (1"
	AND	W17777	/MASK OUT ADDRESS AND ARRAY INDICATOR
	JMS	VECBIN	/OUT WE GO
	JMP*	ADROR0	/RETURN TO DATA WORD WITH NO ILL EFFECT
OUTPT0	JMS	FPPOUT	/ZERO IN AC - OUTPUT IT
	JMP*	ADROR0	/RETURN
/
RWASC1	JMS	FNBCHR		/GET A CHAR
	SAD	S00054		/COMMA?
	JMP	DATDIR		/YES - DATA DIRECTED I/O
	SAD	S00051		/CLOSE PAREN?
	JMP	DATDIR		/YES - D.D I/O
	DZM	UNFNBC		/PUT THE CHARACTER BACK
	JMS	FETSNO		/GET THE FORMAT STATEMENT NUMBER
	SMA		/POSITIVE RESULT MEANS STATEMENT NUMBER -
	JMS	CKDFSN	/CHECK TO SEE THAT ITS DEFINED (LEAVES AC POS.)
	SPA		/NEGATIVE RESULT MEANS NON-NUMBER -
	JMS	FVARGO	/FETCH ARRAY NAME
	LAC	SYMTBC		/SAVE THE SYMBOL TABLE ADDRESS
RW44A	DAC	SYMTMP
	LAC	XCHAR		/TEST OPERATOR
	SAD	S00054		/IF OPERATOR IS , THEN EXPANDED I/O INDICATED
	JMP	RWNRA
	ERS	01F,<SAD S00051>,EF  /BETTER BE CLOSE PAREN
	JMP	NEXIO		/GO TO OUPUT INITIALIZATION CODE
DATDIR	LAC	W00000
	JMP	RW44A		/SET SYMTMP TO 400000 AS A FAKE VALUE
	.EJECT
/	INPUT-OUTPUT LIST PROCESSOR
RW14	DZM	UNFNBC	/UNFETCH CHAR AND GO TO LIST PROCESSOR
/
RW19	JMS	FNBCHR		/PEEK AT THE NEXT CHARACTER
	SAD	S00050		/OPEN PAREN?
	JMP	RWIMDO		/YES - ASSUME BEGINNING OF AN IMPLIED DO
	DZM	UNFNBC		/NO - PUT CHAR BACK
	JMS	EXPRSN		/GET AN EXPRESSION
	LAC	TYPEA2		/GET TYPE OF RESULT
	SAD	T00000		/IS IT A VARIABLE?
	JMP	RW20		/YES - GOOD,GOOD
	ERS  03X,<SAD W00000>,EX  /ELSE MUST BE A STRING, IE, S.S. VARIABLE
	LAC	SYMTBX	/LAW -MODE WILL NOT BE NEEDED FOR DDIO OUTPUT
	TAD	C00005	/OF A SUBSCRIPTED ELEMENT OF ANY DIMENSION.
	DAC	DDSS2	/IN PARTICULAR, FOR OUTPUT OF A SINGLE DIMENSION
	LAC*	DDSS2	/SUBSCRIPTED VARIABLE.  FOR THIS CASE ONLY, DDSS2
	DAC	DDSS2	/GETS SET TO ZERO, AS SYMTAB ENTYR FOR 2ND DIM
	JMP	DDCHK	/IS ZERO.  GO CHECK IF WILL ACTUALLY BE DDIO
RW20	DAC	DDSS2	/STASH ARBITRARY NON 0 VALUE, INDICATING IS NOT
	LAC*	ADDRA2	/A 1 DIM. ARRAY SS ELEMENT REFERENCE.  NOW,
	SMA		/WAS RW20 ENTERED DUE TO SCALAR OR WHOLE ARRAY
	JMS	MODLAW	/REFERENCE? IF SCALAR, MUST OUTPUT LAW -MODE
DDCHK=.			/WHOLE ARRAY I/O ROUTINES GET MODE FROM ADB
			/AND .SS PASSES IT TO 1 DIM DDIO OUTPUT AND ALL
	LAC	SYMTMP		/(RKB-065) OTHER 2 AND 3 DIM I/O
	XOR	W00000		/(RKB-065)
	SNA			/(RKB-065) DATA DIRECTED I/O?
	JMP	DDLIST		/(RKB-065) YES - GENERATE DATA-DIRECTED CALLS
	.IFDEF	%DDIO	/AND .SS PASSES IT TO 1 DIM DDIO OUTPUT AND ALL
	LAC	SYMTMP	/OTHER 2 AND 3 DIM I/O
	XOR	W00000
	SNA			/DATA DIRECTED I/O?
	JMP	DDLIST		/YES - GENERATE DATA-DIRECTED CALLS
	.ENDC
	LAC	DDSS2	/WAS THIS A 1 DIM. ARRAY SS ELEMENT REFERENCE?
	SNA
	JMS	MODLAW	/YES, OUTPUT LAW -MODE
	LAC	TYPEA2
	SMA!CLA			/CHECK FOR ARRAY I/O
	LAC*	ADDRA2
	SMA!CLA
	LAC	C00002		/NO - SET SCALAR OFFSET
	TAD	RWBIN		/ADD BCD/BINARY OFFSET
	TAD	RWRAN		/ADD RANDOM ACCESS OFFSET
	TAD	RWABAS		/ADD BASE OF I/O TABLE
	JMS	OPOPA2		/GENERATE PROPER CALL
	LAC*	ARG2		/WITH PROPER ARG
RWCOMN	LAC	SIGNA2		/CHECK FOR NO UNARY MINUS STUFF
	ERN	24X,SPA,EX
RWCOMA	LAC	IDXNOP		/GET OP WHICH TERMINATED EXPRESSION
	SAD	C00030		/COMMA?
	JMP	RW19		/YES - CONTINUE SCANNING
	ERN	26X,SZA,EX	/BETTER BE A CARRIAGE RETURN
	JMP	RWENDL		/IT WAS - TERMINATE I/O SCAN
DDLIST	LAC	RWFLAG	/IF IS INPUT (RWFLAG=0), AND WAS A 1 DIM
	SZA		/S.S. ELEMENT REFERENCE, MUST OUTPUT LAW -MODE
	JMP	.+3	/ELSE THE MODE IS PASSED BY A .SS CALL
	SAD	DDSS2	/DDSS2 IS ZERO IF I DIM SS ELEMENT REFERENCE
	JMS	MODLAW
	LAC	TYPEA2
	RCL
	SZA!CLA		/FORM A RANDOM CONSTANT:
	LAC*	ADDRA2		/0 IF SCALAR, 1 IF S.S. VARIABLE,
	SPA!CLA		/4 IF ARRAY
	LAC	C00002
	RAL
	TAD	RWFLAG		/ADD IN READ/WRITE FLAG (0 OR 2)
	TAD	DDRWSC		/ADD IN BASE OF DATA - DIR I/O TABLE
	DAC	ARG
	LAC*	ARG		/LOAD SUBROUTINE TO CALL
	JMS	EXP580		/AND CALL IT
	XOR	JMSCMD
	LAC	RWFLAG
	SNA			/DON'T OUTPUT NAME IF INPUT OPERATION
	JMP	RWOPTR
	LAC	SYMTBX
	DAC	SYMTBC		/GET POINTER TO VARIABLE NAME
	JMS	SETADR			/SET UP POINTERS TO SYMTAB ENTRY
	LAC*	SYMTW2
	AND	V77777
	JMS	FPPOUT			/PRINT FIRST 3 CHARACTERS
	LAC*	SYMT2A
	JMS	FPPOUT			/AND SECOND 3 CHARACTERS
RWOPTR	LAC*	ARG2
	JMS	EXP720		/OUTPUT THE VARIABLE
	JMP	RWCOMN			/CONTINUE WITH LIST
/
RWENDL	LAC	RWBIN			/COMPUTE THE PROPER CLEANUP ROUTINE
	TAD	RWRAN
	TAD	RWCNUP
	DAC	ARG
	LAC*	ARG		/GET NAME OF SUBR TO CALL
	JMS	EXP580		/GENERATE CALL
	XOR	JMSCMD
	LAC	RWDLVL		/GET THE DO-LEVEL
	ERN	27X,SZA,EX	/ERROR IF NON-ZERO
	JMP	STEXIT		/WE'RE THROUGH
/
RWIMDO	JMS	EXP550		/GENERATE A "JMS STRING"
	XOR	JMSCMD
	DAC*	DOTABA		/SAVE THE STRING ADDRESS IN THE DO TABLE
	JMS	INCDTP		/BUMP DEPTH TO NEXT LEVEL
	ISZ	RWDLVL		/BUMP LEVEL COUNTER
	JMP	RW19		/CONTINUE
/
/ THE EXPRESSION ANALYZER GOES HERE IF AN EQUAL SIGN IS ENCOUNTERED
/ WHILE "RWEXPF" IS ON
/
RWEQLS	LAC	POP		/**051** CHECK THE STACK. IF NOT CLEARED THEN INCOMPLETE 
	ERS	33X,<SAD OP0>,EX	/**051** EXPRESSION INCOMPLETE AND ERROR
	LAC	RWDLVL		/**051**	GET THE DO-LEVEL
	ERN	28X,SNA,EX	/BETTER NOT BE ZERO
	TAD	K00001
	DAC	RWDLVL		/DECREASE IT BY 1
	JMS	DECDTP		/BUMP UP THE DO LEVEL POINTERS
	LAC	PC
	TAD	C00004		/GENERATE A "JMP .+4"
	XOR	JMPCMD
	JMS	RELBIN
	LAC*	DOTABA
	JMS	STRING		/DEFINE THE SUBROUTINE WHICH WE CALLED
	LAC	PC		/AT THE BEGINNING OF THE LOOP
	DAC*	DOTABA
	CLA
	JMS	FPPOUT
	JMS	DOCODE		/GENERATE THE DO LOOP CODE
	LAC*	DOTABA		/IN THE SUBROUTINE, THEN GENERATE
	XOR	JMPCMD		/A RETURN FROM THE SUBRROUTINE
	XOR	S20000
	JMS	RELBIN
	LAC*	DOTABC
	JMS	STRING	/DEFINE THE TERMINATION EXIT FROM THE SUBROUTINE
	LAC	C00032
	DAC	TFAO01		/SET LAST DELIMITER SPECIAL
	JMS	FA2NOP			/GET THE NEXT OPERATOR
	JMP	RWCOMA
/
RWABAS	BCDAIO-OPTRAN-1
RWCNUP	BCDCLN
RWINIT	BCDINT-OPTRAN-1
DDRWSC	DDRDSC
RWDLVL	.DSA	0	/IMPLIED DO LOOP DEPTH COUNTER
RWEXPF	.DSA	0	/"I/O LIST" FLAG FOR EXPRESSION ANALYZER
ARTEM	0		/.DAT SLOT ARGUMENT STORE
RWEOFS	0		/ADDRESS TO GO TO ON EOF
RWERRS	0		/ADDRESS TO GO TO ON ERROR IN I/O
DCEOF	DAC	RWEOFS
DCERR	DAC	RWERRS
RWRAN	0		/OFFSET FOR RANDOM ACCESS
SYMTMP	0
RWBIN=FORMST
/
MODLAW	CAL		/OUTPUT THE ONES COMPLEMENT OF THE MODE, AS A
	LAC*	SYMTBX	/LAW INSTRUCTION.  THIS IS DONE FOR SCALAR I/O
	AND	S60000	/CALLS, AND 1 DIM SS ELEMENT I/O CALLS OTHER
	LRSS	15	/THAN DDIO OUTPUT.  ALL OTHER SS ELEMENT I/O
	CMA		/RELIES ON .SS TO PASS THE MODE.  WHOLE ARRAY
	JMS	FPPOUT	/I/O GET THE MODE FROM THE ADB.
	JMP*	MODLAW
DDSS2	CAL		/SET TO 0 IS 1 DIM SS ELEMENT I/O, NON-0 OTHERWISE
	.EJECT
/BACKSPACE, REWIND, AND ENDFILE STATEMENT PROCESSORS.
/	BACKSPACE ENTRY = BACKSP
/	REWIND  ENTRY = REWIND
/	ENDFILE	ENTRY = ENDFIL
ENDFIL	LAC	C00001
REWIND	TAD	C00001
BACKSP	TAD	C00035
	DAC	TRW1		/SAVE OUTPUT OP-VALUE
	JMS	IODEV		/FETCH AND RECORD UNIT NUMBER
	LAC	TRW1		/OUTPUT SUBROUTINE CALL.
ENDF01	JMS	OPOPA2
	LAC	ARG
	JMP	CRTEST	/EXIT
	.EJECT
/ENCODE-DECODE STATEMENT PROCESSOR
ENCODE	TAD	C00002
DECODE	DAC	RWFLAG
	RCR
	TAD	DOTGFP		/GET A POINTER TO THE CORRECT ROUTINE
	DZM	RWBIN
	DZM	RWRAN		/ZERO VARIOUS FLAGS FOR THE READ/WRITE PROC
	DAC	ENCFLG
	JMS	FNBCHR
	ERS	39V,<SAD S00050>,EV	/NEXT CHAR BETTER BE (
	JMS	FIARGO		/GET CHARACTER COUNT
	LAC	ARG
	DAC	ARTEM		/STORE IN READ/WRITE TEMPORARY
	LAC	OPVALU
	ERS	40V,<SAD C00030>,EV	/DELIM BETTER BE COMMA
	JMS	FVARGO		/GET ARRAY NAME
	LAC	ARG
	DAC	ENCVAR		/SAVE IT AWAY
	LAC*	SYMTBC
	ERN	41V,SMA,EV	/ARRAY BETTER BE ARRAY
	LAC	OPVALU
	ERS	42V,<SAD C00030>,EV	/DELIM BETTER BE COMMA
	JMP	RWASC1		/NOW GO GET FORMAT AND ERR. CONDITIONS
ENCFLG	.DSA	0
ENCVAR	.DSA	0
DOTGFP	.DSA	DOTGF-OPTRAN-1
/
/
/SUBROUTINE TO FETCH DEVICE NUMBER AND OUTPUT IODEV LOADER INFORMATION
IODEV	SYN	TYPEA2
	JMS	FIARGO		/FETCH DEVICE NUMBER
	LAC	ARG		/TEST ARGUMENT.  IF A SYMBOL, DEFINE ALL
	AND	Z00000	/.DAT SLOTS.  IF A CONSTANT, DEFINE
	SAD	T00000	/ONE .DAT SLOT (=ARG).  IF NEITHER,
	JMP	IODEV2	/ANNOUNCE ERROR.
	JMS	CONTST
PASS1	SKP
IODEV2	LAC	W00000	/ALL SLOTS
	JMS	BINOUT	/OUTPUT IODEV INFO -- LOADER CODE 22.
	XOR	C00022
	JMP*	IODEV		/EXIT
	.EJECT
/DO STATEMENT PROCESSOR
DO	JMS	FDFSNO	/FETCH DEFINED STATEMENT NO.
	DAC*	DOTABA	/STORE SYMTAB ADDRESS IN DO TABLE, WORD A
	DZM	UNFNBC	/UNFETCH CHARACTER.
	JMS	INAOPI	/INITIALIZE ELEMENT LIST.
	JMS	FA2NOP
	LAC	IDXNOP		/CHECK DELIMITER FOR "="
	ERS	04D,<SAD C00001>,ED
	JMS	DOCODE		/GENERATE DO CODE
	JMS	INCDTP		/BUMP DO LEVEL POINTERS
	JMP	STEXIT		/EXIT
	.EJECT
/SUBROUTINE TO INITIALIZE DO-TABLE
/
INDOTB	SYN	IFFLAG		/SET DOTABA, DOTABB, AND DOTABC POINTERS
	LAC	.FFREE	/TO THE FIRST ADDRESS OF EACH OF THREE
	JMS	RSVDTP	/CONSECUTIVE TABLES.
	JMP*	INDOTB
/
/
/SUBROUTINE TO INCREMENT DO-TABLE POINTERS.
/
INCDTP	SYN	NAME2
	LAC	DOTABA
	TAD	C00001
	JMS	RSVDTP
	ERN	01L,<SAD SYMTB0>,EL	/CHECK FOR OVERFLOW
	JMP*	INCDTP	/EXIT
/
/
/
/SUBROUTINE TO DECREMENT DO-TABLE POINTERS.
/
DECDTP	SYN	IDXNOP
CLCCMD	CLC
	TAD	DOTABA
	JMS	RSVDTP
	JMP*	DECDTP	/EXIT
/
/
/
/SUBROUTINE TO RESOLVE DO-TABLE POINTERS.
/CALLING SEQUENCE -- JMS RSVDTP (DOTABA IN AC)
/
RSVDTP	SYN	NAME1
	DAC	DOTABA
	TAD	C00010
	DAC	DOTABB
	TAD	C00010
	DAC	DOTABC
	JMP*	RSVDTP
	.EJECT
/SUBROUTINE TO OUTPUT DO-CODING
/
DOCODE	CAL	0
	DZM	DOM1
	DZM	DOM3
	JMS	INFAOP	/RE-INITIALIZE ARG/OP FETCH
	LAC	MODEA2
	SNA		/CHECK THAT THE DO VARIABLE (ALREADY SCANNED)
	LAC	TYPEA2	/IS A SIMPLE INTEGER VARIABLE
	ERS	05D,<SAD T00000>,ED
	LAC*	ARG2
	DAC	DOI	/SAVE DO VARIABLE
	JMS	FIARGO	/GET INTEGER VAR/CONST AND OPERATOR
	LAC	OPVALU
	ERS	06D,<SAD C00030>,ED	/OP BETTER BE COMMA
	LAC	C00004	/GENERATE A LOAD INSTRUCTION
	JMS	OPOPA2
	LAC	ARG
	JMS	FIARGO
	LAC	ARG
	DAC	DOM2	/SAVE UPPER LIMIT
	LAC	OPVALU
	SAD	C00030
	JMP	.+3		/STEP EXISTS
	ISZ	DOM1		/NO STEP - SET STEP POSITIVE
	JMP	DOGEN		/GO GENERATE CODE
	JMS	FNBCHR	/PEEK AT NEXT CHAR
	SAD	C00045	/IS IT "-"
	JMP	.+3
	ISZ	DOM1	/NO - SET " POSITIVE DO" FLAG
	DZM	UNFNBC	/AND UNPEEK THE CHARACTER
	JMS	FIARGO
	LAC	ARG	/GET THE STEP
	DAC	DOM3	/SAVE IT AWAY
/
DOGEN	LAC	RWEXPF
	SZA!CLA	/THE DO PARAMETERS MUST BE TERMINATED BY A
	LAW	-37	/CARRIAGE RETURN IF IN A REGULAR DO LOOP
	TAD	OPVALU	/AND BY A RIGHT PAREN IF IN AN IMPLIED
	ERN	07D,SZA,ED	/DO LOOP
	LAC	DOM1	/DOM1=0 IF NEG DO, =1 IF POS DO
	.IFDEF	%PDP9	/NOW CALCULATE THE INITIAL JMP
	SZA		/"JMP .+3" FOR POS STEP,"JMP .+4" FOR NEG STEP
	.ENDC		/AND PDP-15, "JMP .+5" FOR NEG STEP
	CMA		/AND PDP-9 (CAUSE NEED TWO INSTRUCTIONS TO TCA)
	TAD	C00005
	TAD	PC
	XOR	JMPCMD	/GENERATE JMP .+N
	JMS	RELBIN
	LAC	PC
	DAC*	DOTABB	/SAVE POINTER TO LOOP REENTRY FOR DO CLEANUP
	LAC	DOM3
	SZA		/WAS THERE A STEP?
	JMP	DOWINC	/YES - COMPILE DO WITH STEP
	LAC	C00004
	JMS	OPOPA2		/LAC I
	LAC	DOI
	JMS	EXP730		/IAC  ( TAD 1 ON PDP9)
	JMP	DOSTOR
/
DOWINC	LAC	C00004
	JMS	OPOPA2
	LAC	DOM3		/LAC M3
	LAC	DOM1
	SNA
	JMS	EXP570		/TCA IF NEGATIVE STEP
	LAC	C00015
	JMS	OPOPA2		/TAD I
	LAC	DOI
DOSTOR	LAC	C00008
	JMS	OPOPA2		/DAC I
	LAC	DOI
	JMS	EXPKFF		/TCA
	LAC	C00015
	JMS	OPOPA2		/TAD M2
	LAC	DOM2
	LAC	DOM1
	SMA!SZA!CLA
	LAC	S00600	/GENERATE "SPA" IF POSITIVE STEP,
	TAD	.-2	/"SMA SZA" IF NEGATIVE STEP
	JMS	ABSBIN
	JMS	EXP550		/JMP OUT
	XOR	JMPCMD
	DAC*	DOTABC		/SAVE ADDRESS OF JUMPOUT
	JMP*	DOCODE
	.EJECT
/FORMAT STATEMENT PROCESSOR
FORMAT	DZM	SYMTBC
	JMS	EXP550	/OUTPUT BRANCH AROUND FORMAT STORAGE AND
	XOR	JMPCMD	/	SET FLAG FOR COMPLETING STRING.
	DAC	STRNGA
	LAC	LABEL	/IF NO LABEL, ANNOUNCE ERROR.
	ERN	04N,SNA,EN	/ERROR: NO STATEMENT NUMBER
	DZM	HFLG	/INITIALIZE HOLLERITH FLAG.
	DZM	NUMFLG	/INITIALIZE NUMERIC FLAG.
	LAW	-5	/INITIALIZE FORMAT OUTPUT PACKER.
	DAC	FMTCNT
	DZM	FPCNT	/INITIALIZE PAREN COUNT.
RW60	JMS	FMTFCH	/FETCH CHARACTER.
RW61	SAD	S00054
	JMP	RW70	/IF COMMA.
	SAD	S00051
	JMP	RW71	/IF RIGHT PAREN.
RW62	SAD	C00047
	JMP	RW60	/IF SLASH
	SAD	C00034
	JMP	RW85	/IF "
	SAD	C00036
	JMP	RW85	/IF $
	SAD	C00039
	JMP	RW85	/IF '
	SAD	S00124
	JMP	RW81	/IF T
RW63	SAD	C00045
	JMP	RW72	/IF MINUS SIGN.
RW635	SAD	S00050
	JMP	RW75	/IF LEFT PAREN.
	JMS	NUMCHK
	JMP	RW636	/IF NUMBER.
	SAD	S00120
	JMP	RW77	/IF P
	SAD	S00110
	JMP	RW78	/IF H
	SAD	S00130
	JMP	RW80	/IF X
	SAD	S00111
	JMP	RW81	/IF I
	SAD	S00114
	JMP	RW81	/IF L
	SAD	S00101
	JMP	RW81	/IF A
	SAD	S00122
	JMP	RW81		/IF R
	SAD	S00117
	JMP	RW81		/IF O
RW64	JMS	NUMCHK
	JMP	RW65	/IF NUMBER
RW65	SAD	S00104
	JMP	RW82	/IF D
	SAD	S00105
	JMP	RW82	/IF E
	SAD	S00106
	JMP	RW82	/IF F
	SAD	S00107
	JMP	RW82	/IF G
RW66	ERS	02F,<JMS NUMCHK>,EF	/GET WIDTH - ERROR IF NOT THERE
	LAC	LS
	ERN	03F,SNA,EF	/ERROR: FIELD WIDTH IS 0
	DZM	NUMFLG	/RESET NUMERIC FLAG AND CHECK XCHAR FOR
	LAC	XCHAR	/	A PERIOD.
	SAD	C00046
	JMP	RW68	/IF PERIOD, CONVERSION MUST BE FLOATING.
	LAC	FLOATF	/IS CONVERSION D, E, F, OR G.
	ERN	04F,SZA,EF	/ERROR: ILLEGAL W IN NSW.D
	LAC	XCHAR	/	NO, GET NEXT CONVERSION.
	JMP	RW61
RW68	LAC	FLOATF	/IS CONVERSION D, E, F, OR G.
	ERN	05F,SNA,EF	/ERROR: ILLEGAL W IN NSW.D
	JMS	FMTFCH	/	YES, GET D-VALUE.
	ERS	06F,<JMS NUMCHK>,EF	/GET D-VALUE - ERROR IF MISSING
	DZM	NUMFLG
	JMP	RW61	/GET NEXT CONVERSION.
/NUMBER WAS FOUND; PAREN COUNT MUST BE AT LEAST ONE
RW636	LAC	FPCNT	/MUST
	SNA		/MAKE EXPLICIT CHECK TO PREVENT CONDITION OF A
	JMP	EF07F	/NUMBER PRECEEDING THE FIRST LEFT PAREN OF
	LAC	XCHAR	/THE FORMAT STATEMENT.  RECOVER NEXT CHARACTER,
	JMP	RW635	/AND GET NEXT CONVERSION
/COMMA	PROCESSOR.
RW70	LAC	FPCNT	/CHECK PAREN COUNT.
	ERN	07F,SPA!SNA,EF	/ERROR: MISSING LEFT PAREN
	JMS	FMTFCH
	JMP	RW62
/RIGHT PAREN PROCESSOR.
RW71	CLC		/DECREMENT PAREN COUNT.
	TAD	FPCNT
	DAC	FPCNT
	SPA		/(RKB-064) CHECK PAREN COUNT --
	JMP	EF07F	/(RKB-064) ERROR IF MINUS (MISSING LEFT PAREN)
	SZA		/(RKB-064)
	JMP	RW60	/(RKB-064) GET NEXT CONVERSION IF PLUS
	JMP	RW83	/(RKB-064) TRY TO EXIT IF ZERO.
/MINUS SIGN PROCESSOR.
RW72	JMS	FMTFCH	/FETCH NEGATIVE SCALE FACTOR
	ERS	08F,<JMS NUMCHK>,EF	/GET NUMBER - ERROR IF MISSING
RW73	DZM	NUMFLG
	ERS	09F,<SAD S00120>,EF	/ERROR: P MISSING
	JMS	FMTFCH	/FETCH NEXT CHARACTER.
	JMP	RW64	/REENTER SKIP CHAIN.
/LEFT  PAREN PROCESSOR.
RW75	ISZ	FPCNT	/BUMP PAREN COUNT.
	JMS	FMTFCH	/FETCH NEXT CHARACTER.
	JMP	RW62	/REENTER SKIP CHAIN.
/P PROCESSOR
RW77	LAC	NUMFLG	/IS P PRECEDED BY A NUMBER.
	ERN	10F,SNA,EF	/ERROR: NO NUMBER BEFORE P
	JMS	FMTFCH		/FETCH NEXT CHAR
	JMP	RW64		/RE-ENTER SKIP CHAIN
/H PROCESSOR
RW78	LAC	NUMFLG	/IS H PRECEDED BY A NUMBER.
	SZA
	LAC	LS	/IF SO, TEST FOR NUMBER >0
	DZM	NUMFLG
	ERN	12F,SNA,EF	/ERROR: ZERO PRECEDING H
	JMS	TWOCMA	/	NO, FETCH AND SKIP (LS) CHARACTERS.
	DAC	LS
	DAC	HFLG	/SET HOLLERITH FLAG.
RW79	JMS	FMTFCH
	ISZ	LS
	JMP	RW79
	DZM	HFLG	/RESET HOLLERITH FLAG.
	JMP	RW60	/REENTER SKIP CHAIN AT TOP.
/X PROCESSOR
RW80	LAC	NUMFLG	/IS X PRECEDED BY A NUMBER.
	SZA		/IF SO,
	LAC	LS	/MAKE SURE ITS NON-ZERO
	DZM	NUMFLG
	ERN	13F,SNA,EF	/ERROR: BAD NUMBER BEFORE X
	JMP	RW60	/	NO, REENTER SKIP CHAIN AT TOP.
/" AND $ PROCESSORS
/
RW85	DAC	LS
	DAC	HFLG	/PASS BLANKS
RW86	JMS	FMTFCH
	SAD	LS
	SKP
	JMP	RW86	/LOOP UNTIL CLOSE QUOTE
	DZM	HFLG
	JMP	RW60
/T,I,L,A PROCESSORS.
RW81	DZM	FLOATF	/SET FLAG TO NON-FLOATING.
	JMP	RW825	/REENTER SKIP CHAIN.
/D,E,F,G PROCESSORS.
RW82	CLC		/SET FLAG TO FLOATING.
	DAC	FLOATF
RW825	JMS	FMTFCH
	JMP	RW66	/REENTER SKIPCHAIN
/EXIT CHECKS.
RW83	JMS	FMTFIL	/FILL MS/LS WITH BLANKS IF NECESSARY.
	JMS	FMTOUT	/	NECESSARY -- OUTPUT LAST WORD PAIR.
	JMS	FNBCHR	/FETCH NEXT CHARACTER (SHOULD BE A C/R).
	JMP	CRTEST	/EXIT
/
/SUBROUTINE TO FETCH, TEST, PACK, AND OUTPUT A FORMAT CHARACTER.
FMTFCH	SYN	TARGI
	LAC	HFLG		/TEST HOLLERITH FLAG.  IF SET, FETCH CHAR-
	SNA		/ACTER.  IF NOT SET, FETCH NON-BLANK
	JMP	FMTFC0	/CHARACTER.
	JMS	FETCHR
	LAC	XCHAR
	SKP
FMTFC0	JMS	FNBCHR
	JMS	FMTPAK	/PACK XCHAR IN MS/LS.
	JMS	FMTOUT	/IF MS/LS FULL, OUTPUT 2 OBJECT WORDS.
	JMS	CTRL60	/TEST IF CHARACTER WAS CARRIAGE RETURN
	JMP*	FMTFCH	/NO - EXIT WITH CHARACTER IN AC
	ERX	15F,EF	/ERROR: TOO MANY LEFT PARENTHESES
	.EJECT
/SUBROUTINE TO SHIFT MS/LS LEFT 7 AND MERGE CHARACTER.
/  CALLING SEQUENCE -- LAC   CHARACTER (ASCII-7)
/	JMS	FMTPAK
/	JMP	MS/LS FULL (5 CHARACTERS PACKED)
/	XXX	MS/LS NOT FULL (1-4 CHARACTERS PACKED)
/  INITIALIZATION -- SET FMTCNT TO -5.
FMTPAK	SYN	OP
	AND	S00177
	DAC	TRW1		/SAVE CHARACTER TO BE PACKED.
	LAW	-7		/INITIALIZE SHIFT-CONNT.
	DAC	TRW2
FMTPK1	JMS	DSHL		/SHIFT MS/LS 7 LEFT OPEN.
	ISZ	TRW2
	JMP	FMTPK1
	LAC	FLS		/MERGE IN SAVED CHARACTER.
	XOR	TRW1
	DAC	FLS
	ISZ	FMTCNT	/CHECK IF 5 CHARACTERS HAVE BEEN PACKED.
	JMP	FMTPK2	/NO, BUMP RETURN ADDRESS AND EXIT.
	JMS	DSHL		/YES, LEFT JUSTIFY MS/LS AND REINITIAL-
	LAW	-5		/IZE CHARACTER COUNTER.
	DAC	FMTCNT
	JMP*	FMTPAK	/EXIT FOR MS/LS FULL.
FMTPK2	ISZ	FMTPAK	/EXIT FOR MS/LS NOT FULL.
	JMP*	FMTPAK
/
/
/SUBROUTINE TO FILL MS/LS WITH BLANK CHARACTERS
/  CALLING SEQUENCE
/	JMS	FMTFIL
/	JMP	(FILL REQUIRED AND WAS EXECUTED)
/	XXX	(FILL NOT REQUIRED -- NO CHANGE)
FMTFIL	SYN	OPVALU
	LAW	-5		/IF MS/LS ALREADY CONTAINS 5 CHARACTERS,
	SAD	FMTCNT	/BUMP RETURN ADDRESS AND EXIT WITH
	JMP	FMTFL2	/MS/LS UNCHANGED.
FMTFL1	LAC	S00040	/IF MS/LS IS PARTIALLY FULL, PACK BLANKS
	JMS	FMTPAK	/UNTIL IT IS FULL, THEN EXIT.
	JMP*	FMTFIL
	JMP	FMTFL1
FMTFL2	ISZ	FMTFIL
	JMP*	FMTFIL
/
/
/SUBROUTINE TO OUTPUT M/S
/
FMTOUT	SYN	TOPI
	LAC	FMS		/OUTPUT MS
	JMS	FPPOUT
	LAC	FLS		/OUTPUT LS

	JMS	FPPOUT

	JMP*	FMTOUT	/EXIT

	.EJECT

/SUBROUTINE TO CHECK FOR A NUMBER AND COMPLETE ITS CONVERSION.

/  CALLING SEQUENCE -- LAC   CHARACTER (ASCII-7)

/	JMS	NUMCHK

/	JMP	YES

NUMCHK	SYN	ARG

	JMS	NUMTST	/IS CHARACTER A NUMBER.

	JMP	NUMCH3	/NO, BUMP RETURN ADDRESS AND EXIT.

	ISZ	NUMFLG	/YES - SET FLAG

NUMCH1	DAC	LS	/SAVE VALUE OF NUMBER

NUMCH2	JMS	FMTFCH	/FETCH NEXT CHARACTER.

	JMS	NUMTST	/IS IT A NUMBER.

	JMP*	NUMCHK	/NO, EXIT WITH NEXT (XCHAR) IN AC.

	DAC	TRW1	/YES - SAVE VALUE

	LAC	LS

	RTL

	TAD	LS	/MULTIPLY LS BY 10.

	RAL

	TAD	TRW1	/ADD IN NEW DIGIT

	JMP	NUMCH1	/UPDATE VALUE AND LOOP

NUMCH3	ISZ	NUMCHK	/EXIT HERE IF 1ST CHARACTER NON-NUMERIC.

	JMP*	NUMCHK	/EXIT WITH CURRENT XCHAR IN AC.

/

/

/SUBROUTINE TO TEST FOR A NUMBER

/  CALLING SEQUENCE -- LAC   CHARACTER

/	JMS	NUMTST

/	JMP	NO

NUMTST	SYN	SIGN

	TAD	Z77706	/IS CHARACTER LESS THEN OR EQUAL TO NINE

	CLL!CML		/BUT GREATER THAN OR EQUAL TO ZERO?

	TAD	C00010

	SZL		/LINK ON IF VALID NUMBER

	LAC	XCHAR	/RELOAD CHAR IF INVALID

	SNL

	ISZ	NUMTST	/SKIP RETURN IF VALID

	JMP*	NUMTST

/

/SUBROUTINE TO SHIFT FMS/FLS LEFT ONE OPEN.

/

DSHL	SYN	CHRCTR

	LAC	FLS

	RCL

	DAC	FLS

	LAC	FMS

	RAL

	DAC	FMS

	JMP*	DSHL

	.EJECT

/		ASSIGNMENT STATEMENT PROCESSOR

/		ASSIGN K TO I

/

ASSIGN	JMS	FDFSNO	/GET A STATEMENT NUMBER

	LAC	SYMTBC

	DAC	S	/FORM A PSEUDO - CONSTANT WITH THE

	LAC	Y00000	/SYMBOL TABLE ADDRESS OF THE STATEMENT NUMBER

	DAC	NAME0	/AS THE VALUE AND "RELOCATABLE" AS THE TYPE

	JMS	CONSSE	/ENTER IT IN THE CONSTANT TABLE

	DAC	SYMTBC

	LAC	XCHAR		/ WAS TERMINATING CHAR A -T-

	ERS	06I,<SAD S00124>,EI	/ERROR: NO T

	JMS	FNBCHR	/ CHECK FOR -O-

	ERS	07I,<SAD S00117>,EI	/ERROR: NO O

	JMS	SYMBIN	/OUTPUT "LAC (STNO"

	XOR	LACCMD

	JMS	FIARGO	/FETCH INTEGER ARGUMENT, OP

	JMS	VARTST	/ARGUMENT MUST BE A VARIABLE

	LAC	C00008	/SET STORE INSTRUCTION

	JMP	ENDF01	/OUTPUT INSTRUCTION AND EXIT

	.EJECT

/		GOTO  STATEMENT PROCESSOR

/

GOTO	CLC

	DAC	RWFLAG	/INITIALIZE FLAG FOR LIST PROCESSING

	JMS	FNBCHR

	SAD	S00050	/IS CHAR AN OPEN PARENS (?

	JMP	GOTO01	/  YES, IS ((), THIS IS COMPUTED GOTO

	DZM	UNFNBC	/  NO, UNFETCH AND TEST LAST CHAR FOR A-Z

	JMS	AIF500	/GET STATEMENT NUMBER OR VARIABLE AND OUTPUT JUMP

	SAD	S00054	/WAS TERMINATOR COMMA?

	SKP		/YES - ASSIGNED GOTO

	JMP	CRTEST	/NO - BETTER BE CR

	LAC	SYMTBC

	ERN	24I,SMA,EI	/COMMA ILLEGAL AFTER STATEMENT NUMBER

	JMS	FNBCHR

	ERS	07X,<SAD S00050>,EX	/NEXT CHAR BETTER BE (

	DZM	RWFLAG	/ZERO FLAG AND FALL THROUGH COMPUTED GOTO CODE

/

/		COMPUTED GOTO

/		GOTO (S1,S2,S3,..SN), V

GOTO01	JMS	INAOPI	/INITIALIZE INTEGER ARG, OP

GOTO02	JMS	FDFSNO	/FETCH DEFINED STATEMENT NO.

	DAC	OP

	JMS	ENTER		/ENTER ARG IN LIST

	LAC	XCHAR		/TEST LAST CHAR FOR COMMA (,)

	SAD	S00054	/ (EXT 54)

	JMP	GOTO02	/ YES, IS COMMA, CYCLE BACK FOR NEXT STMNT

	ERS	04X,<SAD S00051>,EX	/NOT COMMA, BETTER BE )

	JMS	FNBCHR	/FETCH NEXT NON-BLANK CHARACTER

	ISZ	RWFLAG	/IF RWFLAG IS NOT -1, THIS IS AN ASSIGNED GOTO STMT

	JMP	CRTEST	/AND ALL WE WANTED WAS TO ERROR-CHECK, SO GOODBYE

	ERS	05X,<SAD S00054>,EX	/BETTER BE COMMA

	JMS	FIARGO	/FETCH INTEGER ARG, OP

	JMS	VARTST	/ARGUMENT MUST BE A VARIABLE

	LAC	C00004	/SET INDEX VALVE FOR INTEGER LOAD (LAC)

	JMS	OPOPA2	/OUTPUT PREVIOUS OP, ARG2 (LAC V)

	LAC	ARG

	LAC	CGOMNE	/SET CAT .GO

	JMS	EXP580	/OUTPUT INSTRUCTION (JMS+ .GO)

	XOR	JMSCMD

	LAC	ARGI	/DETERMINE NO OF STATEMENT NOS. IN LIST (N)

	JMS	TWOCMA

	TAD	ARG0	/ MOW HAVE (-N)

	DAC	TARGI	/SAVE FOR JUMP COUNTER

	JMS	FPPOUT	/OUTPUT (-N)

	JMS	INAOPI

GOTO06	ISZ	OPI

	LAC*	OPI

	JMS	JMPBIN	/OUTPUT JUMP TO STATEMENT NUMBER

	ISZ	TARGI	/DO THIS THE CORRECT NUMBER OF TIMES

	JMP	GOTO06

	JMP	CRTEST	/SO LONG

	.EJECT

/ SUBROUTINE TO OUTPUT A JUMP

/ CALLING SEQUENCE - LOAD AC WITH POINTER INTO SYMBOL TABLE

/ (SIGN 0 IF ST. NO., 1 IF ASSIGNED VARIABLE)

/	JMS	JMPBIN

/

JMPBIN	CAL	0

	DAC	SYMTBC

	SPA		/STATEMENT NUMBER?

	JMP	JMPSYM	/NO

	JMS	SYMBIN	/YES - OUTPUT "JMP STNO"

	XOR	JMPCMD

	JMP*	JMPBIN	/RETURN

JMPSYM	LAC*	SYMTBC	/VARIABLE --

	AND	T00000	/CHECK FOR DUMMY OR COMMON VARIABLE

	SNA

	JMP	JMPVAR	/NEITHER - A SIMPLE JMP* WILL DO

	LAC	PASS1	/OUTPUT THE FOLLOWING SEQUENCE

	JMS	ABSBIN	/		SKP		(MIGHT BE IN IF STMT)

	LAC	PC

	TAD	C00004	/		JMP	.+4

	XOR	JMPCMD

	JMS	RELBIN	/		LAC*	VAR

	JMS	SYMBIN

	XOR	LACICM	/		DAC	TEMP

	CLA

	JMS	STORET	/		JMP*	TEMP

	DAC	SYMTBC

JMPVAR	JMS	SYMBIN

	XOR	JMPICM	/OUTPUT A JUMP INDIRECT THROUGH CURRENT SYMTBC

	JMP*	JMPBIN	/RETURN

LACICM	LAC*	0

	.EJECT

/ CONTINUE STATEMENT PROCESSOR

/

CONTIN	JMS	FNBCHR	/GET LAST CHARACTER

	JMP	CRTEST	/EXIT AND TEST FOR C/R IN XCHAR

/ PAUSE STATEMENT PROCESSOR

/

PAUSE	LAC	JMSCMD	/SET UP FOR  JMS* .PA INSTRUCTION

	DAC	POP		/ HOLD -JMS-

	LAC	PAMNE		/ GET .PA

	JMP	STOP01

/ STOP STATEMENT PROCESSOR

/

STOP	LAC	JMPCMD	/SET UP FOR  JMP* .ST INSTRUCTION

	DAC	POP		/ HOLD -JMP-

	LAC	STMNE		/ GET .ST

STOP01	DAC	ARG2		/ HOLD .PA OR .ST

	DZM	UNFNBC	/WE ARE GOING TO FALSELY INSERT A "#"

	JMS	INFAOP	/INTO THE INPUT CHARACTER STREAM SO THAT THE

	LAC	CHAROC	/NEXT NUMBER (IF ANY) WILL BE TAKEN AS OCTAL

	DAC	LSTCHR

	JMS	FIARGO	/FETCH AN INTEGER

	LAC	C00004

	JMS	OPOPA2

	LAC	ARG	/GENERATE "LAC (CONSTANT"

	LAC	ARG2		/GET .PA OR .ST

	JMS	EXP580	/BUILD AND OUTPUT JMS* .PA OR JMP* .ST

	XOR	POP	/ (JMS OR JMP)

	JMP	CRTEST	/STATEMENT EXIT

	.EJECT

/ DATA STATEMENT PROCESSOR

/

DATA	LAW	-1

	DAC	DATAFL

	JMS	CTRL70	/CATCH STMT LABEL FOR CONTINUE ERROR.

DATA25	JMS	INAOPI	/INITIALIZE ARG(I) AND OP(I) LISTS

DATA01	JMS	FVORAR	/FETCH SIMPLE OR SUBSCRIPTED VARIABLE, OP

	CLL

	JMS	SYMTYP	/IS VARIABLE COMMON

	XOR	T00000

	CML		/LINK IS COMPLEMENTED IF VAR NOT IN COMMON

	LAW	-1

	SAD	FCNFLG	/LINK COMPLEMENTED AGAIN IF IN BLOCK DATA

	CML

	ERN	16C,SNL,EC	/WRONG COMBINATION YIELDS ERROR

	LAC*	ARG

	SMA		/ARRAY?

	JMP	DATA1B	/NO

	LAC	SSCTR

	SZA		/SUBSCRIPTS?

	JMP	DATA1A	/YES - TREAT NORMALLY

	LAC	W00000

	DAC	T0	/SET T0 TO STRANGE NEGATIVE NUMBER

	SKP

DATA1A	JMS	SUBCNT	/CHECK NUMBER OF SUBSCRIPTS

DATA1B	JMS	ENTER	/ENTER ARG, OP IN ARG(I), OP(I) LISTS

	LAC	T0	/PLACE SUBSRIPT VALUE

	DAC*	OPI	/ IN OP(I)

	LAC	OPVALU	/IS OPERATOR A COMMA (,)

	SAD	C00030

	JMP	DATA01	/	YES, CYCLE BACK FOR NEXT VARIABLE

	ERS	10X,<SAD C00018>,EX	/BETTER BE A SLASH

	JMS	EXP540	/MOVE ARG(I) TO TARG(I)

	JMS	INAOPI	/RE-INITIALIZE THE LIST

	DZM	TFAO01

	LAW	-1

	DAC	ARGCTR	/INITIALIZE REPEAT FLAG

	LAC	C00030

	DAC	OPVALU	/INITIALIZE LAST OP TO A COMMA

DATA02	ISZ	ARGI

	ISZ	OPI	/GET NEXT VARIABLE FROM VARIABLE LIST

DATA03	ISZ	ARGCTR	/ARE WE REPEATING?

	JMP	DATA05	/YES - KEEP OLD VARIABLE

	LAW	-1

	DAC	ARGCTR	/RE-INITIALIZE COUNTER

	LAC	OPVALU

	ERS	11V,<SAD C00030>,EV	/MAKE SURE LAST CHAR SCANNED IS ,

DATA04	LAC	C00001	/IF HOLLERITH CONSTANT IS GOTTEN, THIS IS RESET TO

	DAC	HOLCON	/-5 TO 0, CORRESPONDING TO 0 TO 5 CHARACTERS PACKED

	JMS	FARGOP	/GET ARG AND OP

	LAC	ARG

	AND	Z00000

	ERS	09V,<SAD U00000>,EV	/MAKE SURE ARG IS A CONSTANT

	LAC	OPVALU	/IF OP IS *, GO STORE REPEAT FACTOR

	SAD	C00021	/ALSO SET -1 INTO DATA22.  IT IS ISZ'D

	JMP	DATA16	/EACH TIME HAVE TO CONVERT INTEGER CONSTANT

	LAW	-1	/TO D.I. VARIABLE; ALLOWING THIS CONVERSION

	DAC	DATA22	/ONLY ONCE IN A REPEAT CYCLE.

DATA05	LAC*	ARGI	/GET ARGUMENT DESCRIPTION WORD (I)

	JMS	SETA2	/BUST ARGUMENT

	JMS	SETADR	/ TO GENERATE VARIABLE ADDRESSES

	LAC	HOLCON	/IF HOLCON IS STILL 1, THEN NO HOLLERITH INFORMATION

	SAD	C00001	/WAS ENCOUNTERED.  ELSE CHECK IF ONLY 1 OR TWO

	JMP	DATA26	/CHARACTERS WERE PACKED.  ADDING 2 TO HOLCON

	TAD	C00002	/LEAVES IT NEGATIVE IF ONLY 1 OR 2 CHARS WERE

	SPA!CLL		/PACKED, FOR WHICH CASE THE LINK IS SET.

	STL

	LAC	MODEA2	/GET THE MODE OF THE VARIABLE

	DAC	NAME0	/MAKE  THE MODE OF THE CONSTANT MATCH IT

	AND	S60000	/NOW, IF IT IS AN INTEGER, WONT ALLOW MORE THAN

	SZA		/2 CHARS.  SKIPS IF IS INTEGER.

	JMP	DATA26	/NOT INTEGER, WE ARE SAFE (ULTIMATE 5 CHAR LIMIT) 

	ERS  02H,SZL,EH	/IF LINK IS OFF, TOO MANY CHARS

DATA26	LAC	NAME0	/CHECK IF MODE OF VARIABLE IS MODE OF CONSTANT

	RTL		/(THIS IS FORCED FOR HOLLERITH CODE)

	AND	V00000

	DAC	MODEA1	/SHIFT BITS 3,4 INTO BITS 1,2 FOR OUTPUT

	LAC	MODEA2

	SAD	NAME0	/VARIABLE AND CONSTANT MODES SHOULD AGREE

	JMP	DATA06

	TAD	MODEA1	/ONLY EXCEPTION BEING WHEN VAR IS DBL INTEGER

	ERS	38V,<SAD S60000>,EV	/AND CONSTANT IS INTEGER

	ISZ	DATA22	/INITIALLY = -1, ALLOWING CONVERSION OF

	JMP	DATA06+2	/INTEGER TO DOUBLE INTEGER ONLY FIRST

	LAC	S	/TIME THROUGH.  THIS PREVENTS REPEAT COUNT

	DAC	NAME1	/SEQUENCE FROM CONVERTING MORE THAN ONCE

	SPA!CLA		/IN A SEQUENCE

	CMA

	DAC	S

	JMP	.+3

DATA06	LAC	MODEA1	/IF THE MODE OF THE VARIABLE IS

	SAD	V00000	/DOUBLE INTEGER, MAKE IT REAL TO PACIFY THE

	LAC	T00000	/LOADER (WHICH THINKS MODE 3 IS LOGICAL)

	DAC	MODEA1

	LAC	S	/OUTPUT FIRST DATA WORD

	JMS	BINOUT	/WITH

	XOR	C00015	/LOADER CODE 15

	LAC	MODEA1	/IF MODE OF CONSTANT IS INTEGER OR LOGICAL,

	SNA		/ SKIP OUTPUT OF SECOND DATA WORD

	JMP	DATA08

	LAC	NAME1	/OUTPUT SECOND DATA WORD

	JMS	BINOUT	/ WITH

	XOR	C00016	/	LOADER CODE 16

	LAC	MODEA1	/IF MODE OF CONSTANT IS REAL,

	SAD	T00000

	JMP	DATA08	/ SKIP OUTPUT OF THIRD DATA WORD

	LAC	NAME2	/OUTPUT THIRD DATA WORD

	JMS	BINOUT	/ WITH

	XOR	C00017	/	LOADER CODE 17

DATA08	LAC*	SYMTBC	/GET SYMBOL DESCRIPTION

	AND	Z00000

	SAD	W00000	/CHECK FOR A NON-COMMON ARRAY

	JMP	DATA09	/YES - USE POINTER FROM ARRAY DESCRIPTOR BLOCK

	LAC*	SYMTBC	/	NO, GET ARG DESCRIPTION WORD (WORD 1)

	AND	S17777	/	KEEP ADDRESS OF VARIABLE

	JMP	DATA12

DATA09	LAC*	SYMTW7	/GET ADDRESS OF ARRAY

DATA12	TAD*	OPI	/ ADD SUBSCRIPT VALUE (0 IF NOT ARRAY)

	TAD	MODEA1	/ADD MODE BITS IN BITS 1,2

	AND	V77777	/AND OUT SIGN BIT, IF ARRAY KLUDGE

	JMS	BINOUT	/OUTPUT DEFINITION WORD

	XOR	C00018	/WITH LOADER CODE 18

	LAC	MODEA2

	JMS	SETN

	TAD*	OPI

	DAC*	OPI	/BUMP SUBSCRIPT BY ARGUMENT LENGTH

	XOR	W00000	/CHANGE SIGN BIT

	SMA		/IF THIS IS ARRAY KLUDGE, CHECK WHETHER

	SAD*	SYMTW3	/WE HAVE EXHAUSTED THE ARRAY

	SKP		/NO ARRAY OR ARRAY EXHAUSTED - GET NEXT ARG

	JMP	DATA03	/NOT EXHAUSTED YET - GET NEXT CONSTANT

	LAC	ARGI

	SAD	TARGI	/IF CURRENT ARG PTR IS AT END OF LIST

	JMP	DATA21	/THEN WE ARE FINISHED

	JMP	DATA02	/OTHERWISE BUMP POINTERS AND CONTINUE

DATA16	LAC	NAME0

	SNA

	ISZ	ARGCTR

	ERX	15C,EC	/CURRENT REPEAT CTR MUST BE 0 AND REPEAT FACTOR

	JMS	CONTST	/MUST BE A POSITIVE NON-ZERO INTEGER.

	JMS	TWOCMA

	DAC	ARGCTR	/STORE INTEGER (NEGATED) AS NEW REPEAT COUNT

	JMP	DATA04	/AND GO GET SOME DATA TO REPEAT

DATA21	LAC	C00018	/END OF LIST HAS BEEN REACHED -

	SAD	OPVALU	/CHECK THAT NEXT INPUT CHARACTER IS A SLASH

	ISZ	ARGCTR	/AND THAT THE REPEAT SWITCH IS OFF

	ERX	12V,EV	/OTHERWISE ERROR

	JMS	FNBCHR	/GET NEXT NON-BLANK CHAR

	SAD	S00054	/ IS IT A COMMA

	JMP	DATA25	/YES, REINITIALIZE FOR NEW SET OF VARIABLES

	JMP	CRTEST	/NO, TEST FOR C/R AND EXIT

HOLCON	XX

DATA22	XX

	.EJECT

/ IF STATEMENT PROCESSOR

/

IF	LAC	C00024	/THE IF INDICATOR IS SET AS AN OPEN

	DAC	IFFLAG	/PARENTHESIS FOR EXPRESSION DECODING.

	JMS	EXPRSN	/THE IF EXPRESSION IS DECODED AND THE

	LAC	OPVALU	/NECESSARY CODE IS GENERATED SO THAT THE

			/RESULT WILL BE LEFT IN THE ACCUMULATOR

	ERS	11X,<SAD C00031>,EX	/ERROR: NO CLOSE PAREN

	JMS	SIN530	/SAVE COLUMN POINTERS

	ISZ	CTRLSW	/INHIBIT READING CONTINUATION CARDS

IFLP	JMS	FETCHR	/GET A CHARACTAR

	SKP		/NORMAL CHARACTER

	JMP	LGCLIF	/END OF LINE REACHED - ASSUME LOGICAL IF

	TAD	K00005

	SMA		/CHECK IF CHAR IS ALPHANUMERIC

	SAD	C00006	/OR BLANK

	JMP	IFLP	/IT IS - KEEP LOOKING

	LAC	XCHAR	/IF FIRST NON-ALPHANUMERIC, NON-BLANK CHARACTER

	SAD	S00054	/IS NOT A COMMA,

	SKP

	JMP	LGCLIF	/ITS A LOGICAL IF STMT

	JMS	FNBCHR	/IF COMMA, WE MUST STILL CHECK THAT THE NEXT CHAR

	SAD	S00050	/IS A RIGHT PAREN

	JMP	LGCLIF	/IF IT IS, THIS IS A LOGICAL IF STMT

	JMS	SIN540	/ARITHMETIC IF - RESTORE POINTERS

	DZM	CTRLSW	/RE-ENABLE CONTINUATIONS

/

/ARITHMETIC IF STATEMENT WRAP-UP

/

	DZM	LOGIF

	.IFUND	%FPP

	JMS	GTINAC	/GET A TESTABLE RESULT INTO THE AC

	.ENDC

	.IFDEF	%FPP

	.ENDC

	LAC	OSSTM1		/SET UP TRANSFER VECTOR FOR STORING ADRESSES

	DAC	OSSTMP

	JMS	AIKF50		/GET ADRESS 1

	ERS	12X,<SAD S00054>,EX

	JMS	AIKF50		/GET ADDRESS 2

	ERS	13X,<SAD S00054>,EX

	JMS	AIKF50		/GET ADDRESS 3

	.IFDEF	%FPP

	LAC	MODEA2		/IS EXPRESSION INTEGER?

	SNA

	JMP	AIF14		/YES; USE HARDWARE AC

	LAC	JMP.1		/NO; USE FAC OF FPP

	SAD	JMP.2		/ARE FIRST TWO ADDRESSES IDENTICAL

	JMP	AIFR10		/YES USE SHORTCUT METHOD

	SAD	JMP.3		/ARE FIRST AND THIRD ADDRESS SAME?

	JMP	AIFR12		/YES; USE ANOTHER SHORTCUT METHOD

	LAC	FPPSPA		/OUTPUT SKIP ON FAC POSITIVE

	JMS	FPPOUT

	LAC	JMP.1		/MAKE SURE OBJECT CODE LISTING IS RIGHT

	DAC	SYMTBC

	LAC*	SYMTBC

	AND	S17777

	JMS	VECBIN

	LAC	JMP.2		/ARE SECOND AND THIRD ADDRESSES SAME

	SAD	JMP.3

	JMP	AIF13		/YES; OUTPUT SIMPLE JMP

AIFR12	LAC	FPPSNA		/OUTPUT SKIP ON NONZERO FAC

	JMS	FPPOUT

	LAC	JMP.2		/MAKE SURE OBJECT LISTING RIGHT

	DAC	SYMTBC

	LAC*	SYMTBC

	AND	S17777

	JMS	VECBIN

	JMP	AIF13

AIFR10	LAC	FSPANA

	JMP	AIFR12+1

FPPSPA	716602		/BMA

FPPSNA	716601		/BZA

FSPANA	716603		/BLE

AIF14=.

	.ENDC

	LAC	JMP.1	/IS ADDRESS 1 THE SAME AS 2

	SAD	JMP.2	/NO

	JMP	AIF10		/YES

	SAD	JMP.3	/ADDRESS 3? NO

	JMP	AIF12

	LAC	SPACMD		/OUTPUT A SPA INSTRUCTION

	JMS	ABSBIN

	LAC	JMP.1	/SET UP TO LOOK LIKE ADDRESS JUST READ

	JMS	JMPBIN		/OUTPUT FIRST JMP(1)

	LAC	JMP.2	/IS ADDRESS 2 THE SAME AS 3

	SAD	JMP.3	/NO

	JMP	AIF13		/YES

AIF12	LAC	SNACMD		/OUTPUT A SNA INSTRUCTION

	JMS	ABSBIN

	LAC	JMP.2	/SET UP TO OUTPUT JMP (2)

	JMS	JMPBIN

AIF13	LAC	JMP.3	/SET UP TO OUTPUT JMP (3)

	JMS	JMPBIN

	JMP	CRTEST		/TEST FOR CARRIAGE RETURN TERMINATOR

AIF10	LAC	SPASNA		/OUTPUT SPA!SNA COMMAND

	JMP	AIF12+1

	.EJECT

/ LOGICAL IF STATEMENT WRAP-UP

/

LGCLIF	JMS	SIN540	/RESTORE CHAR POINTERS

	DZM	CTRLSW	/RE-ENABLE CONTINUATION CARDS

	LAC	LOGIF	/ARE WE ALREADY IN A LOGICAL IF?

	ERN	09I,SZA,EI	/YES - ERROR

	JMS	GTINAC	/GET A TESTABLE RESULT INTO THE AC

	ISZ	LOGIF	/GENERATE: (EXPRESSION RESULT IN AC)

	LAC	SNACMD

	JMS	ABSBIN	/	SNA

	JMS	EXP550	/	JMP AA  FALSE EXIT

	XOR	JMPCMD	/	.	TRUE  EXIT (STATEMENT)

	DAC	STRNGA	/	.

	CLC		/	AA  NEXT STATEMENT

	DAC	IFFLAG	/SET IFFLAG OFF SO PAREN CHECKS WILL BE VALID

	JMP	CTRL41	/(SEE EX15X ERROR CHECK)

	.EJECT

/ SUBROUTINE TO OUTPUT A BRANCH INSTRUCTION TO A STATEMENT LABEL

/

AIF500	SYN	LOGIF

	JMS	FSNOAV	/THE DEFINED-ONLY STATEMENT NUMBER IS

	JMS	JMPBIN	/FETCHED AND OUTPUT AS A BRANCH

	LAC	XCHAR	/INSTRUCTION.

	JMP*	AIF500

/

/

/ SUBROUTINE TO GET A STATEMENT LABEL

/STORES IN JMP.1 TO JMP.3 THE THREE LABELS FOR A ARITHMETIC IF

/THE QUANTITIES STORED ARE NOT THE TAGS BUT THE ADDRESSES OF THE

/TAGS IN THE SYMBOL TABLE.

/

OSSTM1	DAC	JMP.1		/INSTRUCTION TO STORE IN JUMP TABLE

JMP.1	0

JMP.2	0

JMP.3	0

/

AIKF50	CAL	0

	JMS	FSNOAV		/FETCH DEFINED ONLY STATEMENT LABEL

OSSTMP	XX			/STORE IT IN THE JUMP TABLE

	ISZ	OSSTMP

	LAC	XCHAR		/LEAVE WITH OPERATOR IN AC

	JMP*	AIKF50

/

/

/ SUBROUTINE TO FETCH DEFINED-ONLY STATEMENT NUMBER

/

FDFSNO	SYN	FPCNT

	JMS	FETSNO	/THE CALLING PROGRAM REQUIRES THAT A

	ERN	05N,SPA,EN	/DEFINED STATEMENT NUMBER BE PRESENT

	JMS	CKDFSN	/CHECK THAT STMT NO IS DEFINED

	LAC	SYMTBC	/THE SYMTAB ADDRESS IS RETURNED TO THE

	JMP*	FDFSNO	/CALLING PROGRAM

	.EJECT

/ SUBROUTINE TO CHECK  HAT STMT NUMBER IS DEFINED

/

CKDFSN	CAL	0	/SUBROUTINE TO CHECK THAT ST. NO. IS DEFINED

	AND	S60000	/ENTER WITH SYMBOL TABLE WORD 1 IN AC

	XCT	PASS	/RETURN IF THIS IS PASS 1 OR IF THE MODE

	SAD	S60000	/BITS OF THE SYMBOL ARE NOT 60000 (UNDEF. ST. NO.)

	JMP*	CKDFSN

	ERX	03N,EN	/ERROR: UNDEFINED STMT NO. ON PASS 2

/

/ SUBROUTINE TO FETCH DEFINED STMT NUMBER OR ASSIGNED GOTO VARIABLE

/

FSNOAV	CAL	0	/SUBROUTINE TO FETCH DEFINED STMT NO. OR ASS. VAR.

	JMS	FETSNO

	SPA		/STATEMENT NUMBER?

	JMP	FSOOPS	/NO

	JMS	CKDFSN	/CHECK DEFINITION

	LAC	SYMTBC

	JMP*	FSNOAV	/RETURN WITH SYMTAB POINTER IN AC

FSOOPS	JMS	FIARGO	/FETCH SIMPLE INTEGER

	JMS	VARTST	/VARIABLE

	LAC	SYMTBC

	XOR	W00000	/RETURN WITH SYMTAB POINTER IN AC

	JMP*	FSNOAV	/AND SIGN BIT ON

	.TITLE	FUNCTION AND SUBROUTINE STATEMENT PROCESSORS

/ STATEMENT FUNCTION STATEMENT PROCESSOR

/

STAFCN	LAC	SORDER	/STATEMENT FUNCTIONS MUST PRECEDE EXECUTABLE CODE

	ERN	16I,<SAD V40000>,EI	/WHICH HAS A STMT ORDER OF SEVEN.

	LAC	V00000	/STATEMENT FUNCTIONS HAVE AN IMPLIED

	DAC	TORDER	/STATEMENT ORDER OF SIX.

	JMS	EXP550	/STRING A JUMP

	XOR	JMPCMD	/AROUND THE FUNCTION BODY

	DAC	STRNGA	/AND SAVE THE STRING ADDRESS FOR STMT CLEANUP

	XCT	PASS

	JMP	SFCN01	/STATEMENT FUNCTION NAMES CANNOT BE

			/EXPLICITLY TYPED AS EXTERNAL FUNCTIONS

	LAC*	SYMTBC

	AND	S60000

	XOR	PC

	XOR	Y00000	/STATEMENT FUNCTIONS ARE DIFFERENTIATED

	DAC*	SYMTBC	/FROM EXTERNAL FUNCTIONS.

SFCN01	JMS	CTRL70	/STATEMENT FUNCTIONS CANNOT BE LABELED.

			/THE DUMMY ARGUMENTS LISTED ARE VALID ONLY

	JMS	SUBR60	/FOR THIS STATEMENT AND MAY DUPLICATE

	ISZ	TSMTBN	/PREVIOUSLY DECLARED NAMES. THE AREA IN

	JMS	SUBR50	/FRONT OF THE SYMBOL TABLE IS USED TO

	LAC	XCHAR	/TEMPORARILY CONTAIN THESE ERASABLE VARIABLES

	ERS	04E,<SAD S00075>,EE	/CHECK FOR = SIGN

	LAC	C00001	/THE PROPER NEXT ENTRY ADDRESS IS RESET

	DAC	IFFLAG	/SO THAT NON-DUMMY VARIABLES IN THE

	DZM	TSMTBN	/EXPRESSION MAY BE ENTERED PERMANENTLY.

	LAC	STAF

	TAD	S03100

	DAC	STAF

	LAC	TSMTBC

	DAC	SUBR40	/SAVE POINTER TO FUNCTION DEFINITION

	JMS	EXPRSN	/THE BODY OF THE FUNCTION IS DECODED AND

	LAC*	SUBR40	/GET THE MODE OF THE FUNCTION

	AND	S60000	/FROM ITS SYMBOL TABLE ENTRY

	JMS	EXP740

	LAC	SUBR40	/AFTER CONVERTING THE RESULT, GET THE ENTRY

	DAC	SYMTBC	/POINT ADDRESS FROM THE SYMBOL TABLE

	JMS	SYMBIN	/AND GENERATE A RETURN JUMP

	XOR	JMPICM	/THE SUBROUTINE IS CLOSED WHEN THE EXIT

	JMP	STEXIT	/INSTRUCTION IS OUTPUT.

STAF	0		/STATEMENT FUNCTION TEMPORARY STORAGE SUFFIX

S03100	3100		/A--

	.EJECT

/ T FUNCTION STATEMENT PROCESSOR

/

TFUNCT	LAC	SORDER	/WE CAME HERE FROM THE TYPE STMT PROCESSOR

	ERN	17I,SZA,EI	/ERROR: FUNCTION STMT NOT FIRST IN PROGRAM

/

/

/ SUBROUTINE/FUNCTION STATEMENT PROCESSOR

/

FUNCTI	LAC	S20000	/A FUNCTION IS DIFFERENTIATED FROM A

SUBROU	XOR	JMPICM	/SUBROUTINE IN THAT A FUNCTION MUST RETURN

	DAC	FCNFLG	/A VALUE IN THE ACCUMULATOR TO THE CALLING

	DZM	TORDER

	LAC	PASS2	/PUT A NOP INTO ENTFLG SO SUBR50

	DAC	ENTFLG	/WILL KNOW THIS IS SUBROU OR FUNCTI

	JMS	FVARGO	/PROGRAM. THE SUBPROGRAM NAME IS FETCHED

	XCT	PASS

	JMP	FUN002		/MODE SET IF PASS 2

	LAC	MODE

	SPA		/THE MODE-TYPE IS EXPLICITLY SET WHEN

FUN002	LAC*	SYMTBC		/THIS IS A T FUNCTION STATEMENT

	AND	S77777	/THE NAME IS ENTERED AS A SIMPLE VARIABLE

	DAC*	SYMTBC	/WITH THE USE FLAG RESET.

	XCT	PASS	/**060** CHECK FOR UNDEFINED FUNCTION ON PASS 2

	SKP		/**060** IT'S PASS 2

	JMP	FUN003		/**060** NO CHECK

	AND	S17777	/**060** ONLY NEED ADDRESS BITS

	SAD	S17777	/**060**IF ADDRESS EQUALS 17777, FUNCTION IS

	SKP		/**060**NOT DEFINED

	JMP	FUN003	/**060**

	LAC	FCNFLG	/**060** TEST IF SUBROUTINE OR FUNCTION, IF FUNCTION

	ERS	10E,<SAD JMPICM>,EE	/**060** THEN ERROR

FUN003=.		/**060** NO ERROR CONTINUE

	LAC	MODE

	CMA

	AND	W00000	/IF THE FUNCTION WAS EXPLICITLY TYPED

	DAC*	SYMTW6	/SET THE "EXPLICITLY TYPED" BIT ON

	JMS	SUBR40	/COMPILE THE CODE FOR THE STATEMENT

	LAC	FNCMNE	/DEFINE THE QUANTITY ".EX" AS THE

	JMS	EXP580	/ADDRESS OF THE RETURN CODE FOR THE SUBROUTINE

	JMP	.+1	/FANCY, FANCY!

	LAC	SYMTBC	/SAVE THE SYMBOL TABLE POINTER SO THAT THE

	DAC	FCNRET	/"END" STATEMENT PROCESSOR CAN DEFINE .EX

	ISZ	TORDER	/ONLY ONE SUBR,FUNCT OR BLOCKDATA IS ALLOWED

	JMP	CRTEST

	.EJECT

ENTRY	LAC	FCNFLG	/AN ENTRY STATEMENT IS ONLY LEGAL

	AND	Z40000	/INSIDE A SUBROUTINE OR FUNCTION

	ERS	03E,<SAD JMPCMD>,EE

	JMS	EXP550	/GENERATE A JUMP AROUND

	XOR	JMPCMD	/THIS STATEMENT

	DAC	STRNGA	/SAVE STRING ADDRESS FOR STATEMENT CLEANUP RTN

	JMS	FVARGO	/GET ENTRY NAME

	LAC	NAME1

	ERN	02E,SZA,EE	/ENTRY NAME MUST BE UNIQUE

	LAC	PASS1	/PUT A SKP INTO ENTFLG, SO SUBR50 WILL

	DAC	ENTFLG	/KNOW ITS AN ENTRY STATEMENT.

	LAC	PC

	DAC*	SYMTBC	/STORE ENTRY ADDRESS AWAY TEMPORARILY

	JMS	SUBR40	/COMPILE THE CODE FOR THE ENTRY

	LAC	TSMTBC

	DAC	SYMTBC	/RESTORE SYMTBC FOR LISTING

	JMS	SYMBIN	/GENERATE		LAC	ENTRYNAME

	XOR	LACCMD	/			DAC	SUBROUTINENAME

	LAC	S17777

	DAC*	SYMTBC	/SET ENTRY POINT UNDEFINED FOR UNIQUENESS TEST

	LAC	DACCMD	/OUTPUT A "DAC 0" SINCE SUBROUTINE ENTRY IS

	JMS	RELBIN	/AT 0 (RELOCATABLE)

	JMP	CRTEST

	.EJECT

/ SUBROUTINE TO OUTPUT CODE FOR "FUNCTION","SUBROUTINE", AND "ENTRY" STMTS

/

SUBR40	CAL	0

	JMS	OSYMBL	/PUT OUT THE NAME

	LAC	PC	/AS A GLOBAL AND DEFINE IT

	JMS	BINOUT	/WITH THE CURRENT LOCATION COUNTER

	XOR	C00010

	JMS	SUBR60	/GENERATE THE SUBROUTINE ENTRY CODE

	LAC	OPVALU	/ANY ARGUMENTS?

	SAD	C00028

	JMS	SUBR50	/YES - COLLECT THEM

	JMP*	SUBR40

/

/

/

/ SUBROUTINE TO GENERATE A SUBROUTINE ENTRY

/

SUBR60	SYN	FLOATF

	DZM	STRNGB

	JMS	TSETAD	/THE SYMBOL TABLE POINTERS ARE PRESERVED

	LAC	PC	/THE SUBROUTINE ENTRY POINT IS OUTPUT AS

	JMS	VECBIN	/A SELF-REFERENCING TRANSFER VECTOR.

	LAC	OPVALU

	SAD	C00028	/A SUBROUTINE SUBPROGRAM MAY BE WRITTEN

	JMP	SUBR51	/WITHOUT AN ARGUMENT LIST.

	LAC	FCNFLG

	ERS	05E,<SAD JMPICM>,EE	/ARG LIST NOT INDICATED

	JMP*	SUBR60

SUBR51	LAC	GETARG

	JMS	EXP580	/ THE SUBROUTINE ENTRY CODE IS...

	XOR	JMSCMD

	JMS	EXP550	/	ENTRY	.DSA	ENTRY

	XOR	JMPCMD	/		JMS*	.G	GET ARGUMENTS

	DAC	STRNGB	/		JMP	A(N)+1

	JMP*	SUBR60

	.EJECT

/ SUBROUTINE TO FETCH DUMMY ARGUMENTS

/

SUBR50	SYN	RWFLAG

SUBR55	JMS	FVARGO	/	.	.	.

	LAC	NAME1

	SNA		/IS ARGUMENT NAME UNIQUE?

	JMP	SUBR52	/YES - GO OUTPUT POINTER

	LAC*	SYMTBC	/THERE ARE FOUR POSSIBILITIES HERE -

	AND	S17777	/1) THE VARIABLE HAS BEEN TYPED BUT NOT USED

	SAD	S17777	/2) THE VARIABLE IS DEFINED AS THE CURRENT LOCATION

	JMP	SUBR52	/ (I.E. WE ARE IN PASS2)

	SAD	PC	/TSMTBC ADDRESS THE ENTRY, FUNC, OR SUBR NAME

	JMP	SUBR52	/SYMTAB ENTRY.  IN PASS 1 MUST GET NEG RESULT

	CMA		/AT THIS STAGE AS (3) THE VAR. WAS PREVIOUSLY

	TAD*	TSMTBC	/DEFINED AS DUMMY.  AT END OF PASS1, DUMMY ARRAYS

	SMA		/ARE REDEFINED AT END OF PROGRAM.  CHECK 3 STILL

	JMP	SUBRYY

	XCT	PASS

	XCT	ENTFLG	/POSITIVE RESULT OF CMA; TAD* TSMTBC IS OK.

	JMP	SUBRYY	/ JMPS IF PASS1 OR IF NOT ENTRY

	LAC*	SYMTBC

	SPA!CLA		/POSITIVE IF NOT ARRAY; IF IS ARRAY

SUBRYY	LAC*	SYMTBC	/CHECK IF IS DUMMY

	AND	V00000

	ERS	14V,<SAD V00000>,EV

	LAC*	SYMTBC	/IF THE ARGUMENT WAS VALIDLY PREVIOUSLY DEFINED

	AND	S17777	/THEN OUTPUT A POINTER TO THE PREVIOUS

	XOR	W00000	/DEFINITION WITH THE SIGN BIT ON

	JMS	VECBIN

	JMP	SUBR53	/REJOIN OTHER CODE

SUBR52	LAC	TSMTBN

	SZA

	JMP	.+3	/STATEMENT FUNCTION.

	XCT	PASS

	JMP	SUBR56

	LAC*	SYMTBC	/ALL ARGS IN THE LIST ARE TYPED AS

	AND	W77777

	XOR	V00000	/DUMMY VARIABLES AND ASSIGNED THE VALUE OF

	DAC*	SYMTBC	/THE CURRENT LOCATION COUNTER.

SUBR56	JMS	DEFNSM

	XOR	PC

	JMS	VECBIN	/THE ARGUMENT LIST IS OUTPUT AS A LIST OF

SUBR53	LAC	OPVALU	/SELF-REFERENCING TRANSFER VECTORS.

	SAD	C00031		/ARGUMENT LIST TERMINATED BY

	JMP	SUBR54		/CLOSE PARENTHESIS

	ERS	03S,<SAD C00030>,ES  /ONLY OTHER LEGAL CHAR IS ,

	JMP	SUBR55

SUBR54	LAC	STRNGB	/STRING JUMP ROUND

	JMS	STRING	/ARGUMENT LIST

	JMS	FNBCHR

	JMP*	SUBR50

	.EJECT

/ BLOCK DATA STATEMENT PROCESSOR

/

BLOCKD	LAC	K00001	/THE SUBPROGRAM FLAG IS SET TO INDICATE

	DAC	FCNFLG	/A BLOCK DATA SUBPROGRAM.

	LAC	LOWRAD	/THE BLOCK DATA DECLARATION IS OUTPUT AS

	JMS	BINOUT	/THE CUMULATIVE SIZE OF THE DECLARED

	XOR	C00011	/COMMON BLOCKS

	ISZ	TORDER	/ONLY ONE SUBR,FUNCT, OR BLOCKDATA ALLOWED IN A PGM

	XCT	PASS	/IF WE ARE IN PASS 2,

	JMS	CLENUP	/OUTPUT COMMON DEFINITIONS NOW.

	JMP	CONTIN	/FROM BEING ACCEPTED.

	.EJECT

/ RETURN STATEMENT PROCESSOR

/

RETURN	LAC	FCNRET	/A "RETURN" STATEMENT IS ONLY LEGAL

	ERN	10I,SNA,EI	/IF WE ARE IN A SUBROUTINE OR FUNCTION

	JMS	FNBCHR	/LOOK A CHARACTER AHEAD

	DZM	UNFNBC

	SAD	C00013	/IS THE CHARACTER A CARRIAGE RETURN?

	JMP	RETRNX	/YES - NORMAL SUBROUTINE RETURN

MRETRN	JMS	FVARGO	/MULTIPLE RETURN - GET THE RETURN TARGET

	DZM	UNFNBC

	LAC*	SYMTBC

	AND	Z60000	/MAKE SURE THAT IT IS A SIMPLE INTEGER ARGUMENT

	ERS	26I,<SAD V00000>,EI	/ERROR: ILLEGAL RETURN ADDRESS

	JMS	SYMBIN	/GENERATE		LAC*	ARGUMENT

	XOR	LACICM	/			DAC	SUBROUTINENAME

	LAC	DACCMD	/		FOLLOWED BY A NORMAL RETURN SEQUENCE

	JMS	RELBIN

RETRNX	LAC	FCNRET	/GENERATE A JUMP

	JMS	JMPBIN	/TO THE COMMON RETURN CODE AT THE END OF THE PGM

	JMP	CONTIN

	.EJECT

/ CALL STATEMENT PROCESSOR

/

CALL	JMS	FA2NOP	/THE NAME OF THE SUBROUTINE BEING CALLED

	JMS	VARTST	/IS FETCHED AND ENTERED INTO THE ARG(I);

	LAC*	SYMTBC	/OP(I) LISTS

	AND	Z00000

	SAD	U00000		/IS THE NAME A FUNCTION?

	JMP	CALL03

	SAD	V00000		/IS THE NAME A DUMMY ARG?

	JMP	CALL01

	LAC	NAME1		/CHECK FOR REDEFINITION OF AN

	ERN	06E,SZA,EE	/EXISTING VARIABLE

CALL02	LAC*	SYMTBC

	AND	S77777

	XOR	U00000	/THE NAME IS TYPED AS A FUNCTION NAME IF

	DAC*	SYMTBC	/THIS IS ITS FIRST APPEARANCE.

CALL03	LAC	OPVALU

	SAD	C00028	/A SUBROUTINE MAY BE CALLED WITH OR

	JMP	CALL06	/WITHOUT SPECIFYING A PARAMETER LIST.

	JMS	SYMBIN	/A SIMPLE  "JMS* SUBR" IS GENERATED WHEN

	XOR	JMSICM	/NO PARAMETER LIST IS SPECIFIED

	JMP	CRTEST	/THE EXPRESSION DECODING ROUTINE IS USED

CALL06	LAC	CALL05	/TO GENERATE THE SUBROUTINE CALL WITH

	DAC	EXPRSN	/FORMAL PARAMETERS.

	JMP	EXP011

CALL05	.DSA	CRTEST

CALL01	LAC	U00000

	XOR*	SYMTW2

	DAC*	SYMTW2

	JMP	CALL02

JMSICM	JMS*	0

	.TITLE	END STATEMENT PROCESSOR

/

END	LAC	K00001

	DAC	PROCAD	/SET UP PROCAD FOR ERROR ROUTINE

	JMS	CTRL70	/END STATEMENTS CANNOT BE LABELED

	LAC	FCNFLG

	SAD	K00001

	JMP	ENDBLK	/BLOCK DATA SUBPROGRAM

	SNA		/MAIN PROGRAM?

	JMP	END04	/YES

	LAC	PC	/NO - DEFINE ".EX" HERE

	XOR	V00000

	DAC*	FCNRET

	LAC	FCNFLG

	SAD	JMPICM	/IF THIS IS A SUBROUTINE,

	JMP	END02	/OUTPUT A "RETURN"

	LAC	ARG0

	DAC	ARG2

	LAC	SYMTB0

	XOR	T00000

	DAC*	ARG2	/THE FUNCTION SUBPROGRAM EXIT CONSISTS

	JMS	SETA2	/OF A LOAD COMMAND WITH THE FUNCTION NAME

	JMS	EXP590	/AS THE ARGUMENT.

	TAD	C00004	/THIS IS FOLLOWED BY A BRANCH RETURN TO

END02	LAC	JMPICM	/THE CALLING PROGRAM (INDIRECT VIA ENTRY).

	JMS	RELBIN

	JMP	ENDSP1

END04	LAC	CLACMD	/GENERATE A "STOP 0" AT THE END

	JMS	ABSBIN	/OF A MAIN PROGRAM

	LAC	STMNE	/TO PREVENT USERS FROM KILLING THEMSELVES

	JMS	EXP580	/BY STUPIDITY

	XOR	JMPCMD

	LAC	PC

	DAC	START	/SET THE STARTING ADDRESS HERE FOR A MAIN PROGRAM

	.IFDEF	%FPP

	LAC	T31422		/OUTPUT A CALL TO .ZB

	JMS	EXP580

	XOR	JMSCMD

	.ENDC

	LAC	FNCMNE+1	/IS OUTPUT IF THIS

	JMS	EXP580		/IS A MAIN-BODY

	XOR	JMSCMD		/PROGRAM CONTAINING I-O STATEMENTS

	LAC	JMPCMD	/A JUMP IS NOW OUTPUT TO THE BEGINNING

	JMS	RELBIN	/OF THE PROGRAM (RELOCATABLE LOCATION 0)

ENDSP1	JMS	CLENUP		/ASSIGN VARIABLE STORAGE NOW

	LAC	CONTB0

	DAC	TCTR

END09	SAD	CONTBN

	JMP	END13

	LAC*	TCTR		/DECLARED AND CREATED CONSTANTS ARE

	AND	Z60000	/ASSIGNED MEMORY LOCATIONS IMMEDIATELY

	XOR	PC		/FOLLOWING THE PROGRAM BODY.

	DAC*	TCTR

	RAL		/CHECK FOR THE SPECIAL CONSTANT

	SPA!RAR		/GENERATED BY THE @N CONSTRUCTION

	JMP	RELCON	/AND OUTPUT THEM AS RELOCATABLE CONSTANTS

	JMS	SETN		/THE CONSTANTS ARE OUTPUT AS THEY ARE

	JMS	TWOCMA	/ASSIGNED.

	DAC	TEMP0

END10	JMS	CNSE50

	LAC*	TCTR

	JMS	FPPOUT

	ISZ	TEMP0

	JMP	END10

END11	JMS	CNSE50

	JMP	END09

RELCON	JMS	CNSE50

	LAC*	TCTR	/LOW ORDER WORD IS ADDRESS

	DAC	SYMTBC	/OF SYMBOL TABLE ENTRY FOR STATEMENT NUMBER

	LAC*	SYMTBC	/FROM THAT ENTRY WE GET THE ADDRESS

	AND	S17777

	JMS	VECBIN

	JMP	END11

END13	LAC	DOTABA

	ERS	04L,<SAD .FFREE>,EL	/ERROR: BACKWARD DO LOOP

	JMP	PASS

ENDBLK	XCT	PASS

	SKP

	JMS	CLENUP	/CLEAN UP ON PASS 1 ONLY

PASS	SKP

	JMP	END12		/ END OF COMPILATION

/

/ PASS 2 INITIALIZATION

/

	LAC	PASS2		/INITIALIZE...

	DAC	PASS		/  PASS FLAG

	.IFUND	RSX

	CAL+767

	6

	.ENDC

	.IFDEF	RSX

	LAC	(DAT11)	/CLOSE THE INPUT FILE AT END OF PASS1

	JMS	CLOSEL

	.ENDC

	JMS	  SUB990

	.DSA	400000+MESSY4-2

EPS1SW	XX		/DON'T WAIT FOR ^P.

	.IFUND	RSX

	.DSA	100000+MESSY3-2

Z77000	777000

	DAC	CTLPSW

	JMP	.		/WAIT FOR ^P

	.ENDC

	.IFDEF	RSX

CNTPLP	CAL	WRCP	/WRITE ^P ON TTY

	CAL	WFEVA	/WAIT FOR EVENT VARIABLE

	CAL	REACP	/READ A LINE

	CAL	WFEVA	/WAIT FOR EVENT VARIABLE

	LAC	EVA	/PICK UP THE EVENT VARIABLE

	SPA

	JMP	EXITF	/BAD EVENT VARIABLE EXIT

	LAC	SINBFH+2	/PICK UP THE FIRST WORD

	AND	(774000)	/MASK OFF THE FIRST CHARACTER

	SAD	(100000)	/IS IT ^P?

	JMP	INIT01	/YES RESTART

	SAD	(104000)	/IS IT ^Q?

	JMP	EXITF	/YES EXIT

	JMP	CNTPLP	/NEITHER TRY AGAIN

/

WRCP	2700	/WRITE ^P

	EVA	/EVENT VARIABLE ADDRESS

	DAT3	/LUN

	2	/DATA MODE

	MESSY3-2	/LINE BUFFER ADDRESS

/

REACP	2600	/READ FROM TTY

	EVA	/EVENT VARIABLE ADDRESS

	DAT2	/LUN

	2		/MODE

	SINBFH	/BUFFER ADDRESS

	5	/MAX WORD COUNT

/

	.ENDC

	.EJECT

/ END OF COMPILATION

/

END12=.

	LAC	PASS2

	DAC	BINO06

	LAC	SYMTB0

END23	DAC	SYMTBC

	JMS	OBJ500		/INITIALIZE SYMBOL TABLE OUTPUT LINE

	LAC	SYMTBC		/*** END23+1 IS REFERENCED IN INIT01 ***

	SAD	SYMTBN

	JMP	END22

	JMS	SETADR

	JMS	SIN530

	JMS	OSYMBL	/EACH SYMBOL IS OUTPUT AS AN INTERNAL

	LAC*	SYMTBC	/SYMBOL FOR DDT. THE USER MUST MAINTAIN

	AND	S17777	/SOME DISCRETION WHEN IT COMES TO THE USE

	SAD	S17777	/OF SYMBOLS WHICH THE COMPILER DOES NOT

	SKP		/DEFINE (BECAUSE THEY ARE NOT REFERENCED)

	JMS	BINOUT

	XOR	C00019

	LAW	-1

	SAD*	SYMTBC

	JMP	.+5

	JMS	SYMTYP	/THE SYMBOL TABLE IS PRINTED WITH FOUR

	XOR	U00000	/SYMBOLS AND THEIR DEFINITIONS PER LINE.

	LAC	K00010

	TAD	K00006	/COMMON SECTIONS ARE INDICATED BY A SLASH,

	TAD	C00048	/EXTERNAL NAMES AND STATEMENT FUNCTIONS

	JMS	OBJ510	/BY AN ASTERISK BEFORE

	JMS	OBJ630	/THE SYMBOL AND ITS DEFINITION.

	JMS	OBJ550

	JMS	OBJ630

	LAC*	SYMTBC

	AND	Z00000

	SAD	Y00000

	JMP	END50

	LAC*	SYMTBC

	SPA

	LAC*	SYMTW7

	SKP

END50	LAC*	SYMTBC

	JMS	OBJ640	/FORMAT SYMBOL DEFINITION.

	JMS	OBJ630	/FORMAT A SPACE

SYMMAP	SKP

	JMS	OBJ520		/OUTPUT SYMBOL BUFFER

	JMS	SBSE50

	JMP	END23
END22	LAC	START
	JMS	BINOUT	/OUTPUT END CODE WITH STARTING ADDRESS OF
	XOR	C00023	/PROGRAM UNIT AS THE DATA WORD
	.IFUND	%NOEOC		/(RKB-069) DO WE WANT END OF COMP. MSGS?
	LAC	ERRCNT		/(RKB-067) READY FOR SIZE AND ERRS MSG
	SZA			/(RKB-067) HAVE ANY ERRORS OCCURRED?
	JMP	END24		/(RKB-067) YES
	LAC	(PGMSIZ)	/(RKB-067) NO, JUST TO 'SIZE =' PART
	DAC	SINBUF		/(RKB-067)
	LAW	-5		/(RKB-067) CONVERT 5 CHARS
	DAC	CHRCNT		/(RKB-067)
	LAC	PC		/(RKB-067) CONVERT PC TO ASCII
	JMS	OBJ540		/(RKB-067) CONVERT ROUTINE
	LAW	-5		/(RKB-067)**ARG TO OBJ540
	JMS	SUB990		/(RKB-067) TYPE IT
	.DSA	SIZMSG+400000	/(RKB-067) SUPRESS IF IN BOSS
	LAC	.-1		/(RKB-067) AND FORWARD MSG TO PRINTER
	JMP	END25		/(RKB-067) GO
END24	LAC	(ERRMSG+2)	/(RKB-067) DO ERROR COUNT MSG
	JMS	SUB980		/(RKB-067) CONVERT ERROR COUNT TO DECIMAL
	LAC	ERRCNT		/(RKB-067) **ARG TO SUB980
	JMS	SUB990		/(RKB-067) OK, TYPE IT
	.DSA	ERRMSG+400000	/(RKB-067) SUPRESS IF BOSS
	LAC	.-1		/(RKB-067) GET MSG ADDR FOR PRINTING
END25	AND	S77777		/(RKB-067) STUFF RIGHT MSG ADDR IN PRINT CALL
	DAC	END26		/(RKB-067) WITHOUT SUPPRESS BIT
	.IFUND	RSX		/(RKB-067)
	LAC	S02766		/(RKB-267) SET OUTPUT TO .DAT -12
	.ENDC			/(RKB-067)
	.IFDEF	RSX		/(RKB-067)
	LAC	(DAT12)		/(RKB-067) SET OUTPUT TO LUN16
	.ENDC			/(RKB-067)
	XCT	LIST		/(RKB-067) SKIP IF LISTING DEVICE IS NOT TTY.
	JMP	F4K		/(RKB-067)
	DAC	S990CL		/(RKB-067) STUFF UNIT IN I/O.
	JMS	SUB990		/(RKB-067) PRINT IT
END26	.DSA	.-.		/(RKB-067)
	.ENDC			/(RKB-069)
F4K	XX
	JMP	.+3
	JMS	SUB990
	.DSA	MESSY2-2
	.IFUND	RSX
	.WAIT	-3
/      .CLOSE -11		/NOW IS THE TIME TO CLOSE ALL FILES
	CAL	00767
	.DSA	000006
/      .CLOSE -12
	XCT	LIST
	JMP .+3
	CAL	00766
	.DSA	000006
/      .CL0SE -13
	LAC	OBINRY	/WAS BINARY
	SMA		/OPENED?
	JMP	NJOPND	/NO
	XCT	OBINRY	/DID WE GET AN ERROR?
	JMP	COMPER	/YES
	CAL	00765	/NO-CLOSE FILE
	6
	JMP	NJOPND
COMPER	CAL	765	/ERROR-KILL FILE
	1
	INIT02
	0
	.ENDC
	.IFDEF	RSX
EXITF	LAC	(DAT11) /CLOSE INPUT LUN
	JMS	CLOSEL
	XCT	LIST	/DON'T CLOSE THE LISTING LUN IF NO LISTING WAS PRINTED
	JMP	.+3
	LAC	(DAT12)
	JMS	CLOSEL	/CLOSE LISTING OUTPUT DEVICE
	LAC	OBINRY	/CHECK IF A BINARY FILE WAS OPEN
	SMA
	JMP	EXITR	/NO - DON'T CLOSE AT ALL
	LAC	(DAT13) /YES - GET BINARY FILE LUN
	XCT	OBINRY	/WERE THERE COMPILATION ERRORS?
	CMA		/YES
	JMS	CLOSEL	/NO
	XCT	DELETE	/SKIP TO DELETE BAD BINARY WHEN  NO ORIGINAL
	JMP	.+3	/BINARY
	XCT	OBINRY	/SKP IF NO ERRORS, AVOID DELETE
	JMS	DELBIN
/
EXITR	LAC	(DAT11)	/DETACH FROM INPUT LUN
	JMS	DETACH
	LAC	(DAT12)	/DETACH FROM LISTING LUN
	JMS	DETACH
	LAC	(DAT13)	/DETACH FROM BINARY FILE
	JMS	DETACH
	LAC	TITLEA	/CHECK THE LAST CHARACTER
	SAD	S00054	/IS IT A ,?
	JMP	INIT02	/YES RESTART
	SAD	C00013	/IS IT A CARRTN?
	CAL	REQTDV	/YES REQUEST TDV
	.ENDC
	.IFUND	RSX
NJOPND	LAC	TITLEA
	SAD	C00013
	JMP	INIT02	/ALLOW BATCH PROCESSING OF SOURCE PROGRAMS.
	.ENDC
	.IFUND	RSX
/      .EXIT
END999	CAL	0
C00013	.DSA	000015
	.ENDC
	.IFDEF	RSX
	CAL	C00008	/EXIT TASK
	.ENDC
PFILE1	.DSA	FILE1
/
	.EOT
