	.TITLE F4
/
/FORTRAN 4 COMPILER 
/
/COPYRIGHT 1969, DIGITAL EQUIPMENT
/CORP., MAYNARD, MASS.
/
/TAPE 1 OF 2
/
/VERSION V8A
/
/11-17-69
/
/PARAMETER ASSIGNMENTS
/	PTP=0 MAKE PAPER TAPE SYSTEM (7 OR 9)
/	BANK=0,1,2,3 PROPER BANK FOR PAPER TAPE
/	%F2=0 MAKE ABBREVIATED VERSION
/	PDP7=0 ASSEMBLE FOR 7 DECTAPE
/        PDP15=0 ASSEMBLE FOR PDP15
/
/        IF PTP,PDP7, AND PDP15 ARE UNDEFINED, ASSEMBLE
/	FOR A PDP-9 DECTAPE SYSTEM
/	IF IMBED DEFINED USE IMBEDDED I/O
/	IF K16 DEFINED MAKE EXPANDED FORTRAN
/
	.ABS
	.IFUND BANK
BANK=0
	.ENDC
BASE1=3465
APTP=0
A%F2=0
B%F2=0
C%F2=0
D%F2=0
APDP7=0
APDP15=0
BPDP15=0
ABF=0
AIMBED=0
%F4I=0
AX4K=0
ADUMY=0
BDUMY=0
AEQUIV=0
AERMSG=0
AASCI=0
AK16=0
	.IFDEF	K16
DUMY=0
	.IFUND	%F2
EQUIV=0
	.ENDC
ERMSG=0
ASCI=0
AK16=-21
	.ENDC
	.IFDEF PTP
APTP=61
	.ENDC
	.IFUND	PTP
	.IFDEF	BF
ABF=141
	.ENDC
	.ENDC
	.IFDEF %F2
A%F2=1322
B%F2=6
C%F2=27
D%F2=-42
	.ENDC
	.IFDEF PDP7
APDP7=-154
	.ENDC
	.IFDEF PDP15
APDP15=-22
BPDP15=1
	.ENDC
	.IFDEF	IMBED
AIMBED=411+D%F2+BPDP15
	.IFDEF	X4K
	.END
	.ENDC
	.IFDEF	PTP
	.END
	.ENDC
	.ENDC
	.IFDEF	X4K
AX4K=-344+C%F2
	.ENDC
	.IFDEF	DUMY
ADUMY=-15
BDUMY=-1
	.ENDC
	.IFDEF	EQUIV
AEQUIV=-22
	.ENDC
	.IFDEF	ERMSG
AERMSG=-174+B%F2+BDUMY
	.ENDC
	.IFDEF	ASCI
AASCI=-16
	.ENDC
AOPS=AX4K+ADUMY+AEQUIV+AERMSG+AASCI+AK16
	.LOC BANK*20000+BASE1+APTP+AIMBED+A%F2+APDP7+APDP15+ABF+AOPS
	.EJECT
/ERROR MACROS
	.IFUND	ERMSG
	.DEFIN	ERN,A,B,C
	B
	JMP	C
	.ENDM
	.DEFIN	ERS,A,B,C
	B
	SKP
	JMP	C
	.ENDM
	.DEFIN	ERR,A,B
	LAW	B
	JMS	ERROR1
	.ENDM
	.ENDC
	.IFDEF	ERMSG
	.DEFIN	ERN,A,B,C
	JMS	ERRORN
	.ASCII	A
	.LOC	.-2
	B
	.LOC	.+1
	.ENDM
	.DEFIN	ERS,A,B,C
	JMS	ERRORS
	.ASCII	A
	.LOC	.-2
	B
	.LOC	.+1
	.ENDM
	.DEFIN	ERR,A,B
	.ASCII	A
	.LOC	.-2
	JMS	ERROR1
	.LOC	.+1
	.ENDM
	.ENDC
	.EJECT
/BANK-BIT INITIALIZATION-OVERLAYED
/
OPR=740000
	.IFDEF	IMBED
BEGIN	LAC	DL155
	DAC	BINBFH
	JMP	INIT02
DL155	15500
SINBFH=.
	.ENDC
	.IFUND	IMBED
BEGIN	LAC N00767
	DAC RSTRT
	LAC* S00100
	.IFUND PTP
	AND S60000	/GET BANK BITS
	.ENDC
	.IFDEF PTP
	CLA
	.ENDC
	DAC BNKBTS
	LAC BNKTAB
	XOR BNKBTS	/PUT INTO TABLE ADDR
	DAC BNKTAB
	LAC MODCT
	DAC BNKCTR
BNKLOP	LAC* BNKTAB
	XOR BNKBTS
	DAC BNKTMP
	LAC* BNKTMP
	XOR BNKBTS
	DAC* BNKTMP
	ISZ BNKTAB
	ISZ BNKCTR
	JMP BNKLOP
/
/ONCE-ONLY INITIALIZATION-OVERLAYED
/
OVRLAY	CAL+775
	1
	INIT02
	0
	.IFDEF	X4K
	LAC*	S00120
	SMA
	JMP	N00767
	AND	S77777
	DAC	CONTB1	/EXTRA 4K USED FOR STORAGE OF CONSTANTS
	AND	S70000
	DAC	BNKBTS
	XOR	S07777
	DAC	ENDINT	/LAST LEGAL ADDRESS
	LAC	S70000
	DAC	MASK
	LAC	ENDIN1
	DAC	SYMTB1	/FIRST REGISTER BELOW F4
	LAC	DL1
	DAC	SBSE51+1
	LAC	DL2
	DAC	CNSE52
	.ENDC
N00767	CAL 767		/.INIT INPUT (-11)
	1
	INIT02
	0
	LAC .-1
	SAD S00377
	JMP .+3		/BULK STORAGE
	LAC DLNOP		/NOT BULK STORAGE
	SKP
	LAC DLJMP
	DAC EPS1SW	/INTO END PASS 1 SWITCH
	LAC DL155
	DAC BINBFH
	LAC DLCR
	DAC SINBFH+44
	LAC ENDINT
	DAC CONTB0
	JMP INIT02

DLNOP	JMS SUB990
DLJMP	JMP INIT01
	.IFDEF	X4K
DL1	JMS	SYMSAF
DL2	JMS	CONSAF	/CHECK FOR BOUNDARY
	.ENDC
DL155	15500
DLCR	64000
BNKTAB	MODF
BNKCTR	0
BNKTMP	0
ENDINT	BEGF4
	.IFDEF	X4K
ENDIN1	SYMSAF-1
S07777	7777
S70000	70000
	.ENDC
/ADDRESS TABLE-OVERLAYED
MODF=.
	OVRLAY+2
	N00767+2
	INIT02+5
	M1BK
	M2BK
	M3BK
	ARG0
	ARGEND
	OP0
	EQCLSX
	AT1
	BASE0
	BASEMX
	BASEJ
	SINBF0
	BINBF0
	.IFUND %F2
	OBJBF0
	.ENDC
	ENDINT
	.IFDEF	X4K
	ENDIN1
	.ENDC
	Z77744-1
	FORMST-1
	TRYBIN-1
	CMDERR+1
	CALL05
	ER1MSY
	X17777-1
	INIT01-1
	.IFDEF PDP15
	END02
	.ENDC
	INIT01+7
	CTRLIM+1
	CTRLIM+2
	CTRLIM+3
	CTRLIM+4
	CTRLIM+5
	CTRLIM+6
	CTRLIM+7
	CTRLIM+10
	CTRLIM+11
	CTRLIM+12
	CTRLIM+13
	CTRLSM+1
	CTRLSM+2
	CTRLSM+3
	CTRLSM+4
	CTRLSM+5
	CTRLSM+6
	CTRLSM+7
	CTRLSM+10
	CTRLSM+11
	CTRLSM+12
	CTRLSM+13

	CTRLNM+1
	CTRLNM+2
	CTRLNM+3
	CTRLNM+4
	CTRLNM+5
	CTRLNM+6
	CTRLNM+7
	CTRLNM+10
	CTRLNM+11
	CTRLNM+12
	CTRLNM+13
	PIDTB0
	PIDTB0+2
	PIDTB0+4
	PIDTB0+6
	PIDTB0+10
	PIDTB0+12
	PIDTB0+14
	.IFUND %F2
	PIDTB0+16
	PIDTB0+20
	.ENDC
	FUNMNE+1
	FUNMNE+3
	FUNMNE+5
	FUNMNE+7
	RETADR
	FMTADR
	FMTADR+2
	FMTADR+4
	.IFUND %F2
	FMTADR+6
	.ENDC
	PAUSAD
	CALLAD
	DATAAD
	STOPAD
	GOTOAD
	IFADDR
	PIDTBX
	ENDFAD
	REALAD
	READAD
	DOADDR
	CTRL90
	CTRL90+1
	CTRL90+2
	CTRL90+3
	CTRL90+4
	SIDTBX
	PASS+7

	PASS+11
	FAOPIM+1
	FAOPIM+2
	FAOPIM+3
	FAOPIM+4
	FAOPIM+5
	FAOPIM+6
	FAOPIM+7
	FAOPIM+10
	FAOPIM+11
	FAOPIM+12
	FAOPUM+1
	FAOPUM+2
	FAOPUM+3
	FAOPUM+4
	FAOPUM+5
	FAOPUM+6
	FAOPUM+7
	FAOPUM+10
	FAOPUM+11
	FAOPUM+12
	FAOPNM+1
	FAOPNM+2
	FAOPNM+3
	FAOPNM+4
	FAOPNM+5
	FAOPNM+6
	FAOPNM+7
	FAOPNM+10
	FAOPNM+11
	FAOPNM+12
	FAOPSM+1
	FAOPSM+2
	FAOPSM+3
	FAOPSM+4
	FAOPSM+5
	FAOPSM+6
	FAOPSM+7
	FAOPSM+10
	FAOPSM+11
	FAOPSM+12

	FAOPLM+1
	FAOPLM+2
	FAOPLM+3
	FAOPLM+4
	FAOPLM+5
	FAOPLM+6
	FAOPLM+7
	FAOPLM+10
	FAOPLM+11
	FAOPLM+12
	NMODE
	.IFUND %F2
	LDRTAB+1
	LDRTAB+2
	LDRTAB+3
	LDRTAB+4
	LDRTAB+5
	LDRTAB+6
	LDRTAB+7
	LDRTAB+10
	LDRTAB+11
	LDRTAB+12
	LDRTAB+13
	LDRTAB+14
	LDRTAB+15
	LDRTAB+16
	LDRTAB+17
	LDRTAB+20
	LDRTAB+21
	LDRTAB+22
	LDRTAB+23
	LDRTAB+24
	LDRTAB+25
	LDRTAB+26
	LDRTAB+27
	.ENDC
	SINPUT+3
	OBINRY+4
	.IFUND %F2
	OBJ521+4
	OBJ545
	OBJ400
	.ENDC
	OPTRAN
	RELOPC
	LOCTAB
	LOCTBM
	CHRTAB
	CHRTBX
MODL=.
MODCT	MODL-MODF\777777+1
	.IFDEF	X4K
/ROUTINES TO HANDLE EXTRA 4K CORE
/
/ROUTINE TO JUMP GAP IN SYMBOL STORAGE
/
SYMSAF	0	/AC CONTAINS PROP. ADDR.
	DAC	TEMSAF
	TAD	C00006	/COMPUTE LAST POSSIBLE ENTRY ADDRESS
	JMS	FORARA	/IS ADDR. IN FORBIDDEN AREA?
	LAC	CONTB1	/YES
	JMP*	SYMSAF	/NO
/COMPUTE WHETHER AC ADDRESS IN FORBIDDEN AREA
FORARA	0
	JMS	TWOCMA
	DAC	TESAF1
	TAD	CONTB1	/ADDR. < CONTB1
	SPA!SNA
	JMP	FORAR1	/NO, OK
	LAC	SYMTB1	/YES,TEST ADDR. > SYMTB1
	TAD	TESAF1
	SMA
FORAR1	ISZ	FORARA	/NO,OK
	LAC	TEMSAF
	JMP*	FORARA
/
/ROUTINE TO JUMP GAP IN CONSTANT STORAGE
/
CONSAF	0	/PROPOSED NEXT ENTRY ADDR. IN AC
	DAC	TEMSAF
	TAD	K00003	/COMPUTE LAST POSSIBLE ENTRY ADDRESS
	JMS	FORARA	/IS THIS ADDRESS IN FORBIDDEN AREA
	LAC	SYMTB1	/YES
	JMP* CONSAF	/NO
TESAF1	0
SYMTB1	0
CONTB1	0
	.BLOCK	240-C%F2
	.ENDC
/
/BUFFER ALLOCATION IN OVERLAY AREA
/
/2ND MINUS FOR WORKING STORAGE
/
SINBFH=.-45
	.ENDC
BINBFH=SINBFH-32-24
	.IFUND %F2
OBJBFH=BINBFH-26-5
TBEG=OBJBFH
	.ENDC
	.IFDEF %F2
TBEG=BINBFH-4
	.ENDC
	.EJECT
/ TABLES WHICH PRECEDE THE COMPILER IN MEMORY
/ DOTAB		         / DO TABLES
/ SYMTAB		         /SYMBOL TABLE
/ CONTAB		         / CONSTANT TABLE
	.IFUND	IMBED
.FFREE   .DSA   102          /START OF DO + SYMTAB
CONTB0	0
	.ENDC
	.IFDEF	IMBED
.FFREE	ENDIMB
CONTB0	BEGF4
	.ENDC
		        /FIRST ADDRESS OF CONSTANT TABLE
CONTBC=ERROR1                 / ADDRESS OF CURRENT ENTRY IN CONTAB
CONTBN=TBEG-1		/ NEXT ENTRY ADDRESS IN CONTAB
SYMTB0=TBEG-2		/ FIRST ADDRESS OF SYMBOL TABLE
SYMTBC	0                 / ADDRESS OF CURRENT ENTRY IN SYMTAB
SYMTBN=TBEG-3		/ NEXT ENTRY ADDRESS IN SYMTAB
SYMTW2=SETA1                 / ADDRESS OF WORD 2 CURRENT ENTRY IN SYMTAB
SYMT2A=SETA2                 /ADDRESS OF WORD2A CURRENT ENTRY IN SYMTAB
SYMTW3=EXP520                / ADDRESS OF WORD 3 CURRENT ENTRY IN SYMTAB
SYMTW4=EXP530                 / ADDRESS OF WORD 4 CURRENT ENTRY IN SYMTAB
SYMTW5=EXP540                 / ADDRESS OF WORD 5 CURRENT ENTRY IN SYMTAB
SYMTW6=EXP600                 / ADDRESS OF WORD 6 CURRENT ENTRY IN SYMTAB
TSMTBC=EXP610                 / TEMP ADDR OF CURRENT ENTRY (W1) IN SYMTAB
TSMTBN=TBEG-4		/ TEMP ADDR OF NEXT ENTRY IN SYMTAB
TSMTW3=EXP620                / TEMP ADDR OF CURRENT ENTRY (W3) IN SYMTAB
TSMTW4=EXP640                 / TEMP ADDR OF CURRENT ENTRY (W4) IN SYMTAB
TRELAD=EXP650                / TEMP RELATIVE ADDRESS
CTLPSW=SUB990+5			/0 IF RESTART, OTHERWISE EOM
/							
EQUSTR=TBEG-5		/AMOUNT OF NON COMMON EQUIVALENCE STORAGE
	.IFUND	IMBED
START=INIT02+6               /ADDRESS OF FIRST EXECUTABLE INSTRUCTION
	.ENDC
	.IFDEF	IMBED
START	0
	.ENDC
LOWRAD=TBEG-6		/BLOCK DATA SIZE (EQU CLASS LOW REL. ADDR)
IFFLAG=INDOTB                /CURRENT STATEMENT IS AN IF STATEMENT
LABEL=TBEG-7		/SYMTAB ADDR OF CURRENT STATEMENT LABEL
LOGIF=AIF500                  /CURRENT STATEMENT IS A LOGICAL IF
MODE=EXP710                 /MODE-TYPE FOR SPECIFICATION STATEMENTS
SORDER=TBEG-10		/ORDER NUMBER OF LAST STATEMENT
TORDER=TBEG-11		/ORDER NUMBER OF CURRENT STATEMENT
PASS1  SKP                   /PASS 1 INDICATOR
PASS2	.DSA 740000	/PASS 2 INDICATOR
PROCAD=TBEG-12		/ADDRESS OF STATEMENT PROCESSING ROUTINE
STRNGA=TBEG-13		/ADDRESS OF INSTRUCTION REQUIRING A STRING
LSTCMD=TBEG-14		/LAST COMMAND GENERATED
TITLEA.DSA   15              / ADDRESS OF CURRENT TITLE IN SYMTAB
CTRLSW=TBEG-21		/IMAGE RECOGNITION ALLOWS NO CONTINUATION
/CTRLSW=5 REGISTERS		/OTS I/O INITIALIZER INDICATOR
FILE=CTRLSW+2       	                 /INPUT FILE NAME
       	                 /(SEEK DIRECTORY)
       .EJECT
/ EXPRESSION DECODE WORKING STORAGE
ARGI=CTRL00                 /ADDRESS OF LAST ENTRY IN ARGUMENT TABLE
ARG1=CTRL50		/ADDRESS OF ARGUMENT 2 IN ARGUMENT TABLE
ARG2=CTRL70                  /ADDRESS OF ARGUMENT 2 IN ARGUMENT TABLE
OPI=CTRL80                 /ADDRESS OF LAST ENTRY IN OPERATOR TABLE
POP=CLEN50                   /ADDRESS OF PREVIOUS OPERATOR IN OP TABLE
NOP=TBEG-22		/ADDRESS OF NEXT OPERATOR IN OP TABLE
ADDRA1=VECTOR                 /ADDRESS OF SYMBOLIC OR CONSTANT ARGUMENTS
ADDRA2=DEFNSM                /(1 OR 2) IN SYMBOL OR CONSTANT TABLE.
TYPEA1=SCNLO                 /TYPE OF ARGUMENT 1
TYPEA2=IODEV                 /TYPE OF ARGUMENT 2
MODEA1=CLEN60		/MODE OF ARGUMENT 1
MODEA2=DEFNP1                 /MODE OF ARGUMENT 2
SIGNA1=NTHSYM                /SIGN OF  ARGUMENT 1
SIGNA2=FARDIM                /SIGN OF ARGUMENT 2
LEVPOP=FEDIMN                /LEVEL OF PREVIOUS OPERATOR
LEVNOP=COMN50                /LEVEL OF NEXT OPERATOR
IDXPOP=CHAIN                 /INDEX ON OP TRANSLATION FOR PREVIOUS OP
IDXNOP=DOCLEN                /INDEX ON OP TRANSLATION FOR NEXT OPERATOR
TSI=FVARGO                   /CURRENT INTEGER/LOGICAL TEMP STORE NAME
TSR=PNZCV                    /CURRENT REAL TEMPORARY STORAGE NAME
TSD=FVORAR                   /CURRENT DOUBLE PRECISION TEMP STORE NAME
TARGI=FMTFCH                 /TEMPORARY ARG(1) INDEX
TOPI=FMTOUT                  /TEMPORARY OP(1) INDEX
TSTRNG=TBEG-23		/TEMPORARY HOLD FOR STRING ADDRESS
RELOPT=CTRL60                /RELATIVE OPERATOR TYPE
DATAFL=TBEG-24		/DATA STMT FLAG
	.IFDEF	IMBED
/IMBED VARIABLES
PC	0
FORMST	0
	.ENDC
       .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
/   1  REAL
/   2  DOUBLE PRECESION
/   3  LOGICAL
/							
/ 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         03  03       .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.
/	    12  14         06  06       -
/	    15  17         06  06       +
/	    18  22         07  07       /
/	    21  25         07  07       *
/	    26  32         08  10       **
/	    24  30         09 11        UNARY NEGATION
/	    28  34         10  12       (F
/	    29  35         00  00       (S
/	    30  36         00  00       ,
/           32  40         00  00       )F
/	    33  41         00  00       )S
/							
ARG0   .DSA   ARG0+1
	.IFUND	DUMY
       .REPT 17
	-1
	.ENDC
	.IFDEF	DUMY
	.REPT	31
	-1
	.ENDC
ARGEND	.DSA	ARGEND		/ARG.-OP. OVFLW. ADD.
/ EQUIVALENCE CLASS STORAGE (ARG(I) LIST NOT USED DURING EQUIVALENCE
/ PROCESSING).
FSTVAR=TBEG-25		/INDICATES FIRST CLASS MEMBER
LSTVAR=TBEG-26		/ADDRESS OF THE LAST VARIABLES LINKAGE WORD
HEDCLS=TBEG-27		/ADDRESS OF HEAD MEMBER OF CLASS
COMCLS=TBEG-30		/INDICATES A COMMON BLOCK IS THE CLASS
OLDCLS=TBEG-31		/INDICATES THE MERGE OF TWO CLASSES
SUBVAL=TBEG-32		/RELATIVE ADDRESS WITH RESPECT TO ONE
SUBADJ=TBEG-33		/ADDRESS LINE-UP ADJUSTMENT FACTOR
DIFF=TBEG-34		/DIFFERENCE BETWEEN ONE VARIABLES ASSIGNED
/		         /  RELATIVE ADDRESSES (TWO CLASSES)
RELADR=TBEG-35		/RELATIVE ADDRESS WITH RESPECT TO THE HEAD
/		         /  OF THE CLASSES ADDRESS.
EQUCLS=TBEG-36		/ADDRESS OF LAST ENTRY IN EQUIVALENCE
/		         /  CLASS LIST
OP0    .DSA   OP0+1          /OP(I) AND EQUIVALENCE CLASS LIST START
       .REPT 31
	-1
EQCLSX .DSA   EQCLSX         /EQUIVALENCE CLASS LIST OVERFLOW ADDRESS
       .EJECT
/ READ, WRITE , FORMAT, AND DO WORKING STORAGE
/							
RWFND=FDFSNO
RWTST=SUBR60
RWEND=SUBR50
RWFLAG=RWFND
PARLHI=EXPRSN
TRW1=TBEG-37
TRW2=TBEG-40
TRW3=TBEG-41
DOI=EXP625
DOM1=EXP720
DOM2=TBEG-42
DOM3=EXP740
FPCNT=RWFND
FLOATF=RWTST
NUMFLG=PARLHI
HFLG=DOI
FMTCNT=DOM1
FMS=DOM2
FLS=DOM3
       .EJECT
/ ARRAY DECLARATION SUBSCRIPT STORAGE
TI=TRW1 		     /ADDRESS OF I-TH SUBSCRIPT
T0=BASE+1                   /NUMBER OF MACHINE WORDS PER ELEMENT
T1=BASE+2                   /FIRST SUBSCRIPT
T2=BASE+3                   /SECOND SUBSCRIPT
T3=BASE+4                   /THIRD SUBSCRIPT
ATX=BASEMX                  /SUBSCRIPT OVER-RUN CATCHER
SSCTR=OSYMBL                 /SPECIFIED SUBSCRIPT COUNTER
AT1    .DSA   T1	     /ADDRESS OF FIRST SUBSCRIPT
       .EJECT
/ FETCH ARGUMENT/OPERATOR-DELIMETER PAIR WORKING STORAGE
ARG=NUMCHK                   /ARGUMENT DESCRIPTION WORD
OP=FMTPAK                    /OPERATOR DESCRIPTION WORD
OPVALU=FMTFIL               /OPERATOR VALUE
SIGN=NUMTST                   /ARGUMENT SIGN
CHRCTR=DSHL                   /CONCATENATION CHARACTER COUNTER
TFAO01=TBEG-43		/LAST DELIMETER PROCESSED
TFAO03=OUTSSC                /DIGIT COUNT FOR NUMERIC PROCESSING
TFAO04=INAOPI                /ARGUMENT CONVERSION COMPLETE (ADJ.10 EXP)
TFAO05=FAO590               /EXPONENT SIGN
TFAO06=TBEG-44		/LOGIC OP MODE ENTRY FLAG (MODE)
FAOMOD=OPOPA2                /CURRENT PROCESSING MODE
NAME0=TBEG-45		/ARGUMENT MODE
NAME1=RSVDTP                  /FIRST HALF CONCATENATED SYMBOL
NAME2=TSTDTP                 /SECOND HALF CONCATENATED SYMBOL
S=EXP550			/NUMBER CONVERSION
MS=EXP560                    /NUMBER CONVERSION
LS=EXP570                    /NUMBER CONVERSION
TMS=EXP580                   /NUMERIC CONVERSION
TLS=EXP590                    /NUMERIC CONVERSION
TCTR=INFAOP                  /TEMPORARY COUNTER
TEMP0=FTC500                 /TEMPORARY ADDRESS HOLD
SHFCTR=TWOCMA                /SHIFT COUNTER
/
/ SUBPROGRAM WORKING STORAGE
/
FCNFLG=TBEG-46		/SUBPROGRAM FLAG
FCNRET=TBEG-47		/SYMBOL TABLE ADDRESS OF FUNCTION RETURN
XITCMD=TBEG-50		/SUBPROGRAM EXIT COMMAND
TXITCM=TBEG-51
ARGCTR=EXP700                /DUMMY ARGUMENT COUNTER
SUBRN0=TBEG-52	/SUBPROGRAM NAME REFERENCED INDICATOR
STRNGB=TBEG-53		/ADDRESS OF BRANCH AROUND PARAMETERS
STRNGC=TBEG-54		/ADDRESS OF SUBPROGRAM BRANCH
/
/FILE NAME STORAGE
/
FILFLG=TBEG-55
FILE1	0		/FIRST HALF OF PROGRAM NAME SYMBOL
FILE2	0		/SECOND HALF OF PROGRAM NAME SYMBOL
       .EJECT
/ 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 5
BASE   -1 	     /TABLE
BASEMX .DSA   BASEMX	     /END OF TABLE
BASEJ  .DSA   BASE0	     /ADDRESS OF CURRENT LEVEL COUNTER
/
/DO TABLE POINTERS
DOTABA=TBEG-56		/TERMINAL STATEMENT NUMBER
DOTABB=TBEG-57		/FIRST STRING ADDRESS
DOTABC=TBEG-60		/SECOND STRING ADDRESS
DOTABX=TBEG-61		/END ADDRESSES
       .EJECT
/ SOURCE IMAGE INPUT (OUTPUT) BUFFER AND ASSOCIATED WORKING STORAGE
/
/BUFFER IN OVERLAY AREA
/
CHRBUF=SINBFH-1		/CHARACTER BUFFER
CHRBF1=SINBFH-2		/ (CONTAINS FIVE CHARACTERS)
SINBUF=SINBFH-3		/ADDRESS OF NEXT 5 CHARACTERS
CHRCNT=SINBFH-4		/CHARACTER COUNTER (WITHIN CHARACTER BUFF)
COL=SINBFH-5		/COLUMN COUNTER
CHAR=SINBFH-6		/CURRENT CHARACTER (INTERNAL CODE)
XCHAR=SINBFH-7		/CURRENT CHARACTER (ASCII CODE)
CHRTYP=SINBFH-10		/CURRENT CHARACTER (TYPE CODE)
LEVEL=SINBFH-11		/CURRENT CHARACTER (HEIRARCHY LEVEL IF OP)
LSTCHR=SINBFH-12		/LAST CHARACTER FETCHED
UNFNBC=SINBFH-13		/USE LAST CHARACTER FETCHED INDICATOR
COL06=SINBFH-14		/CONTENTS OF COLUMN 6 - CONTINUATION FIELD
BITCTR=SINBFH-15		/SHIFT COUNTER FOR POSITIONING CHARACTER
TCHBUF=SINBFH-16		/TEMPORARY CHARACTER BUFFER
TCHBF1=SINBFH-17		/TEMPORARY CHARACTER BUFFER
TSINBF=SINBFH-20		/TEMPORARY ADDRESS OF NEXT 5 CHARACTERS
TCHCNT=SINBFH-21		/TEMPORARY CHARACTER COUNTER
KOL=SINBFH-22		/TEMPORARY COLUMN COUNTER
TCHAR=SINBFH-23		/TEMPORARY CURRENT CHARACTER
	.IFDEF	IMBED
SINBFH=DTIBUF
	.ENDC
SINBF0	.DSA	SINBFH+2
/ BINARY OBJECT CODE OUTPUT BUFFER AND ASSOCIATED WORKING STORAGE
/
/BUFFER IN OVERLAY AREA
/
BINBF0 .DSA  BINBFH+1	/ADDRESS (-1) OF BINARY BUFFER
BINBUF=BINBFH-1		/DATA WORD STORAGE ADDRESS
CODEWD=BINBFH-2		/LOADER CODE WORD STORAGE ADDRESS
WRDCTR=BINBFH-3		/DATA WORD COUNTER
CODCTR=BINBFH-4	/LOADER CODE COUNTER
	.IFUND %F2
/ OBJECT CODE LISTING BUFFER
/
/BUFFER IN OVERLAY AREA
/
OBJB04=OBJBFH+22		/PRINTING BUFFER (ALSO TEMP STORAGE)
OBJB03=OBJBFH+23		/PRINTING BUFFER (ALSO TEMP STORAGE)
OBJB02=OBJBFH+24		/PRINTING BUFFER (ALSO TEMP STORAGE)
OBJB01=OBJBFH+25		/PRINTING BUFFER (ALSO TEMP STORAGE)
OBJBF0 .DSA   OBJBFH+2	     /ADDRESS OF OUTPUT BUFFER
	.ENDC
       .EJECT
/ BATCH PROCESSOR
LIST=TBEG-62
BEGF4=TBEG-63
       .DSA   232203         /.SIXBT /SRC/          /FILE NAME EXTENSIONS
       .DSA   142324         /.SIXBT /LST/
       .DSA   021116         /.SIXBT /BIN/
/      PASS1 INITIALIZATION
/
/
	.IFUND	IMBED
INIT02 LAC    CTLPSW
       SZA
       JMP    INIT01
/      .INIT  -11,IOERR,0,0,0  /INITIALIZE SOURCE INPUT DEVICE
RSTRT	JMP BEGIN		/RESTART ADDRESS INIT. TO CAL 767
       .DSA   000001	     / INITIALIZE CODE
       .DSA   INIT02	     / ERROR RETURN
       .DSA   000000	     / STANDARD BUFFER SIZE (72+ CHARACTERS)
	.ENDC
	.IFDEF	IMBED
INIT02=.
RSTRT	JMS	INITIO
	.ENDC
       JMS    SUB990
M1BK	.DSA MESSY1-2
       JMS    SUB990
M2BK	.DSA MESSY5-2
	.IFUND	IMBED
/      .READ  -2	     / INPUT COMMAND STRING
       CAL    02776
C00008	.DSA 000010
       .DSA   SINBFH
Z77744 .DSA   777744
/      .WAIT  -2
       CAL    00776
C00010	   .DSA	000012
	.ENDC
	.IFDEF	IMBED
	JMS	TTYIN
	.ENDC
       .EJECT
/ PASS 1 INITIALIZATION
/
	LAC CHR1	/INTERNAL FOR CR AND ESC IS 36
	DAC CHARCR
	LAC CHR2
	DAC CHARLT
	.IFDEF	IMBED
	LAC	SIN512
	DAC	SIN507
	DZM	DTSAMS
	.ENDC
       LAC    PASS1	     /INITIALIZE...
       DAC    CLEN01         /PRE-DATA ASSIGNMENT SWITCH
       DAC    PASS	     /	PASS SWITCH
	DZM	SUBRN0
	.IFUND %F2
       DAC    SYMMAP         /  NO SYMBOL MAP
	.ENDC
       LAC    PASS2
	.IFDEF PDP15
	DAC F4K
	.ENDC
	.IFUND %F2
       DAC    OLIST	     /	NO OBJECT LIST
	.ENDC
       DAC    SLIST          /NO SOURCE LIST
	DAC LIST		/NO LISTING DEVICE
	DAC OBINRY	/NO BINARY
	.IFDEF	IMBED
	DAC	DLIST
	.ENDC
	DAC FT2CNG
       LAC    OP0
       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
       JMS    SIN520
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	IMBED
	SAD	CHARU
	ISZ	DTSAMS
	SAD	CHARD
	JMP	CMDD
	.ENDC
	.IFUND %F2
       SAD    CHARO
       JMP    CMDO    / O...OBJECT LIST
       SAD    CHARS
       JMP    CMDS  / S...SYMBOL MAP
	.ENDC
       SAD    ARROW
       JMP   CMDA        /_...END OF OPTION LIST
       JMP    INIT08          / ILLEGAL CHAR...IGNORE
CMDERR	JMS SUB990	/ERROR: CR OR ALT MODE BEFORE _
	CMDERT-2
	JMP INIT02
CMDB	LAC PASS1
       DAC    OBINRY	      / SET BINARY OPTION FLAG
       JMP    INIT08
CMDL	LAC PASS1
       DAC    SLIST	      / SET SOURCE LIST OPTION FLAG
LSTSET	DAC LIST
       JMP    INIT08
	.IFUND %F2
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
	.ENDC
	.IFDEF	IMBED
CMDD	LAC	PASS1
	DAC	DLIST
	JMP	LSTSET
	.ENDC
CMDA	DAC UNFNBC
	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
       JMP   .-2
	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
	JMP .+10	/FINISHED
	JMS FNBCHR		/FIND TERMINATOR.
	SAD C00013
	SKP
	SAD S00175
	SKP
	JMP .-5
	DAC TITLEA
	LAC MS
       DAC    CTRLSW+2
       LAC    LS
       DAC    CTRLSW+3       / SET UP FILE NAME
       LAC    INIT02-2
       DAC    CTRLSW+4       / SET NAME EXTENSION (LST)
	LAC CHR3	/INTERNAL FOR CR AND ESC IS 00
	DAC CHARCR
	LAC CHR4
	DAC CHARLT
	LAC JMPFT2
	DAC FT2CNG
	.IFUND	IMBED
	XCT LIST
	JMP TRYBIN
	CAL+1766
	1
M3BK	INIT02
PC	0		/PROGRAM COUNTER
/      .ENTER -12              / OPEN LISTING FILE
       CAL    00766
       .DSA   000004
       .DSA   CTRLSW+2
TRYBIN	LAC INIT02-1
       DAC    CTRLSW+4       / SET NAME EXTENSION (BIN)
	XCT OBINRY
	JMP INIT01
	CAL+1765
	1
	INIT02
FORMST	0
/      .ENTER -13              / OPEN BINARY FILE
       CAL    00765
       .DSA   000004
       .DSA   CTRLSW+2
	.ENDC
	.IFDEF	IMBED
	LAC	CMDONE+1
	DAC	SIN507
	XCT	LIST
	JMP	TRYBIN
DLIST	XX
	JMP	LISTTL
	LAC	LISTD
	DAC	LISTI
	JMS	DENTER
	LAC	PASS2
	DAC	OBINRY
	JMP	INIT01
LISTTL	LAC	LISTT
	DAC	LISTI
TRYBIN	XCT	OBINRY
	JMP	INIT01
	LAC	RSTRT-1
	DAC	FILE+2
	JMS	DENTER
	.ENDC
       .EJECT
/ PASS 1 / PASS 2 COMMON INITIALIZATION
/
INIT01=.
	.IFUND	IMBED
	.CLOSE	-3	/TYPE CR/LF
	DZM	CTLPSW
	LAC    INIT02-3
       DAC    CTRLSW+4       / SET NAME EXTENSION (SRC)
/      .SEEK  -11,CTRLSW+2
       CAL    00767           / LOCATE INPUT FILE
       .DSA    000003
       .DSA   CTRLSW+2
	.ENDC
	.IFDEF	IMBED
	JMS	TTCLOS
	LAC	RSTRT-3
	DAC	FILE+2
	JMS	DSEEK
	.ENDC
       JMS    INDOTB	     /	DO TABLE POINTERS
       LAC    PASS1
       DAC    CLEN01	     /	DATA ASSIGNMENTS FINISHED/UNFINISHED
       DAC    CTRLSW+1	      /OTS I/O INITIALIZE IND.
       DZM    SORDER	     /	STATEMENT ORDERING COUNTER
       JMS    BIN500	     /	BINARY OUTPUT BUFFER
       DZM    XCHAR	     /	SOURCE IMAGE REQUIRED
	.IFUND	%F2
       LAC    END23
       DAC    BINO06	     /OBJECT LISTING BUFFER INITIALIZATION
	.ENDC
      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   PROCAD
	DZM	STAF	/RESET TEMPORARY STORAGE LETTER FOR STATEMEMTFUNCTIONS
       .EJECT
/ STATEMENT INITIALIZATION, READ IN, RECOGNITION, EXECUTION AND CLEAN UP
/
CONTRL LAC    K00001	     /INITIALIZE....
       DAC    UNFNBC	     / FETCH NEXT CHARACTER INDICATOR
       DZM    LOGIF	     / LOGICAL IF STATEMENT
       DZM    LABEL	     / LABEL FIELD ENTRY
	.IFUND %F2
       DZM    OBJB04	     /VECTOR IS (IS NOT) A PARAMETER (OBJ LIST)
	.ENDC
	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*   0              /CONSIDERATION.
       .EJECT
/SUBROUTINE TO FETCH STATEMENT LABEL
/CALLING SEQUENCE
/	JMS CTRL00
/
CTRL00	CAL    0
	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. STATEMENT LABELS CONSIST OF A
       SPA                   /DIGIT STRING OF 1 TO 5 DECIMAL DIGITS.
       JMP    CTRL04-2
       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
/	LAW 16340		/IS EQUAL TO THE CURRENT PROGRAM COUNTER
/       JMS    ERROR1         /IF THE ASSIGNMENT IS CORRECT.
ER01N	ERR	<'  01N'>,16340
       CLA                   /AN ERROR IS ANNOUNCED IF THE NUMBER WAS
       JMP    CTRL03         /USED MORE THAN ONCE AS A STATEMENT LABEL.
CTRL04 JMS    DEFNP1         /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
FAKE	0
	DAC BINBFH+1	/SAVE AC
	LAC* FAKE
	AND S17777	/(17777
	XOR LACCMD	/(200000
	DAC .+1
	XX
	.IFUND	X4K
	AND S60000	/MAKE SURE
	.ENDC
	.IFDEF	X4K
	AND	MASK
	.ENDC
	JMS TWOCMA	/OF LEGAL ADDR.
	TAD BNKBTS
	SNL
	ISZ FAKE		/DO NOT EXECUTE INSTRUCTION
	LAC BINBFH+1
	JMP* FAKE
       .EJECT
/ STATEMENT RECOGNITION DECODING MATRIX
/							
/ INITIAL MODE ROW
CTRLIM JMP*   CTRLIM         /TYPE CHARACTER
       .DSA   CTRL11         /01   NUMERIC       0123456789
       .DSA   CTRL12         /02   ALPHABETIC    BCJKMNOQRSTUVWYZ
       .DSA   CTRL12         /03   ALPHABETIC    ED
       .DSA   CTRL12         /04   ALPHABETIC    AEFGHILPX
       .DSA   CTRL13         /05   OPERATOR      +-
       .DSA   CTRL13         /06   OPERATOR      */
       .DSA   CTRL13         /07   PERIOD        .
       .DSA   CTRL14         /08   PARENTHESIS   (
       .DSA   CTRL15         /09   PARENTHESIS   )
       .DSA   CTRL16         /10   DELIMETER     ,=
       .DSA   CTRL13         /11   SPACE
/
/ SYMBOLIC MODE ROW
CTRLSM JMP*   CTRLSM         /TYPE CHARACTER
       .DSA   CTRL18         /01   NUMERIC       0123456789
       .DSA   CTRL18         /02   ALPHABETIC    BCJKMNOQRSTUVWYZ
       .DSA   CTRL18         /03   ALPHABETIC    ED
       .DSA   CTRL18         /04   ALPHABETIC    AFGHILPX
       .DSA   CTRL13         /05   OPERATOR      +-
       .DSA   CTRL13         /06   OPERATOR      */
       .DSA   CTRL13         /07   PERIOD        .
       .DSA   CTRL14         /08   PARENTHESIS   (
	.DSA CTRL15	/09    PARENTHESIS )
	.DSA CTRL16	/10   DELIMITER ,=
	.DSA CTRL18	/11   SPACE
/
/NUMERIC MODE ROW
CTRLNM	JMP* CTRLNM	/TYPE CHARACTER
	.DSA CTRL18	/01 NUMERIC 0123456789
	.DSA CTRL13	/02 ALPHABETIC BCJKMNOQRSTUVWYZ
	.DSA CTRL13	/03 ALPHABETIC ED
	.DSA CTRL19	/04 ALPHABETIC AFGHILPX
	.DSA CTRL13	/05 OPERATOR +-
	.DSA CTRL13	/06 OPERATOR */
	.DSA CTRL13	/07 PERIOD .
	.DSA CTRL14	/08 PARENTHSEIS (
	.DSA CTRL15	/09 PARENTHESIS )
	.DSA CTRL16	/10 DELIMETER ,=
	.DSA CTRL18	/11 SPACE
	.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).
       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.
/       SAD    DOMNE
/       JMP    CTRL20
/	JMP ED	/ERROR: STATEMENT NOT A DO STATEMENT
ER01D	ERS	<'  01D'>,<SAD DOMNE>,ED
CTRL20 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
	.IFDEF	K16
	LAC	LOGIF
	SZA
	JMP	CTRL29
	.ENDC
CTRL07	LAC	Y00000
       JMS    CTRL50         /BECAUSE A LOGICAL IF STATEMENT MAY
       SAD    IFMNE          /CONTAIN AN ASSIGNMENT STATEMENT, THE
       JMP    CTRL22         /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
	.IFDEF	K16
CTRL29	LAC	OP
	SNA
	JMP	CTRL07
	.ENDC
       JMS    CTRL80         /FUNCTIONS) OR A NON-ASSIGNMENT STATEMENT.
       JMS    SIN540        /AFTER THE STORAGE ASSIGNMENTS HAVE BEEN
       JMS    CLENUP          /PROCESSED (NECESSARY BEFORE ANY EXECUTABLE
       JMS    CTRL00         /(FETCH STATEMENT LABEL)
       JMS    FVARGO         /CODE IS GENERATED) THE ASSIGNMENT
       DZM    CTRLSW         /VARIABLE AND ITS DELIMETER ARE FETCHED.
       DZM    PROCAD         /INDICATE ASSIGNMENT OR FUNCTION STATEMENT.
       SAD    C00028         /THE STATEMENT IS IDENTIFIED AS A
       JMP    STAFCN         /STATEMENT FUNCTION WHEN THE DELIMETER
       JMS    SIN540         /INDICATES A FUNCTION AS THE ARGUMENT.
       LAC    V40000         / THE STATEMENT ORDER IS SET TO INDICATE
       DAC    TORDER         /EXECUTABLE CODE BEING GENERATED AND THE
       JMS    EXPRSN         /ASSIGNMENT STATEMENT IS DECODED.
	.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
       LAC    LABEL          /(WHEN NECESSARY) TO A STATEMENT ADDRESS.
       SZA                   /IF A LABEL WAS PRESENT, IT IS CHECKED
       JMS    DOCLEN         /AGAINST THE LIST OF DO RANGE TERMINATION
       JMP    CONTRL         /LABELS AND DO CLEAN UP IS OUTPUT (MAYBE).
       .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    REAMNE         /ENDFILE MUST BE RECOGNIZED SEPARATELY AS
       JMP    CTRL36         /THE FIRST THREE CHARACTERS OF EACH PAIR
       SAD    ENDMNE         /ARE IDENTICAL.
       JMP    CTRL37
       JMP    CTRL38
CTRL36 JMS    FNBCHR         /WHEN THE FIRST THREE CHARACTERS ARE REA,
       SAD    S00104         /THE NEXT NON-BLANK CHARACTER IS OBTAINED
       JMP    CTRL39         /AND EXAMINED FOR D OR L. (READ OR REAL).
	.IFUND	ERMSG
       SAD    S00114
       JMP    CTRL40         /AN ERROR IS ANNOUNCED IF THE CHARACTER IS
ER13I       JMP    EI         /NEITHER D NOR L.
	.ENDC
	.IFDEF	ERMSG
ER13I	ERS	<'  13I'>,<SAD S00114>,EI
	JMP	CTRL40
	.ENDC
CTRL39	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                   /AND EXAMINED FOR EITHER THE STATEMENT
       JMP    END            /TERMINATION CHARACTER OF F. A TERMINATION
/       SAD    C00006         /CHARACTER IDENTIFIES AN END STATEMENT.
/       SKP                   /AN ERROR IS ANNOUNCED IF THE CHARACTER IS
/       JMP    CTRL28         /NEITHER F OR THE TERMINATION CHARACTER.
ER14I	ERS	<'  14I'>,<SAD C00006>,EI
       LAC    Y00000
       JMS    CTRL50         /THE NEXT THREE CHARACTERS ARE FETCHED AND
/       SAD    ILEMNE         /MATCHED AGAINST ILE TO COMPLETE THE NAME
/       SKP                   /ENDFILE. AN ERROR IS ANNOUNCED IF THE
/       JMP    CTRL28         /NAME IS MISPELED.
ER15I	ERS	<'  15I'>,<SAD ILEMNE>,EI
	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 (I.E. COMMON,
       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.
/       SAD    PIDTBX
/	JMP EI		/ERROR: PRELIMINARY IDENTIFICATION NOT
ER01I	ERN	<'  01I'>,<SAD PIDTBX>,EI
       JMP    CTRL38+1	/POSSIBLE
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
       LAC    TEMP0          /NEXT TIME IN BITS 0-1
/       SAD    SIDTBX
/	JMP CTRL28	/THE STATEMENT IS IDENTIFIED WHEN ALL
ER12I	ERN	<'  12I'>,<SAD SIDTBX>,EI
CTRL30 LAC*   TCTR           /CHARACTERS TO DATE HAVE BEEN RECOGNIZED
       AND    T77777         /AND THE NUMBER OF CHARACTERS TO EXAMINE
/       SAD    NAME2          /NEXT TIME IS ZERO.
/	SKP
/CTRL28	JMP EI		/ERROR: CHARS NOT CORRESPONDINGLY MACTHED.
ER02I	ERS	<'  02I'>,<SAD NAME2>,EI
       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
       AND    Z00000         /THE SPECIFICATION STATEMENTS MUST BE
       RCR                   /PROCESSED IN A PRESCRIBED MANNER.
       DAC    TORDER
       JMS    TWOCMA         /THEREFORE THE ORDER NUMBER OF THE CURRENT
       TAD    SORDER         /STATEMENT IS COMPARED AGAINST THE ORDER
/       SMA!SZA               /NUMBER OF THE LAST STATEMENT.
/CTRL44	JMP EI		/ERROR: CURRENT STMT OUT-OF-ORDER.
ER03I	ERN	<'  03I'>,SMA!SZA,EI
       JMS    TSTORD         /STATEMENTS ARE ORDERED AS FOLLOWS...
       JMP    CTRL33         / 00  BLOCK DATA, FUNCTION, SUBROUTINE
/		         /01  INTEGER, REAL, LOGICAL, DOUBLE PREC.
       LAC    TORDER         / 02  DIMENSION
       TAD    Z00000         / 03  COMMON
       SPA                   / 04  EQUIVALENCE, EXTERNAL (FLOATS)
       JMP    CTRL34         / 05 DATA STATEMENT
       XCT    PASS           / 06 STATEMENT FUNCTIONS
       JMP    CONTRL         / 07  ALL OTHERS
       JMP    CTRL34         /STORAGE ASSIGNMENT STATEMENTS ARE NOT
CTRL33 SZA                   /PROCESSED DURING PASS 2.
       JMS    CTRL80         /ONLY DATA STATEMENTS AND STORAGE
       JMS    CLENUP         /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
       .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   615555         /DOU
       .DSA   100000+DBLPRC  /DOUBLE PRECESION
	.IFUND	%F2
       .DSA   620775         /EQU
       .DSA   400000+EQUIVA  /EQUIVALENCE
	.ENDC
       .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
	.IFUND	%F2
       .DSA   621424         /EXT
       .DSA   400000+EXTERN  /EXTERNAL
	.ENDC
       .DSA   612446         /CON
       .DSA   700000+CONTIN  /CONTINUE
FUNMNE .DSA   624326         /FUN
       .DSA   000000+FUNCTI  /FUNCTION
       .DSA   635204         /INT
       .DSA   100000+INTEGE  /INTEGER
       .DSA   646537         /LOG
       .DSA   100000+LOGICA  /LOGICAL
       .DSA   612445         /COM
       .DSA   300000+COMMON  /COMMON
       .DSA   670534         /RET
RETADR .DSA   700000+RETURN  /RETURN
       .DSA   623752         /FOR
FMTADR .DSA   700000+FORMAT  /FORMAT
	.IFUND	%F2
       .DSA   604513         /ASS
       .DSA   700000+ASSIGN  /ASSIGN
	.ENDC
       .DSA   670537         /REW
       .DSA   700000+REWIND  /REWIND
	.DSA 511231	/WRI
       .DSA   700000+WRITE   /WRITE
       .DSA   462075         /PAU
PAUSAD .DSA   700000+PAUSE   /PAUSE
       .DSA   211364         /CAL
CALLAD .DSA   700000+CALL    /CALL
       .DSA   214474         /DAT
DATAAD .DSA   500000+DATA    /DATA
       .DSA   274757         /STO
STOPAD .DSA   700000+STOP    /STOP
       .DSA   227054         /GOT
GOTOAD .DSA   700000+GOTO    /GOTO
IFMNE  .DSA   034522         /IF(
IFADDR	.DSA 700000+IF	/IF
PIDTBX .DSA   PIDTBX
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
       .DSA   SIDTB4         /FOURTH SECONDARY TABLE.CHARACTERS 13-15
SIDTBX .DSA   SIDTBX         /TERMINAL ADDR SECONDARY REFERENCE TABLE
/							
/ 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 607145	/BLE  DOUBLE PRECISION
	.IFUND	%F2
       .DSA   635661         /IVA  EQUIVALENCE
	.ENDC
       .DSA   671355         /ROU  SUBROUTINE
       .DSA   620603         /ENS  DIMENSION
       .DSA   612174         /CKD  BLOCK DATA
       .DSA   643710         /KSP  BACKSPACE
	.IFUND	%F2
       .DSA   421036         /ERN  EXTERNAL
	.ENDC
       .DSA   477166         /TIN  CONTINUE
CTIMNE .DSA   412751         /CTI  FUNCTION
       .DSA   220135         /EGE  INTEGER
       .DSA   234271         /ICA  LOGICAL
       .DSA   051646         /MON  COMMON
       .DSA   103036         /URN  RETURN
       .DSA   050574         /MAT  FORMAT
	.IFUND	%F2
       .DSA   034546         /IGN  ASSIGN
	.ENDC
       .DSA   035164         /IND  REWIND
       .DSA   001445         /TE   WRITE
       .DSA   001375         /SE   PAUSE
C00012 .DSA   000014         /L    CALL
C00001 .DSA   000001         /A    DATA
C00016 .DSA   000020         /P    STOP
C00015 .DSA   000017         /O    GOTO
/							
SIDTB2 .DSA   663325         /PRE  DOUBLE PRECISION
	.IFUND	%F2
       .DSA   445726         /LEN  EQUIVALENCE
	.ENDC
       .DSA   277166         /TIN  SUBROUTINE
       .DSA   035246         /ION  DIMENSION
	.DSA 004541	/ATA  BLOCK DATA
       .DSA   003275         /ACE  BACKSPACE
	.IFUND	%F2
       .DSA   000064         /AL   EXTERNAL
	.ENDC
       .DSA   001515         /UE   CONTINUE
ONMNE  .DSA   001146         /ON   FUNCTION
C00018 .DSA   000022         /R    INTEGER
       .DSA   000014         /L    LOGICAL
/							
SIDTB3 .DSA   612073         /CIS  DOUBLE PRECESION
	.IFUND	%F2
       .DSA   000175         /CE   EQUIVALENCE
	.ENDC
C00005 .DSA   000005         /E    SUBROUTINE
/							
SIDTB4 .DSA   035246         /ION  DOUBLE PRECESION
       .EJECT
/ SUBROUTINE TO CONCATENATE N NON-BLANK CHARACTERS
/ CALLING SEQUENCE...
/      LAC    N              /N IS CONTAINED IN BITS 0 AND 1
/      JMS    CTRL50
/							
CTRL50 CAL    0
       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)
       .EJECT
/ SUBROUTINE TO TEST FOR STATEMENT TERMINATION CHARACTER
/ CALLING SEQUENCE...
/      JMS    CTRL60
/      JMP    NO
/      XXX    YES
/
CTRL60 CAL    0
       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
       .EJECT
/ SUBROUTINE TO DETERMINE IF STATEMENT IS ERRONEOUSLY LABELED
/ CALLING SEQUENCE...
/      JMS    CTRL70
/							
CTRL70 CAL    0
       LAC    LABEL
       SNA                   /NO ACTION IS TAKEN IF THE STATEMENT IS
       JMP*   CTRL70         /NOT LABELED.
/	LAW 16340
/       JMS    ERROR1         /A RECOVERABLE ERROR IS ANNOUNCED IF THE
ER02N	ERR	<'  02N'>,16340
       LAC    V77777         /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.
       .EJECT
/ SUBROUTINE TO ANNOUNCE AN ERROR WHEN A BLOCK DATA SUBPROGRAM CONTAINS
/ EXECUTABLE STATEMENTS
/ CALLING SEQUENCE...
/      JMS    CTRL80
/
CTRL80	CAL 0		/NO ACTION IS TAKEN WHEN THE CURRENT
       LAC    FCNFLG         /SOURCE PROGRAM IS NOT A BLOCK DATA
/       SAD    K00001         /SUBPROGRAM.
/	JMP EI		/ERROR: BLOCK DATA SUBPROGRAM CONTAINS
ER04I	ERN	<'  04I'>,<SAD K00001>,EI
	JMP* CTRL80	/EXECUTABLE STATEMENTS.
       .EJECT
	.IFUND	%F2
/ EXTERNAL STATEMENT PROCESSOR
/							
EXTERN JMS    CTRL80         /EXTERNAL CANNOT APPEAR IN BLOCK DATA SUBR.
EXTE03 JMS    FVARGO         /THE EXTERNAL STATEMENT IS USED TO DECLARE
       JMS    SYMTYP         /THE NAMES OF EXTERNAL FUNCTIONS WHICH
       XOR    C00000         /WILL APPEAR AS FUNCTION PARAMETERS WITHOUT
	.IFUND	ERMSG
ER01E       JMP    EE         /PARAMETER LISTS SO THAT THEY MAY BE
	.ENDC
	.IFDEF	ERMSG
ER01E	ERS	<'  01E'>,SKP,EE
	.ENDC
       LAC*   SYMTBC         /DISTINGUISHED FROM SIMPLE VARIABLES.
/       SPA
/       JMP    EE         /THE VARIABLE NAMES LISTED CANNOT
ER02E	ERN	<'  02E'>,SPA,EE
       XOR    U00000         /REPRESENT...
       DAC*   SYMTBC         /  (1) ALREADY DECLARED FUNCTION NAMES
       LAC    OPVALU         /  (2) DUMMY VARIABLES
       SAD    C00030         /  (3) VARIABLES ASSIGNED TO A COMMON BLOCK
       JMP    EXTE03         /  (4) ARRAYS
       LAC    SORDER
       DAC    TORDER
       JMP    CRTEST
	.ENDC
       .EJECT
/ LOGICAL STATEMENT PROCESSOR
/							
LOGICA 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 DAC    MODE           /MODE IS INDICATED BY 0
       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.
       XCT    PASS	     /SPECIFICATION STATEMENTS ARE NOT
       JMP    CONTRL	     /PROCESSED DURING PASS 2.
       LAC    MODE
       JMS    SETN
       XOR    MODE
       DAC    MODE	     /SET NEW NUMBER OF WORDS PER ELEMENT
       .EJECT
/ DIMENSION STATEMENT PROCESSOR
/
DIMENS JMS    FVARGO	     /ONLY VARIABLES MAY BE SPECIFIED AS NAMES
       LAC    TORDER	     /OF DATA STORAGE, ARRAYS, OR FUNCTIONS.
       SAD    T00000
       JMP    DIMN01	     /THE CURRENT STATEMENT ORDER NUMBER IS
	LAC*	SYMTW6	/EXAMINED TO DETERMINE IF THE STATEMENT
			     /IS A DIMENSION OR ONE OF THE SPECIFICATION
/       SPA		     /STATEMENTS. THE NAMES ON SPECIFICATION
/	JMP EV		/ERROR: NAME EXPLICITY MODE-TYPED ALREADY.
ER01V	ERN	<'  01V'>,SPA,EV
	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    Z00000	     /STATEMENT. THE IMPLICIT MODE OF THE NAME
       XOR    MODE	     /(BASED ON THE FIRST CHARACTER OF THE
       DAC*   SYMTBC	     /NAME) IS OVER-RIDDEN AND THE EXPLICIT
       LAC    OPVALU	     /MODE SET (BASED ON THE NAME OF THE
       SAD    C00027	     /STATEMENT). 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 JMS    CTRL60	     /THE ONLY OTHER DELIMITER ALLOWED IS THE
/       		     /STATEMENT TERMINATION CHARACTER (C/R).
/	JMP EX		/ERROR:IMPROPER DELIMITER USED.
ER01X=.
CRTEST	ERN	<'  01X'>,<JMS CTRL60>,EX
       JMP    STEXIT
DIMN01 LAC    OPVALU	     /DIMENSION STATEMENTS MAY CONTAIN ONLY
/       SAD    C00027	     /ARRAY DECLARATIONS.
/	JMP DIMN03
/	JMP EC		/ERROR: DIMENSION STMT CONTAINS ILLEGAL ARRAY.
ER01C	ERS	<'  01C'>,<SAD C00027>,EC
DIMN03 JMS    FEDIMN	     /THE ARRAY DIMENSIONS ARE OBTAINED AND
       JMP    DIMN05	     /ENTERED INTO THE SYMBOL TABLE.
       .EJECT
/ COMMON STATEMENT PROCESSOR
/
COMMON JMS    COMN50	     /LABELED COMMON IS INDICATED BY ENCLOSING
       JMP    COMN01	     /THE LABELING NAME IN SLASHES. THE ABSENCE
COMN03 LAC    BLANKC	     /OF SLASHES INDICATES BLANK COMMON.
       DAC    NAME1	     /BLANK COMMON IS TREATED IN THE SAME
	JMS SYMBSE	/MANNER AS LABELED COMMON AND SO THE
       JMP    COMN02	     /COMPILER ASSIGNS A LABEL TO BLANK COMMON.
COMN01 JMS    COMN50	     /TWO SLASHES WITH NO NAME BETWEEN THEM
       JMP    COMN03	     /ALSO INDICATE BLANK COMMON.
       JMS    FVARGO
/       SAD    C00018
/       JMP    COMN02
/	JMP EC		/ERROR: SLASH DOES NOT DELIMIT BLOCK NAME.
ER02C	ERS	<'  02C'>,<SAD C00018>,EC
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
/       SAD    K00001	     /AS A COMMON BLOCK NAME.
/	SKP
/	JMP EC		/ERROR: DECLARED BLOCK NAME PREVIOUSLY
ER03C	ERS	<'  03C'>,<SAD K00001>,EC
       LAC*   SYMTW3	/DECLARED AS SOMETHING ELSE.
       SNA
       JMP   COMN04
       JMS    TSETAD         /SOMETHING ELSE.
       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*   SYMTW3	     /LABEL AND THE BLOCK SIZE IS RESET TO ZERO
       JMS    TSETAD
COMN09 JMS    FVARGO
       JMS    SYMTYP	     /THE NAMES OF THE DATA WORDS (ARRAYS)
       XOR    C00000	     /ASSIGNED TO THE COMMON BLOCK MUST
	.IFUND	ERMSG
           	     /INITIALLY REPRESENT NON-COMMON VARIABLES.
ER04C	JMP EC	/ERROR: DECLARED VARIABLE IS A DUMMY,FUNCTION,
	.ENDC
	.IFDEF	ERMSG
ER04C	ERS	<'  04C'>,SKP,EC
	.ENDC
       LAC    OPVALU	/OR ALREADY DECLARED TO BE IN COMMON.
       SAD    C00027	     /ARRAY DECLARATIONS ARE LEGAL ON COMMON
       JMS    FEDIMN	     /STATEMENTS.
       LAC*   TSMTW3	     /VARIABLES IN COMMON ARE ASSIGNED RELATIVE
       DAC*   SYMTW3	     /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*   SYMTBC	     /THE SIZE OF THIS VARIABLE (OR ARRAY) IS
       AND    S17777	     /ADDED TO THE EXISTING SIZE OF THE COMMON
       TAD*   TSMTW3	     /BLOCK TO WHICH IT IS ASSIGNED
       DAC*   TSMTW3
       JMS    CHAIN	     /THE NARIABLE (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    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
	.IFUND	%F2
/ EQUIVALENCE STATEMENT PROCESSOR
/
EQUIVA JMS    FNBCHR	     /EQUIVALENCE CLASSES ARE WRITTEN AS LISTS
/       SAD    S00050	     /OF SIMPLE VARIABLES OR SUBSCRIPTED
/       SKP    	     /VARIABLES ENCLOSED IN PARENTHESIS.
/	JMP EC		/ERROR: NEW CLASS NOT STARTED WITH LEFT PAREN.
ER05C	ERS	<'  05C'>,<SAD S00050>,EC
       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
       LAC    OPVALU	     /THE EQUIVALENCE CLASS IS INITIALIZED UPON
/       SAD    C00030	     /ENCOUNTERING THE FIRST VARIABLE.
/	SKP
/EQUI20	JMP EC		/ERROR: ONLY 1 CLASS MEMBER INDICATED.
ER06C	ERS	<'  06C'>,<SAD C00030>,EC
       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	     /A VARIABLE WHICH HAS NOT BEEN ASSIGNED TO
       XOR    T00000	     /AN EQUIVALENCE CLASS MAY BE ASSIGNED TO
       JMP    EQUI04	     /A COMMON BLOCK. WHEN AN EQUIVALENCE CLASS
	LAC COMCLS	/MEMBER BELONGS TO A COMMON BLOCK, THE
/       SZA		     /ENTIRE CLASS IS ASSIGNED TO THE COMMON
/       JMP    EQUI20	     /BLOCK. BECAUSE ENTITIES IN COMMON ARE
ER07C	ERN	<'  07C'>,SZA,EC
			/ASSIGNED UNIQUE STORAGE, ERROR:CURRENT CLASS ALREADY
       LAC    C00001	     /BEEN MERGED INTO A COMMON BLOCK. A COMMON
       DAC    COMCLS	     /BLOCK IS A SPECIAL CASE EQUIVALENCE CLASS.
	DAC OLDCLS
	.IFUND	EQUIV
	JMP	EQUI04+3
EQUI04 LAC*   SYMTW4	     /A VARIABLE WHICH HAS NOT BEEN ASSIGNED TO
       SAD    CHRCTR	     /AN EQUIVALENCE CLASS OR IS THE ONLY
       JMP    EQUI05	     /MEMBER IN THE CLASS WILL HAVE ITS OWN
       LAC    RELADR	     /ADDRESS AS ITS CLASS MEMBER LINKAGE ADDR.
	.ENDC
	.IFDEF	EQUIV
EQUI01	LAC	RELADR
	.ENDC
       JMS    TWOCMA
       TAD*   SYMTW3	     /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
	.IFDEF	EQUIV
EQUI04	LAC*	SYMTW4
	SAD	CHRCTR
	JMP	EQUI05
	LAC	COMCLS
	SNA
	JMP	EQUI01
	LAC	CHRCTR
	DAC	FSTVAR
	LAC*	SYMTW3
	JMS	TWOCMA
	TAD	RELADR
	DAC	DIFF
	SKP
EQUI16	JMS	NTHSYM
	JMS	EQUI15
	LAC*	SYMTW4
	SAD	FSTVAR
	JMP	EQUI17
	JMP	EQUI16
	.ENDC
EQUI06 JMS    TSETAD         /MEMBER.
       LAC    HEDCLS         /THE PREVIOUS AND CURRENT CLASSES ARE
EQUI12 JMS    NTHSYM         /MERGED WHEN THE CURRENT CLASS CONTAINS
/		         /MORE THAN ONE MEMBER. THE PREVIOUS CLASS
	.IFUND	EQUIV
       LAC*   SYMTW3         /IS LEGT ALONE AND THE RELATIVE ADDRESSES
       TAD    DIFF           /OF THE CURRENT CLASS MEMBERS ARE ADJUSTED
       DAC*   SYMTW3         /TO LINE-UP WITH THE PREVIOUS CLASS MAMBERS
       LAC    COMCLS         /THE ADJUSTMENT FACTOR IS THE DIFFERENCE
       SNA                   /BETWEEN THE RELATIVE ADDRESSES ASSIGNED
       JMP    EQUI08         /TO THE CURRENT VARIABLE IN BOTH CLASSES.
       LAC*   SYMTW3         /THIS DIFFERENCE IS ALSO ADDED TO THE
/	SPA		/SUBSCRIPT ADJUSTMENT FACTOR SO THAT FUTURE
/       JMP    EC       /MEMBERS MAY BE PROPERLY LINED-UP.
	SMA
	JMP	.+4
ER08C	ERR	<'  08C'>,16060
	DZM*	SYMTW3
/		        /AN ERROR IS ANNOUNCED IF THE RELATIVE
/		         /ADDRESS OF A VARIABLE ASSIGNED TO A COMMON
       LAC*   SYMTBC         /BLOCK UNDERFLOWS THE BLOCK BASE ADDRESS
       AND    Y77777
       XOR    T00000         /OF ZERO. WHEN THE PREVIOUS CLASS IS A
       DAC*   SYMTBC         /COMMON BLOCK, THE MEMBERS OF THE CURRENT
	.ENDC
	.IFDEF	EQUIV
	JMS	EQUI15
	.ENDC
EQUI08 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
	.IFDEF	EQUIV
EQUI15	0
	LAC*	SYMTW3
	TAD	DIFF
	DAC*	SYMTW3
	LAC	COMCLS
	SNA
	JMP	EQUI08
	LAC*	SYMTW3
	SMA
	JMP	.+4
/	LAW	16060	/C ERROR - RELATIVE ADDRESS UNDERFLOWS BLOCK BASE ADDRESS
/	JMS	ERROR1
ER08C	ERR	<'  08C'>,16060
	DZM*	SYMTW3
	LAC*	SYMTBC
	AND	Y77777
	XOR	T00000
	DAC*	SYMTBC
	JMP*	EQUI15
	.ENDC
EQUI11 LAC    DIFF           /CLASSES HAVE TWO OR MORE MEMBERS IN COMMON
/       SZA                   /IF SO, THE RELATIVE ADDRESS OF THE CURRENT
/       JMP    EQUI20         /VARIABLE HAS ALREADY BEEN ADJUSTED (WHEN
ER09C	ERN	<'  09C'>,SZA,EC
/		         /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
/       SPA                   /SIMPLY ADDED TO THE CURRENT CLASS.
/       JMP    EC         /ERROR: RELATIVE ADDRESS OF A VARIABLE
ER10C	ERN	<'  10C'>,SPA,EC
                     /ASSIGNED TO A COMMON BLOCK THROUGH AN
		/EQUIVALENCE RELATIONSHIP UNDERFLOWS
EQUI19	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* SYMTW3	/ITS ENTRY IN THE SYMBOL TABLE.
EQUI17	JMS CHAIN	/THE CURRENT EQUIVALENCE CHAIN IS BROKEN
	LAC OPVALU	/AND THE CURRENT VARIABLE INSERTED
	SAD C00030
	JMP EQUI07
/	SAD C00031	/EQUIVALENCE CLASS MEMBERS ARE SEPARATED
/	JMP EQUI13	/BY COMMAS. EQUIVALENCE CLASSES ARE
/	JMP EC	/TERMINATED BY RIGHT PARENS. ERROR: NO COMMA OR ).
ER11C	ERS	<'  11C'>,<SAD C00031>,EC
EQUI13	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
/       SAD    EQCLSX         /CLASS OR COMMON BLOCK.
/	JMP EM		/ERROR: EQUIVALENCE CLASS LIST FULL.
ER01M	ERN	<'  01M'>,<SAD EQCLSX>,EM
       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.
	.ENDC
       .EJECT
/ SUBROUTINE TO CLEAN-UP DATA STORAGE ASSIGNMENTS
/ CALLING SEQUENCE...
/      JMS    CLENUP
/							
CLENUP CAL    0              /DATA STORAGE LOCATIONS ARE ASSIGNED AFTER
CLEN01 SKP                   /ALL TYPE-SPECIFICATION, ARRAY DECLARATION,
       JMP*   CLENUP         /COMMON DECLARATION AND EQUIVALENCE
	LAC	U40000
	DAC	SORDER
	XCT PASS		/RELATION STATEMENTS HAVE BEEN PROCESSED.
	JMP CLEN02	/THE ASSIGNMENTS ARE MAKE DURING PASS 1
       LAC    PC	/AND THE BINARY INFORMATION IS OUTPUT
       DAC    START	/DURING PASS 2.
	.IFDEF	%F2
	DZM	EQUSTR
	.ENDC
	.IFUND	%F2
       DAC    EQUSTR         /THE AMOUNT OF NON-COMMON EQUIVALENCED
       LAC    EQUCLS         /MEMORY IS INITIALLY SET TO ZERO.
CLEN10 SAD    OP0
       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.
       SPA
       JMP    CLEN04         /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*   SYMTW3         /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*   SYMTW3         /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*   SYMTW3
       TAD    LOWRAD         /THE MEMBER WITH THE LOWEST RELATIVE
       DAC*   SYMTW3         /ADDRESS WILLBE ASSIGNED THE CURRENT
       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
	.ENDC
	.IFDEF	X4K
	LAC	PASS2	/USE ROUTINE TO SEARCH COMPACTED SYMTAB
	DAC	CLEN01
	LAC	SYMTB0
	DAC	SYMTBC	/POINTER TO UNCOMPACTED SYMBOL TABLE CURRENT ENTRY
	SAD	SYMTBN
	JMP	CLEN02-2
	DAC	TCTR	/POINTER TO NEXT AVAILABLE COMPACTED SYMBOL TABLE ENTRY
CLEN14	JMS	SETADR	/THE SYMBOL TABLE IS COMPACTED AFTER ALL
			/NON-COMMON EQUIVALENCED STORAGE HAS BEEN ASSIGNED
	LAC	K00001
	SAD*	SYMTBC
	JMP	CLEN17
	SAD	FCNFLG
	SKP
	JMP	CLEN16
	JMS	SYMTYP
	XOR	C00000
	JMP	CLEN16
/	LAW	16060
/	JMS	ERROR1
ER12C	ERR	<'  12C'>,16060
CLEN16	LAC*	SYMTBC
	SPA
	JMP	CLEN17
	JMS	SYMTYP
	XOR	T00000
	JMP	CLEN18
CLEN17	LAC	TCTR
	DAC	SYMTW5
	ISZ	SYMTW6
CLEN20	LAC	SYMTBC	/TRANSFER OLD ENTRY TO ITS NEW POSITION
	SAD	SYMTW6
	JMP	CLEN19
	LAC*	SYMTBC
	DAC*	SYMTW5
	ISZ	SYMTBC
	ISZ	SYMTW5
	JMP	CLEN20
CLEN18	JMS	DEFNSM
	XOR*	SYMTW3
	JMP	CLEN17
CLEN19	XCT	SBSE51+1	/JMS SYMSAF WITH EXTRA 4K
	SAD	SYMTBN
	JMP	CLEN11
	DAC	EXPTMP
	LAC	TCTR
	DAC	SYMTBC
	JMS	SETADR
	JMS	SBSE50
	DAC	TCTR	/MOVE OVER LAST ENTRY PROCESSED
	LAC	EXPTMP
	DAC	SYMTBC
	JMP	CLEN14
CLEN11	LAC	TCTR	/FIND THE NEW END OF SYMTAB POINTER
	DAC	SYMTBC
	JMS	SETADR
	JMS	SBSE50
	DAC	SYMTBN
	.ENDC
	.IFUND	X4K
       LAC    SYMTB0         /PROGRAM COUNTER FROM THE ENDING PROGRAM
CLEN14 DAC    SYMTBC         /COUNTER (BEFORE AND AFTER ASSIGNMENT).
	SAD    SYMTBN
       JMP    CLEN02-2         /THE SYMBOL TABLE IS COMPACTED AFTER ALL
       JMS    SETADR         /NON-COMMON EQUIVALENCED STORAGE HAS BEEN
       LAC    K00001         /ASSIGNED.
       SAD*   SYMTBC
       JMP    CLEN12         /ENTRIES FOR COMMON BLOCK NAMES ARE
       SAD    FCNFLG         /REDUCED TO FOUR (OR FIVE) WORDS.
       SKP
       JMP    CLEN16
       JMS    SYMTYP         /ALL SYMBOL TABLE ENTRIES ARE EXAMINED IN
       XOR    C00000         /A BLOCK DATA SUBPROGRAM.
       JMP    CLEN16
/       LAW    16060         /AN ERROR IS ANNOUNCED IF NON-COMMON DATA
/       JMS    ERROR1         /STORAGE IS DECLARED IN A BLOCK DATA
ER12C	ERR	<'  12C'>,16060
CLEN16 LAC*   SYMTBC         /SUBPROGRAM.
       SPA
       JMP    CLEN17         /ENTRIES FOR SIMPLE VARIABLES IN COMMON
       JMS    SYMTYP         /ARE REDUCED TO FOUR (OR FIVE) WORDS.
       XOR    T00000
       JMP    CLEN18         /ENTRIES FOR NON-COMMON SIMPLE VARIABLES,
CLEN12 LAC    SYMTW5         /FUNCTION NAMES, SIMPLE DUMMY VARIABLES,
       JMP    CLEN19         /AND STATEMENT NUMBERS ARE REDUCED TO
CLEN18 JMS    DEFNSM         /TWO (OR THREE) WORDS.
       XOR*   SYMTW3         /THE SYMBOL IS DEFINED OR SET UNDEFINED
       LAC    SYMTW3         /ACCORDINGLY.
CLEN19 DAC    SYMTBC
       DAC    TCTR
CLEN11 LAC    SYMTW6         /THE TABLE IS COMPACTED BY REMOVING THE
       TAD    C00001         /UNUSED WORDS OF THE CURRENT ENTRY AND
       DAC    SYMTW6         /PUSHING THE SUBSEQUENT ENTRIES UP INTO
       SAD    SYMTBN         /THE UNUSED WORDS (THE TABLE IS LAID OUT
       JMP    CLEN20         /BEGINING IN LOW MEMORY AND ENDING IN HIGH
       LAC*   SYMTW6         /MEMORY).
       DAC*   TCTR
	ISZ TCTR
       JMP    CLEN11
CLEN20 LAC    TCTR           /THE NEXT AVAILABLE ENTRY ADDRESS IS
       DAC    SYMTBN         /UPDATED BY THE NUMBER OF WORDS REMOVED
       LAC    SYMTBC         /FROM THIS ENTRY.
       JMP    CLEN14
CLEN17 LAC    SYMTW6         /ALL SIX (OR SEVEN) WORDS ARE RETAINED FOR
       TAD    C00001         /ARRAY NAME AND STATEMENT FUNCTION NAME
       JMP    CLEN14         /ENTRIES.
	.ENDC
       LAC    START
       DAC    PC
CLEN02 DZM    LOWRAD         /THE AMOUNT OF STORAGE REQUIRED FOR THE
       LAC    PASS2
       DAC    CLEN01
	LAC	FILE1		/OUTPUT FILE NAME
	JMS	BINOUT
	XOR	C00007
	LAC	FILE2
	JMS	BINOUT
	XOR	C00008
	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    PROCAD
       DAC    START
       LAW    -1
       DAC    PROCAD
       LAC    SYMTB0
CLEN25 DAC    SYMTBC         /ARRAY DESCRIPTION BLOCKS AND TRANSFER
       SAD    SYMTBN         /VECTORS FOR SIMPLE VARIABLES ASSIGNED TO
       JMP    CLEN22         /COMMON ARE OUTPUT NEXT.
       JMS    SETADR         /THE ORDER OF OUTPUT WILL FOLLOW THE ORDER
       LAC*   SYMTBC         /OF THE SYMBOL TABLE EXCEPT FOR VARIABLES
       SAD    K00001         /ASSIGNED TO COMMON. VARIABLES ASSIGNED
       JMP    CLEN23         /TO A COMMON BLOCK ARE OUTPUT AS A UNIT.
       RCL
	SNL
	JMP	CLEN13
	SPA						
       JMP    CLEN24         /DESCRIPTION WORDS ARE NOT OUTPUT FOR A
       LAC    FCNFLG         /BLOCK DATA SUBPROGRAM.
       SAD    K00001
       JMP    CLEN26         /SIMPLE VARIABLES NOT ASSIGNED TO COMMON
       JMS    SYMTYP         /AND TRANSFER VECTORS FOR DECLARED
       XOR    C00000         /EXTERNAL REFERENCES ARE NOT ASSIGNED AT
       JMP    CLEN26         /THIS TIME.
       LAC*   SYMTW3
       SAD    S17777         /NON-COMMON ARRAYS WHICH WERE NOT INCLUDED
       JMP    CLEN27         /IN ANY EQUIVALENCE CLASS ARE ASSIGNED
       JMP    CLEN28         /MEMORY LOCATIONS AT THIS TIME.
CLEN27 LAC    PC
       XCT    PASS           /THE CURRENT SETTING OF THE PROGRAM
       DAC*   SYMTW3         /COUNTER BECOMES THE RELATIVE ADDRESS OF
       LAC*   SYMTBC         /THE ARRAY.
       AND    S17777
       JMS    BINOUT         /THE ARRAY IS OUTPUT AS A BLOCK OF NON-
       XOR    C00006         /COMMON STORAGE.
CLEN28 JMS    CLEN50
	JMS VECTOR	/DESCRIPTION WORDS FOR NON-COMMON ARRAYS
CLEN26 LAC    SYMTW6         /ARE OUTPUT AS THEY ARE ENCOUNTERED IN THE
CLEN34 TAD    C00001         /SYMBOL TABLE.
	.IFDEF	X4K
	XCT	SBSE51+1
	.ENDC
       JMP    CLEN25
CLEN24	RCL
	SPA
	JMP	CLEN26
CLEN13	LAC	SYMTW3
	JMP	CLEN34+1
CLEN23 JMS    TSETAD
       LAC*   SYMTW3         /A BLOCK SIZE OF ZERO INDICATES
       SNA                   / AN EMPTY COMMON BLOCK (NO MEMBERS).
       JMP    CLEN22-2       / USUALLY THE RESULT OF ERRS IN COMN STMNTS.
       JMS    OSYMBL
	XCT	PASS	/DO NOT EXECUTE BLOCK
	JMP	CLEN32	/SIZE CALCULATION PASS2
       DZM*   TSMTW3
       LAC*   TSMTW4
CLEN33 JMS    NTHSYM
       JMS    CLEN60	     /THE COMMON BLOCK SIZE IS RE-CALCULATED
       TAD*   TSMTW3	     /BECAUSE IT MAY HAVE BEEN LENGTHENED DUE
       SMA		     /TO EQUIVALENCE RELATIONSHIPS.
       JMP    CLEN29
       LAC    TEMP0
       DAC*   TSMTW3
CLEN29 LAC*   SYMTW4
       SAD*   TSMTW4
       SKP
       JMP    CLEN33
CLEN32       LAC*   TSMTW3
       JMS    BINOUT
       XOR    C00012
       LAC*   TSMTW4
CLEN40 JMS    NTHSYM
       LAC    FCNFLG	     /ARRAY DESCRIPTION BLOCK AND TRANSFER
       SAD    K00001	     /VECTORS ARE NOT GENERATED IF THIS IS A
       JMP    CLEN30	     /BLOCK DATA SUBPROGRAM.
       LAC*   SYMTBC
       SPA
       JMS    CLEN50
       JMS    VECTOR	     /THE VARIABLE IN COMMON IN
       LAC*   SYMTW3	     /OUTPUT ALONG WITH ITS RELATIVE ADDRESS
       JMS    BINOUT	     /IN THE CURRENT COMMON BLOCK (CODE 13),
       XOR    C00013	     /AND THE ADDRESS OF ITS TRANSFER VECTOR
       LAC*   SYMTBC	     /(CODE 14).
       AND    S17777
       JMS    BINOUT
       XOR    C00014
       JMP    CLEN31
CLEN30 JMS    DEFNSM	     /VARIABLES IN A BLOCK DATA SUBPROGRAM ARE
	XOR* SYMTW3		/DEFINED AS THEIR RELATIVE ADDRESSES.
CLEN31 LAC*   SYMTW4
       SAD*   TSMTW4
       SKP
       JMP    CLEN40
       LAC*   TSMTW3	     /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    TSMTW4
       JMP    CLEN34
CLEN22 LAC    START
       DAC    PROCAD
       LAC    PC	     /THE PROGRAM COUNTER IS SAVED AS THE
       DAC    START	     /ADDRESS OF THE FIRST EXECUTABLE
       JMP*   CLENUP	     /INSTRUCTION.
       .EJECT
/ SUBROUTINE TO OUTPUT ARRAY DESCRIPTION WORDS
/ CALLING SEQUENCE...
/      JMS    CLEN50
/
CLEN50 CAL    0 	     /ARRAY DESCRIPTION WORDS ARE OUTPUT FOR
       LAC*   SYMTBC	     /ALL COMMON ARRAYS AND NON-COMMON ARRAYS
       AND    S77777	     /WHICH ARE NOT DUMMY VARIABLES.
       JMS    ABSBIN	     /(DESCRIPTION WORDS FOR DUMMY ARRAYS ARE
       LAC*   SYMTW5	     /LOCATED IN THE CALLING PROGRAM.)
       JMS    ABSBIN	     / WORD 1 ..  MODE + SIZE
       LAC*   SYMTW6	     / WORD 2 ..  IMAX
       JMS    ABSBIN	     / WORD 3 ..  IMAX*JMAX
       JMP*   CLEN50	     / WORD 4 ..  ADDRESS
       .EJECT
/ SUBROUTINE TO OUTPUT A TRANSFER VECTOR
/ CALLING SEQUENCE...
/      JMS    VECTOR
/
VECTOR CAL    0
       XCT    PASS	     /THE SYMBOL IS LEFT UNDEFINED UNTIL PASS 2
       JMS    DEFNSM	     /AS THE DEFINITION WORD CONTAIN THE NUMBER
       XOR    PC	     /OF WORDS OCCUPIED BY THIS VARIABLE.
       LAC*   SYMTW3
       JMS    VECBIN	     /THE TRANSFER VECTOR IS INITIALLY SET TO
       JMP*   VECTOR         /REFERENCE THE ARRAY(VAR) ADDRESS.
       .EJECT
/ SUBROUTINE TO DEFINE A SYMBOL
/ CALLING SEQUENCE...
/      JMS    DEFNSM
/      XOR    DEFINITION
/
DEFNSM CAL    0
       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
/ CALLING SEQUENCE...
/      JMS    CLEN60
/
CLEN60 CAL    0
       LAC*   SYMTBC	     /THE NUMBER OF WORDS OCCUPIED BY THIS
       AND    S17777	     /VARIABLE IS ADDED TO THE RELATIVE ADDRESS
       TAD*   SYMTW3	     /ASSIGNED TO THIS VARIABLE.
       DAC    TEMP0	     /THE POSITIVE ADDRESS IS SAVED AND ITS
       JMS    TWOCMA	     /NEGATIVE RETURNED TO THE CALLING PROGRAM.
       JMP*   CLEN60
       .EJECT
/ 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.
	.IFDEF PDP15
	TAD	K04081
	SPA
	JMP	.+3
	LAC	PASS1		/PROGRAM EXCEEDS 4K
	DAC	F4K
	LAC	PC
	.ENDC
	TAD	K08177
       SPA		     /THE COMPILER.. 8191 IS USED AS A FLAG.)
       JMP*   INCRPC
/	LAW 16320		/ERROR: PROGRAM SIZE
/       JMS    ERROR1	     /EXCEEDS A SINGLE MEMORY BANK.
ER02M	ERR	<'  02M'>,16320
       JMP*   INCRPC
       .EJECT
/ SUBROUTINE TO FETCH VARIABLE ARGUMENT-OPERATOR/DELIMITER PAIR
/ CALLING SEQUENCE...
/      JMS    FVARGO
/
FVARGO CAL    0
       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
       .EJECT
/SUBROUTINE TO MAKE PASS1 DEFINITIONS
/CALLING SEQUENCE
/      JMS DEFNP1
/
DEFNP1 CAL    0
       LAC    PC
       XCT    PASS
       JMP*   DEFNP1
       XCT    CLEN01
       JMP*   DEFNP1
       DAC*   SYMTW3
       JMP*   DEFNP1
       .EJECT
/SUBROUTINE TO SET ADDRESS OF NTH SYMBOL
/CALLING SEQUENCE
/      LAC    N
/      JMS    NTHSYM
/
NTHSYM CAL    0
       JMS    TWOCMA
       DAC    TCTR
       LAC    SYMTB0
NTHSM1 DAC    SYMTBC
       JMS    SETADR
       ISZ    TCTR
       SKP
       JMP*   NTHSYM
       JMS    SBSE50
       JMP    NTHSM1
       .EJECT
/ SUBROUTINE TO FETCH INTEGER CONSTANT ARRAY DIMENSIONS (SUBSCRIPTS)
/ CALLING SEQUENCE...
/      JMS    FARDIM
/
FARDIM CAL    0
       DZM    T2	     /AN ARRAY DECLARATION MUST CONTAIN AT
       DZM    T3	     /LEAST ONE DIMENSION BUT NOT MORE THAN
       LAC    AT1	     /THREE.
       DZM    SSCTR
FARD05 DAC    TI
       JMS    FIARGO
       JMS    CONTST	     /THE DIMENSIONS MUST BE WRITTEN AS
       DAC*   TI	     /UNSIGNED, NON-ZERO INTEGER CONSTANTS.
       ISZ    SSCTR
       LAC    OPVALU	     /DIMENSIONS ARE SEPARATED BY COMMAS AND
       SAD    C00030	     /THE DIMENSION LIST IS TERMINATED BY A
       JMP    FARD02	     /RIGHT PARENTHESIS.
/       SAD    C00033
/	SKP
/	JMP ES		/ERROR: SOME OTHER DELIMITER USED.
ER01S	ERS	<'  01S'>,<SAD C00033>,ES
       JMS    FARGOP	     /THE PSEUDO ARGUMENT SUBSCRIPTED VARIABLE
       JMP*   FARDIM	     /AND ITS DELIMITER ARE OBTAINED BEFORE
FARD02 LAC    TI	     /RETURNING TO THE CALLING PROGRAM.
       TAD    C00001
/       SAD    ATX	     /A MAXIMUM OF THREE DIMENSIONS ARE ALLOWED.
/	JMP ES		/ERROR: MORE THAN 3 DIMENSIONS.
ER02S	ERN	<'  02S'>,<SAD ATX>,ES
       JMP    FARD05
	.EJECT
/ SUBROUTINE TO FETCH AND ENTER (IN THE SYMBOL TABLE) ARRAY DIMENSIONS
/ CALLING SEQUENCE...
/      JMS    FEDIMN
/
FEDIMN CAL    0
       LAC*   SYMTBC	     /THE NUMBER OF MACHINE WORDS PER ELEMENT
       AND    S17777	     /IS OBTAINED AND SET UP AS A MULTIPLIER
       DAC    T0	     /FOR DETERMINING THE TOTAL SIZE OF THE
       JMS    FARDIM	     /ARRAY
       LAC    T0	     /THE ARRAY DIMENSIONS ARE OBTAINED AND THE
       JMS    MULT	     /ROW-COLUMN LENGTHS CALCULATED (ALONG WITH
       TAD    T1	     /THE TOTAL SIZE).
       DAC    T1	     /	 N * IMAX
       JMS    MULT
       TAD    T2
       DAC    T2	     /	 N * IMAX * JMAX
       JMS    MULT
       TAD    T3
       DAC    T3	     /	 N * IMAX * JMAX * KMAX
       LAC*   TI	     /THE TOTAL LENGTH IS ONE OF THESE THREE
       TAD    K08192	     /NUMBERS DEPENDING ON THE ACTUAL NUMBER OF
/       SMA		     /DIMENSIONS.
/	JMP EM		/ERROR: ARRAY LENGTH GREATER THAN 8192.
ER03M	ERN	<'  03M'>,SMA,EM
       LAC*   SYMTBC
       AND    Z60000	     /THE LENGTH OF THE ARRAY IS TEMPORARILY
       XOR*   TI	     /SET AS THE ADDRESS OF THE ARRAY (FOR
       XOR    W00000	     /EQUIVALENCE AND COMMON PROCESSING). THE
       DAC*   SYMTBC	     /SYMBOL IS FLAGGED AS AN ARRAY.
       DZM*   TI
       LAC    T1	     /THE INFORMATION REQUIRED TO CALCULATE THE
       DAC*   SYMTW5	     /POSITION OF AN ARRAY ELEMENT IS ENTERED
/			     /INTO THE SYMBOL TABLE. I.E.
       LAC    T2	     /	N*IMAX FOR 2-DIMENSION ARRAYS
       DAC*   SYMTW6	     /N*IMAX, N*IMAX*JMAX FOR 3-DIMENSION.
       LAC    OPVALU	     /THE TERMINAL DELIMITER IS RETURNED TO THE
       JMP*   FEDIMN	     /CALLING PROGRAM.
       .EJECT
/ SUBROUTINE TO ANNOUNCE AN ERROR IF THE ARGUMENT IS NOT A VARIABLE
/ CALLING SEQUENCE...
/      JMS    VARTST
/
VARTST CAL    0
       LAC    ARG	     /THE ARGUMENT TYPE IS ISOLATED AND
	AND Z00000	/EXAMINED TO DETERMINE IF IT IS A VARIABLE.
	.IFUND	ERMSG
       SAD    T00000
       JMP*   VARTST
ER02V	JMP EV		/ERROR: ARG NOT SYMBOLIC.
	.ENDC
	.IFDEF	ERMSG
ER02V	ERS	<'  02V'>,<SAD T00000>,EV
	JMP*	VARTST
	.ENDC
       .EJECT
/ SUBROUTINE TO ANNOUNCE AN ERROR IF AN INTEGER ARGUMENT IS NOT A
/ NON-ZERO POSITIVE CONSTANT.
/ CALLING SEQUENCE...
/      JMS    CONTST
/
CONTST CAL    0
       LAC    ARG	     /THE ARGUMENT TYPE IS ISOLATED AND
       AND    Z00000	     /EXAMINED TO DETERMINE IF IT IS A CONSTANT.
/       SAD    U00000
/       SKP		     /(INTERGER TYPE HAS ALREADY BEEN DETERMINED).145500
/	JMP EV		/ERROR: ARG NOT NON-ZERO POSITIVE CONSTANT.
ER03V	ERS	<'  03V'>,<SAD U00000>,EV
       LAC    S 	     /THE CONSTANT MUST BE NON-ZERO AND
/       SMA!SZA		     /POSITIVE.
/       JMP*   CONTST
/	JMP EV		/ERROR: ARG NOT NON-ZERO POSITIVE CONSTANT.
ER04V	ERN	<'  04V'>,SPA!SNA,EV
	JMP*	CONTST
       .EJECT
/SUBROUTINE TO TEST FOR A VARIABLE OR A +CONSTANT.NE.0.
/CALLING SEQUENCE---JMS PNZCV
PNZCV  CAL    0
       LAC    ARG	    /IF ARG=VARIABLE, EXIT
       AND    Z00000
       SAD    T00000
       SKP
       JMS    CONTST	      /IF ARG.NE.VARIABLE, IT MUST BE A
       JMP*   PNZCV	      /   POSITIVE, NON-ZERO CONSTANT
       .EJECT
/ SUBROUTINE TO FETCH CHARACTER AND CHECK FOR A SLASH (/) AS A DELIMITER
/ CALLING SEQUENCE
/      JMS    COMN50
/      JMP    YES
/      XXX    NO
/
COMN50 CAL    0
       JMS    FNBCHR	     /THE NEXT NON-BLANK CHARACTER IS FETCHED
       SAD    C00047	     /RETURN IS IMMEDIATE IF THE CHARACTER IS
       JMP*   COMN50	     /A SLASH (/).
       DZM    UNFNBC	     /IF NOT, THE CHARACTER IS UNFETCHED AND
       ISZ    COMN50	     /RETURN IS MADE TO MARK PLUS ONE.
       JMP*   COMN50
       .EJECT
/ SUBROUTINE TO CHAIN CLASS MEMBERS (EQUIVALENCE OR COMMON BLOCK)
/ CALLING SEQUENCE...
/      JMS    CHAIN
/
CHAIN  CAL    0
       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 SIMPLE VARIABLE OR ARRAY ELEMENT WHOSE SUBSCRIPTS
/ ARE CONSTANTS AND OPERATOR-DELIMITER
/ CALLINGING SEQUENCE...
/      JMS    FVORAR
/
FVORAR CAL    0 	     /THIS SUBROUTINE IS USED BY THE DATA AND
       JMS    FVARGO	     /EQUIVALENCE STATEMENT PROCESSORS. LEGAL
/       JMS    SYMTYP	     /NAMES ARE SIMPLE VARIABLES OR ARRAY
/       XOR    V00000	     /ELEMENTS WITH CONSTANT SUBSCRIPTS.
/	SKP
/	JMP EV		/ERROR: NAME IS THAT OF DUMMY VARIABLE.
/       JMS    SYMTYP
/       XOR    U00000
/	SKP
/	JMP EV		/ERROR: NAME IS THAT OF EXTERNAL FUNCTION.
	LAC*	SYMTBC
	AND	V00000
ER05V	ERN	<'  05V'>,<SAD V00000>,EV
ER06V	ERN	<'  06V'>,<SAD U00000>,EV
       DZM    T0
       LAC*   SYMTBC	     /THE NUMBER OF WORDS PER ITEM (VARIABLE IS
/			     /ONLY ONE ITEM, ARRAY MAY CONTAIN MORE)
       JMS    SETN	     /IS OBTAINED FOR USES BOTH INTERNAL AND
       DAC    MODE	     /EXTERNAL TO THIS ROUTINE.
       LAC    OPVALU	     /THE APPEARANCE OF A SUBSCRIPTED VARIABLE
       SAD    C00027	     /NEED NOT INDICATE AN ARRAY ELEMENT. IF
       JMP    FVAR03	     /THE VARIABLE HAS NOT BEEN DECLARED AS AN
       SAD    C00029	     /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
       TAD    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
/       SMA		     /AS A FUNCTION AND AN ERROR WOULD OCCUR).
/	JMP EV		/ERROR: MORE THAN 1 DIMENSION INDICATED FOR
ER07V	ERN	<'  07V'>,SMA,EV
			/A NON-ARRAY VARIABLE.
FVAR04 LAC    T2
       TAD    K00001	     /THE ELEMENT POSITION IS CALCULATED FOR
       JMS    MULT	     /MULTI-DIMENSION ARRAY ELEMENTS AS...
       TAD*   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
       TAD*   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    T0	     /ELEMENT.
       TAD    K08192	     /THE NUMBER OF STATED SUBSCRIPTS (OTHER
/       SPA		     /THAN ONE) MUST AGREE WITH THE NUMBER OF
/       JMP*   FVORAR	     /DECLARED SUBSCRIPTS (DATA STATEMENT CHECKS
/       JMP    EM	     /ONE-SUBSCRIPTED ELEMENTS TOO). THE ELEMENT
ER04M	ERN	<'  04M'>,SMA,EM
	JMP*	FVORAR
			/POSITION CANNOT BE GREATER THAN 8191.
       .EJECT
/ READ AND WRITE STATEMENT PROCESSORS
/      READ  ENTRY = READ
/      WRITE ENTRY = WRITE
WRITE  LAC    C00001	     /WRITE ENTRY -- ONE TO RWFLAG
READ   DAC    RWFLAG	     /RWFLG= READ/WRITE INDICATOR
       JMS    FNBCHR	     /FETCH FIRST NON-BLANK CHARACTER AFTER THE
/       SAD    S00050	     /	 READ OR WRITE MNEMONIC.  IF ITS NOT A
/	SKP
/	JMP EV		/ERROR:1ST CHAR AFTER READ OR WRITE NOT (.
ER08V	ERS	<'  08V'>,<SAD S00050>,EV
       JMS    FIARGO	     /	 ARGUMENT MUST BE INTEGER TYPE,
/			     /	 AS IT IS THE I/O UNIT NO.
	JMS IODEV		/OUTPUT I/O DEVICE INFORMATION.
	LAW -37		/TEST OP FOR RIGHT-PAREN. IF SO, SET
	TAD OPVALU	/   FORMST TO ZERO INDICATING BINARY I/O.
	DAC FORMST
	SNA!CLA
	LAC C00033
	TAD RWFLAG	/OUTPUT APPROPRIATE OTS CALL --READ OR
	JMS OPOPA2	/   WRITE, BCD OR BINARY.
	LAC ARG
	LAC FORMST	/CHECK (OPVALU-31).  IF ZERO (OP=RIGHT-
	SNA		/	PAREN), EXIT TO LIST PROCESSOR SETUP.
	JMP RW13		/   IF -1 (OP = COMMA), FETCH FORMAT
/	SAD K00001	/   STATEMENT OR ARRAY NAME.  IF NEITHER,
/	SKP		/ANNOUNCE ERROR.
/	JMP EI
ER05I	ERS	<'  05I'>,<SAD K00001>,EI
	JMS FETSNO	/FETCH FORMAT STATEMENT NUMBER.  IF AC IS
	SMA		/NEG. AFTER FETCH, THERE WAS NO
	JMP	RW45	/ STATEMENT (MUST BE
	JMS	FVARGO	/ AN ARRAY. OUTPUT
	JMP	RW44	/ADDRESS OF FORMAT+1
RW45	AND	S60000	/ OR ARRAY
	XCT	PASS
	SAD	S60000
	SKP
	.IFUND	ERMSG
ER03N	JMP	EN	/ADDRESS UNDEFINED
	.ENDC
	.IFDEF	ERMSG
ER03N	ERS	<'  03N'>,SKP,EN
	.ENDC
RW44	LAC*	SYMTBC
	SMA		/	MENT (PLUS 1) OR THE ARRAY.
	TAD C00001
       AND    W17777
	JMS VECBIN
	LAC XCHAR		/IF THE FIRST CHARACTER AFTER THE FORMAT
/	SAD S00051	/   STATEMENT NUMBER OR THE ARRAY NAME IS
/	SKP		/NOT A RIGHT-PAREN, ANNOUNCE AN ERROR.
/	JMP EF
ER01F	ERS	<'  01F'>,<SAD S00051>,EF
RW13   JMS    FNBCHR	     /FETCH FIRST CHARACTER OF THE I/O LIST.
       JMS    CTRL60
       JMP    RW14	     /IF CHAR NOT A CARRIAGE RETURN, THERE IS
       LAC    FORMST	     /	 AN I/O LIST.
       SZA
       JMP    RW42	     /IF I/O CALL IS BCD, OUTPUT JMS* TO BCD
       LAC    RWFLAG	     /	 CLEANUP ROUTINE.
/       SNA
/       JMP    RW43	     /IF I/O CALL IS A READ, OUTPUT JMS* TO
/       JMP    EX	     /	 BINARY CLEANUP ROUTINE.  IF I/O CALL
ER02X	ERN	<'  02X'>,SZA,EX
	JMP	RW43
			/IS BINARY WRITE, ANNOUNCE ERROR.
RW14   DZM    UNFNBC	     /UNFETCH CHAR AND GO TO LIST PROCESSOR
       .EJECT
/ INPUT AND OUTPUT LIST PROCESSOR -- SCAN1
RW19   JMS    INAOPI
       DZM    TFAO01
       LAC    DOTABA	     /SAVE DO TABLE POINTER FOR EXIT CHECKS.
       DAC    TRW1
RW20   JMS    FA2NOP	     /FETCH ARG2 AND NOP.
       LAC    ARG0	     /SAVE RELATIVE POSITION OF THE ELEMENT
       JMS    TWOCMA	     /	 LIST POINTER.
       TAD    ARGI
       DAC    TRW2
       LAC    IDXNOP	     /CHECK OP.
       SNA
       JMP    RW22	     /IF C/R.
       SAD    C00030
       JMP    RW21	     /IF COMMA.
/       SAD    C00001
/       SKP
/       JMP    RW39
ER03X	ERS	<'  03X'>,<SAD C00001>,EX
       JMS    TSTDTP	     /IF EQUAL SIGN, STORE LEVEL, INDEX IN DO
       LAC    LEVNOP	     / TABLE.
       XOR    TRW2
       DAC*   DOTABA
       JMS    INCDTP
       JMP    RW20
RW21   LAC    LEVNOP	     /CHECK LEVEL (DP).
       TAD    Z76600	     /IF .LT. 10, END OF SCAN 1.
       SMA
       JMP    RW20
RW22	JMS INAOPI	/END OF SCAN 1 -- SETUP FOR SCAN 2.
	LAC V77777	/MAKE PAREN BASE LEVEL A LARGE POSITIVE
	DAC PARLHI	/   NUMBER IN CASE NO IMPLIED DO'S.
	LAC DOTABA	/TEST DO-TABLE POINTER.  IF IT DID NOT
	SAD TRW1		/   CHANGE IN SCAN 1, THERE ARE NO IMPLIED
	JMP RW23		/   DO'S. GO TO SCAN 2 WITH PARLHI LARGE.
	TAD K00001	/SET RWEND POINTER TO LAST ENTRY IN THE
	DAC RWEND		/   IMPLIED-DO-TABLE.  (TRW1 POINTS TO 1ST)
	DAC RWFND		/INITIALIZE DO-TABLE SCANNING PARAMETERS.
	DZM RWTST
	LAC* RWEND	/THE PAREN BASE LEVEL IS SET TO THE LOWEST
	AND Z77700	/   OP-LEVEL IN THE TABLE (ALWAYS THE LAST
	DAC PARLHI	/   ENTRY) TO ALLOW FOR GROUPING PARENS.
	LAC TRW1		/RESET ALL DO-TABLE POINTERS TO FIRST
	JMS RSVDTP	/   ENTRY IN THE IMPLIED-DO-TABLE.
/I/O LIST PROCESSOR -- SCAN 2.
RW23	JMS GETA2N	/GET AN ARG/OP PAIR FROM ELEMENT LIST
RW231	LAC LEVNOP	/IF THE OP-LEVEL IS GREATER THAN OR EQUAL
	JMS TWOCMA	/   TO THE BASE LEVEL AT LEAST ONE SET OF
	TAD PARLHI	/   DO-CODING MUST BE OUTPUT AT THIS TIME.
	SMA!SZA		/   IF NOT, OP IS CHECKED FOR DO-CLEANUP
	JMP RW29		/   REQUIREMENTS OR OTS ROUTINE CALLS.
	LAC DOTABA	/SAVE DOTABLE POINTERS TO PRESERVE CLEANUP
	DAC TRW3		/   HIERARCHY.
	LAC RWFND		/IF LAST FOUND ENTRY IS AT THE END OF THE
	SAD RWEND		/   DO-TABLE DON'T BOTHER CHECKING THE
	JMP RW24		/   NEXT SUCCESSIVE ENTRY.
	ISZ RWFND		/CHECK NEXT SUCCESSIVE ENTRY IN THE DO-
	LAC* RWFND	/   TABLE.  IF ITS NESTING LEVEL IS THE
	AND Z77700	/   SAME AS THE LAST ONE, ITS DO-CODING
	SAD RWTST		/   MUST BE THE NEXT OUTPUT.
	JMP RW25
RW24	LAC S01200	/SCAN THE DO-TABLE FOR THE NEXT HIGHER
	TAD RWTST		/   (DEEPER) LEVEL OF NESTING.
	JMS SCNLO
	JMP RW25		/FOUND--OUTPUT DO CODING.
	LAC S01200	/NOT FOUND--THERE ARE NO HIGHER LEVELS OF
	JMS SCNLO		/   NESTING.  RESCAN TABLE FOR LOWEST NEST
	JMP RW25		/   LEVEL AND OUTPUT DO-CODING.
	JMP RW405		/NOT FOUND AGAIN--IMPROPER NESTING, E082
RW25	LAC RWFND		/SET DO-TABLEPOINTERS TO THE FOUND ENTRY.
	JMS RSVDTP
	LAC* RWFND	/ZERO OUT THE NESTING LEVEL OF THIS ENTRY
	AND S00077	/   TO ENSURE THAT IT WILL NEVER BE FOUND
	DAC* RWFND	/   IN/   IN A SCAN AGAIN.
	JMS DOCODE	/OUTPUT DO-CODING
	LAC TRW3		/RESTORE DO-TABLE POINTERS TO THEIR SAVED
	JMS RSVDTP	/   VALUES.
	LAC PARLHI	/BUMP PAREN BASE LEVEL BY 10 AND GO BACK
	TAD S01200	/   AND CHECK IF ANY MORE SETS OF DO-CODE
	DAC PARLHI	/   MUST BE OUTPUT AT THIS TIME.
	JMP RW231
/ CHECK NOP FOR DO-CLEANUP (OPI=EQUAL SIGN)
RW29   LAC    OPVALU
       SAD    C00001	     /CHECK (NOP) FOR EQUAL SIGN
       SKP		     /	 YES, OUTPUT DO-CLEANUP
       JMP    RW31	     /	 NO, OUTPUT I/O BUFFER CALL
       JMS    DCLOUT
       JMS    INCDTP
       LAC    LEVNOP	     /SKIP OVER DO PARAMETERS IN ELEMENT LIST.
       DAC    TRW2
RW30   JMS    GETA2N	     /FETCH ARGI/OPI UNTIL LEVEL(OP) DROPS 10.
       LAC    LEVNOP
       SAD    TRW2
       JMP    RW30
       LAC    PARLHI	     /DECREMENT PAREN BASE LEVEL BY 10.
       TAD    Z76600
       DAC    PARLHI
       JMP    RW38	     /CONTINUE WITH SCAN 2.
/ROUTINE TO OUTPUT CODING FOR OBJECT-TIME I/O BUFFER CALL
RW31   LAC    OPVALU	     /CHECK NOP FOR (S OPERATOR. IF SO, OUTPUT
       SAD    C00029	     /	 SUBSCRIPT CODING.
       JMP    RW32
       LAC    FORMST	     /NOT SUBSCRIPTED, BRANCH PER BCD OR BINARY.
       SZA
       JMP    RW33	     /BCD
       JMP    RW35	     /BINARY
RW32   JMS    OUTSSC	     /OUTPUT SUBSCRIPT CODING, AND RESET ARGI
       JMS    TREST	     /AND OPI TO BOTTOM OF LIST (SUBSCRIPT
/			    /PORTION)
       LAC    FORMST	     /BRANCH PER BCD OR BINARY.
       SZA
       JMP    RW34	     /BCD
       JMP    RW36	     /BINARY
RW33   LAC*   ARG	     /CHECK BCD ARG FOR ARRAY
       SMA
       JMP    RW34
       LAC    C00045	     /BCD ARRAY I/O -- .FA
       JMP    RW37
RW34   LAC    C00046	     /BCD ELEMENT I/O -- .FE
       JMP    RW37
RW35   LAC*   ARG	     /CHECK BINARY ARG FOR ARRAY
       SMA
       JMP    RW36
       LAC    C00048	     /BINARY ARRAY I/O -- .FB
       JMP    RW37
RW36   LAW    -15	     /BINARY ELEMENT I/O -- INTEGER -- .FI
       JMS    SHIFT	     /			    REAL    -- .FJ
       LAC    MODEA2	     /			    DOUBLE  -- .FK
       TAD    C00049	     /			    LOGICAL -- .FL
RW37   JMS    OPOPA2	     /OUTPUT OP/ARG WHERE OP IS IN AC.
       LAC    ARG
RW38   LAC    LEVNOP   /EXIT CHECKING.
/			     /IF LEVEL(OPI).NE.ZERO, CONTINUE WITH
       SZA		     /	 SCAN 2.
       JMP    RW40
       LAC    TRW1
       JMS    RSVDTP
       LAC    OPVALU	      /IF LEVEL(OPI).EQ.ZERO, (OPI) MUST BE
/			     /	 EITHER A C/R OR A COMMA.  IF NOT,
/			     /	 AN ERROR IS ANNOUNCED.
       SNA
       JMP    RW41	     /IF C/R, EXIT
	.IFUND	ERMSG
       SAD    C00030
       JMP    RW19	     /IF COMMA, GO TO SCAN 1
ER24X	JMP EX
	.ENDC
	.IFDEF	ERMSG
ER24X	ERS	<'  24X'>,<SAD C00030>,EX
	JMP	RW19
	.ENDC
RW40   LAC    OPVALU	      /IF OP=C/R, ANNOUNCE ERROR.
       SZA
       JMP    RW23
RW405  LAC    TRW1
/       JMS    RSVDTP
/	JMP ED
ER02D	ERN	<'  02D'>,<JMS RSVDTP>,ED
RW41   LAC    FORMST	     /IF (OPI)	IS A C/R, A CALL TO THE APPRO-
       SNA		     /	 PRIATE CLEANUP ROUTINE IS OUTPUT
       JMP    RW43	     /	 ACCORDING TO WHETHER THIS I/O CALL IS
RW42   LAC    OPTR47	     /	 BCD OR BINARY.
       SKP
RW43   LAC    OPTR53
       JMS    EXP580
       XOR    JMSCMD
       JMP    STEXIT	     /END OF STATEMENT -- EXIT
       .EJECT
/SUBROUTINE TO GET ARG2/NOP FROM ELEMENT LIST
/ CALLING SEQUENCE -- JMS    GETA2N
GETA2N CAL    0
       ISZ    ARGI	     /BUMP ARGUMENT LIST POINTER AND UPDATE
       LAC    ARGI	     /	 ARG AND ARG2.
       DAC    ARG2
       LAC*   ARGI
       DAC    ARG
	JMS SETA2	/UPDATE ADDRA2,MODEA2, AND TYPEA2.
       LAC    ADDRA2
       TAD    K00001
       DAC    NOP
	JMS FAKE
       LAC*   NOP
       DAC    S
       ISZ    OPI	     /BUMP OPERATOR LIST POINTER AND UPDATE
       LAC    OPI	     /	 OP AND NOP.
       DAC    NOP
       LAC*   OPI
       DAC    OP
       AND    S00077
       DAC    OPVALU	     /UPDATE OPVALU.
       TAD    K00029
       SNA!CLA
       LAC    Z76600
       TAD    OP
       AND    T77700
       DAC    LEVNOP	     /UPDATE LEVNOP. (-10 IF OP=(S.)
       JMP*   GETA2N
       .EJECT
/SUBROUTINE TO SCAN IMPLIED-DO-TABLE NESTING LEVELS.
/CALLING SEQUENCE: LAC LOWEST NEST LEVEL
/		   JMS SCNLO
/		   JMP FOUND
/		   JMP NOTFOUND
/EXIT WITH RWTST IN ACCUMULATOR.
SCNLO  CAL    0
       DAC    RWTST
       LAW    -12	     /SET MAX. LOOP COUNT
       DAC    TRW2
SCN1   LAC    TRW1	     /SET POINTER TO TOP OF TABLE
       DAC    RWFND
SCN2   LAC*   RWFND
       AND    Z77700
       SAD    RWTST	     /EXIT WHEN LEVELS MATCH
       JMP*   SCNLO
       LAC    RWFND	     /TEST FOR END OF TABLE
       SAD    RWEND
       JMP    .+3
       ISZ    RWFND	     /NO, BUMP POINTER.
       JMP    SCN2
       LAC    RWTST	     /YES, BUMP LEVEL
       TAD    S01200
       DAC    RWTST
       ISZ    TRW2
       JMP    SCN1
       ISZ    SCNLO
      JMP*   SCNLO
       .EJECT
/BACKSPACE, REWIND, AND ENDFILE STATEMENT PROCESSORS.
/      BACKSPACE ENTRY = BACKSP
/      REWIND L  ENTRY = REWIND
/      ENDFILE	 ENTRY = ENDFIL
ENDFIL LAC    C00001
REWIND TAD    C00001
BACKSP TAD    C00035
       DAC    TRW1           /SAVE OUTPUT OP-VALUE
       JMS    FIARGO         /FETCH UNIT NO. = .DAT SLOT
       JMS    IODEV          /OUTPUT I/O DEVICE INFORMATION FOR LOADER.
       LAC    TRW1           /OUTPUT SUBROUTINE CALL.
ENDF01	JMS OPOPA2
       LAC    ARG
       JMP    CRTEST         /EXIT
       .EJECT
/SUBROUTINE TO OUTPUT IODEV LOADER INFORMATION
/ CALLING SEQUENCE -- JMS    IODEV
IODEV  CAL    0
       DZM    CTRLSW+1       /SET OTS I/O INITIALIZER CALL REQUIRED.
       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
       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    TSTDTP         /TEST DO-TABLE NESTING LEVEL.
       JMS    FDFSNO         /FETCH DEFINED STATEMENT NO.
	LAC SYMTBC	/SUCCESSFUL FETCH - STORE SYMBOL TABLE
       DAC*   DOTABA         /   ADDRESS IN DO-TABLE (WORD A).
       DZM    UNFNBC         /UNFETCH CHARACTER.
       JMS    INAOPI         /INITIALIZE ELEMENT LIST.
DO02   JMS    ENTERI         /FETCH INTEGER ARG/OP AND ENTER IN LIST.
	JMS CTRL60	/CONTINUE ENTERING ARG/OP PAIRS IN LIST
       JMP    DO02           /   UNTIL (OP) = CARRIAGE RETURN.
       JMS    INAOPI         /RE-INITIALIZE ELEMENT LIST.
       LAC    C00001         /SET DO PARAMETER INDEX TO START OF LIST.
       JMS    DOCODE         /OUTPUT DO-CODING.
       JMS    INCDTP         /BUMP DOTAB POINTERS.
       JMP    STEXIT         /EXIT
       .EJECT
/SUBROUTINE TO INITIALIZE DO-TABLE
/ CALLING SEQUENCE -- JMS    INDOTB
INDOTB CAL    0              /SET DOTABA, DOTABB, AND DOTABC POINTERS
	.IFUND	IMBED
       LAC*   .FFREE         /   TO THE FIRST ADDRESS OF EACH OF THREE
	.ENDC
	.IFDEF	IMBED
	LAC	.FFREE
	.ENDC
       JMS    RSVDTP         /CONSECUTIVE TABLES.
       JMP*   INDOTB
       .EJECT

/SUBROUTINE TO TEST DO-TABLE POINTERS.
/ CALLING SEQUENCE -- JMS    TSTDTP
TSTDTP CAL    0
       LAC    DOTABC         /IF POINTER FOR WORD C IS POINTING
/       SAD    SYMTB0         /  AT THE FIRST WORD OF THE SYMBOL
/       JMP EL                   /  TABLE, DO-TABLE SIZE HAS BEEN
ER01L	ERN	<'  01L'>,<SAD SYMTB0>,EL
       JMP*   TSTDTP         /  EXCEEDED.
       .EJECT
/SUBROUTINE TO INCREMENT DO-TABLE POINTERS.
/ CALLING SEQUENCE -- JMS    INCDTP
INCDTP CAL    0
       LAC    DOTABA
       TAD    C00001
       JMS    RSVDTP
       JMP*   INCDTP         /EXIT
       .EJECT
/SUBROUTINE TO DECREMENT DO-TABLE POINTERS.
/ CALLING SEQUENCE -- JMS    DECDTP
DECDTP CAL    0              /ARE POINTERS LESS THAN OR EQUAL TO THEIR
/       LAC    DOTABA         /   MINIMUMS.
/	SAD* .FFREE
/	JMP ED		/ERROR: MISSING DO PARAMETER.
/ER03D	ERN	<'  03D'>,<SAD* .FFREE>,ED
       CLC                   /NO -- DECREMENT POINTERS.
       TAD    DOTABA
       JMS    RSVDTP
       JMP*   DECDTP         /EXIT
       .EJECT
/SUBROUTINE TO RESOLVE DO-TABLE POINTERS.
/CALLING SEQUENCE -- JMS RSVDTP (DOTABA IN AC)
RSVDTP CAL    0
       DAC    DOTABA
       TAD    C00010
       DAC    DOTABB
       TAD    C00010
       DAC    DOTABC
       JMP*   RSVDTP
       .EJECT
/SUBROUTINE TO OUTPUT DO-CODING
/ CALLING SEQUENCE -- LAC    DO-PARAMETER ELEMENT LIST INDEX
/		   JMS   DOCODE
DOCODE CAL    0
       TAD    K00001
       DAC    TRW2           /TEMP STORE LIST INDEX.
       JMS    EXP540         /TEMP STORE ARGI, OPI
       LAC    ARG0           /CONSTRUCT NEW ARGI AND OPI FROM LIST
       TAD    TRW2           /   INDEX.
       DAC    ARGI
       LAC    OP0
       TAD    TRW2
       DAC    OPI
       JMS    GETA2N         /FIRST OP MUST BE EQUAL SIGN -- IF NOT,
       LAC    OPVALU         /   AN ERROR IS ANNOUNCED.
/       SAD    C00001
/       SKP
/DO14	JMP ED	/ERROR: ILLEGAL CONSTRUCTION OF DO-PARAMETERS.
ER04D	ERS	<'  04D'>,<SAD C00001>,ED
       LAC    LEVNOP         /TEMP STORE LEVEL OF FIRST OP.
       DAC    TRW2
       LAC    ARG           /FIRST ARG = CONTROL VARIABLE. (I)
       DAC    DOI
       JMS    VARTST
       JMS    GETA2N        /BUMP ELEMENT LIST POINTERS.
	JMS PNZCV
       LAC    OPVALU         /SECOND OP MUST BE COMMA.  
/       SAD    C00030
/       SKP
/       JMP    DO14		/ERROR: NO COMMA.
ER05D	ERS	<'  05D'>,<SAD C00030>,ED
       LAC    ARG           /SECOND ARG = INITIAL PARAMETER. (M1)
       DAC    DOM1
       JMS    GETA2N         /BUMP ELEMENT LIST POINTERS.
       JMS    PNZCV
       LAC    ARG            /THIRD ARG = TERMINAL PARAMETER. (M2)
       DAC    DOM2
       LAC    OPVALU         /IF THIRD OP IS A C/R, SET (M3)=0 AND
       SNA		/OUTPUT CODE.
       JMP    DO10
/       SAD    C00030         /IF THIRD OP IS NOT A COMMA, 
/	SKP
/       JMP    DO14		/ERROR: NO COMMA.
ER06D	ERS	<'  06D'>,<SAD C00030>,ED
       LAC    LEVNOP         /IF OP-LEVEL HAS CHANGED, SET (M3)=0 AND
/		         /   OUTPUT CODE.  IF NOT, GET NEXT ARG/OP
       SAD    TRW2           /   PAIR.
       SKP
       JMP    DO10
       JMS    GETA2N         /BUMP ELEMENT LIST POINTERS.
       JMS    PNZCV
       LAC    ARG            /FOURTH ARG = INCREMENTATION PARAMETER.(M3)
       DAC    DOM3
       LAC    OPVALU         /IF FOURTH OP IS A C/R, OUTPUT CODE.
	SNA
       JMP    DO11
/       SAD    C00030         /IF FOURTH OP IS NOT A COMMA, 
/	SKP
/       JMP    DO14		/ERROR: OP-LEVEL NOT CHANGED.
ER07D	ERS	<'  07D'>,<SAD C00030>,ED
       LAC    LEVNOP         /IF OP-LEVEL HAS NOT CHANGED, 
/       SAD    TRW2
/       JMP    DO14		/ERROR: OP-LEVEL NOT CHANGED.
ER08D	ERN	<'  08D'>,<SAD TRW2>,ED
       JMP    DO11
DO10   DZM    DOM3
DO11   JMS    TREST           /RESTORE ARGI AND OPI.
/DO-CODE OUTPUT SECTION
       LAC    C00004	     / (LAC  M1)
       JMS    OPOPA2
       LAC    DOM1
       LAC    PC	     / (JMP  PC+3)
       XOR    JMPCMD
       TAD    C00003
       JMS    RELBIN
       LAC    PC	     /PC TO DO-TABLE, WORD B
       DAC*   DOTABB
       LAC    C00004	     / (LAC I)
       JMS    OPOPA2
       LAC    DOI
       LAC    DOM3	     /TEST FOR INCREMENTATION PARAMETER -- IF
       SZA		     /	 NONE SPECIFIED (DOM3=0) ASSUME M3=1.
       JMP    DO12
       JMS    EXP730	     / (TAD 000001)
       JMP    DO13
DO12   LAC    C00015	     / (TAD M3)
       JMS    OPOPA2
       LAC    DOM3
DO13   LAC    C00008	     / (DAC I)
       JMS    OPOPA2
       LAC    DOI
       CLA		     / (CMA  ) AND (TAD  000001)
       JMS    EXP570
       LAC    C00015	     / (TAD  M2)
       JMS    OPOPA2
       LAC    DOM2
       LAC    DOM2
       LAC    SPACMD	     / (SPA   )
       JMS    ABSBIN
       LAC    PC	     /PC TO DO-TABLE, WORD C.
       DAC*   DOTABC
       XOR    JMPCMD	     / (JMP   PC)
       JMS    RELBIN
       JMP*   DOCODE	     /EXIT
       .EJECT
/SUBROUTINE TO CHECK FOR AND PERFORM DO-CLEANUP OPERATIONS.
/ CALLING SEQUENCE -- JMS    DOCLEN
DOCLEN CAL    0
DO20=.
	.IFUND	IMBED
	LAC*	.FFREE
	.ENDC
	.IFDEF	IMBED
	LAC	.FFREE
	.ENDC
/DO20   LAC*   .FFREE	     /IF THERE ARE NO ENTRIES IN DO-TABLE, AN
       SAD    DOTABA	    /  IMMEDIATE EXIT IS TAKEN
       JMP*   DOCLEN
       JMS    DECDTP
       LAC*   DOTABA	     /GET DO-TABLE ENTRY (WORD A).
       SAD    LABEL	     /IF TABLE ENTRY = CURRENT STATEMENT, CHECK
       SKP		     /	 FOR LEGAL RANGE TERMINATION.  IF NOT,
       JMP    DO21	     /	 CHECK FOR IMPROPER NESTING.
       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    DCLOUT	     /STATEMENT TYPE O.K. -- OUTPUT DO-CLEANUP
       JMP    DO20	     /TEST NEXT LOWER NESTING LEVEL.
DO21   LAC    DOTABA	     /TEMP STORE DOTABLE POINTER
       JMP    DO27
DO22	TAD	K00001	/DECREMENT NEST LEVEL
       DAC    TRW2
       LAC*   TRW2	     /	 NO, TEST STATEMENT.
       SAD    LABEL	     /AN ERROR IS ANNOUNCED IF CURRENT STATE-
       JMP    DO25	     /	 MENT = ANY TABLE ENTRY OF LOWER NEST
	LAC	TRW2	/LEVEL.
/DO27	SAD*	.FFREE	/IS NEST LEVEL = 0
DO27=.
	.IFUND	IMBED
	SAD*	.FFREE
	.ENDC
	.IFDEF	IMBED
	SAD	.FFREE
	.ENDC
	JMP	DO26	/YES,TABLE SEARCH COMPLETE.
	JMP	DO22	/SEARCH  MORE
/DO24   DZM    LABEL
/	JMP ED		/ERROR: ILLEGAL STMT TERMINATES DO-LOOP.
DO24=.
ER09D	ERN	<'  09D'>,<DZM LABEL>,ED
/DO25   DZM    LABEL
/	JMP EL		/ERROR: IMPROPER DO NESTING.
DO25=.
ER02L	ERN	<'  02L'>,<DZM LABEL>,EL
DO26   JMS    INCDTP
       JMP*   DOCLEN
       .EJECT
/SUBROUTINE TO OUTPUT DO-CLEANUP CODING
/ CALLING SEQUENCE -- JMS    DCLOUT
DCLOUT CAL    0
       LAC*   DOTABB	     /OUTPUT COMMAND TO REENTER DO-CODING.
       XOR    JMPCMD
       JMS    RELBIN
       LAC*   DOTABC	     /STRING ADDRESS FOR EXIT FROM DO-LOOP.
       JMS    STRING
       JMP*   DCLOUT	     /EXIT
TREST  CAL    0
       LAC    TARGI
       TAD    K00001
       DAC    ARGI
       LAC    TOPI
       TAD    K00001
       DAC    OPI
       JMS    GETA2N
       JMP*   TREST
       .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.
/       SNA
/RW85	JMP EN		/ERROR: FORMAT STMT HAS NO STMT NUMBER.
ER04N	ERN	<'  04N'>,SNA,EN
       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.
RW62	SAD S00057
/       JMP    RW76	     /IF SLASH
	JMP	RW60
       SAD    S00051
       JMP    RW71	     /IF RIGHT PAREN.
RW63   SAD    S00055
       JMP    RW72	     /IF MINUS SIGN.
RW635  SAD    S00050
       JMP    RW75	     /IF LEFT PAREN.
       JMS    NUMCHK
       JMP    RW635	     /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
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   JMS    NUMCHK
       JMP    RW67	     /IF NUMBER, ITS W-VALUE.
	.IFUND	ERMSG
ER02F       JMP    EF	     /ERROR: MISSING FIELD WIDTH.  
	.ENDC
	.IFDEF	ERMSG
ER02F	ERS	<'  02F'>,SKP,EF
	.ENDC
RW67   LAC    LS
/       SNA
/       JMP    RW86	     /ERROR: FIELD WIDTH IS ZERO.  
ER03F	ERN	<'  03F'>,SNA,EF
       DZM    NUMFLG	     /RESET NUMERIC FLAG AND CHECK XCHAR FOR
       LAC    XCHAR	     /	 A PERIOD.
       SAD    S00056
       JMP    RW68	     /IF PERIOD, CONVERSION MUST BE FLOATING.
       LAC    FLOATF	     /IS CONVERSION D, E, F, OR G.
/       SZA
/	JMP RW86		/ERROR: ILLEGAL W IN NSW.D.
ER04F	ERN	<'  04F'>,SZA,EF
       LAC    XCHAR	     /	 NO, GET NEXT CONVERSION.
       JMP    RW61
RW68   LAC    FLOATF	     /IS CONVERSION D, E, F, OR G.
/       SNA
/	JMP RW86		/ERROR: ILLEGAL W IN NSW.D.
ER05F	ERN	<'  05F'>,SNA,EF
       JMS    FMTFCH	     /	 YES, GET D-VALUE.
       JMS    NUMCHK
       JMP    RW69
	.IFUND	ERMSG
ER06F	JMP EF		/ERROR: MISSING D-VALUE.
	.ENDC
	.IFDEF	ERMSG
ER06F	ERS	<'  06F'>,SKP,EF
	.ENDC
RW69   DZM    NUMFLG
       JMP    RW61	     /GET NEXT CONVERSION.
/COMMA	PROCESSOR.
RW70   LAC    FPCNT	     /CHECK PAREN COUNT.
/       SPA!SNA
/	JMP RW86		/ERROR: MISSING LEFT PAREN.
ER07F	ERN	<'  07F'>,SPA!SNA,EF
       JMS    FMTFCH
	SAD	S00057
	JMP	.-2
       JMP    RW63	     /REENTER SKIP CHAIN
/RIGHT PAREN PROCESSOR.
RW71   CLC		     /DECREMENT PAREN COUNT.
       TAD    FPCNT
       DAC    FPCNT
       SMA!SZA		     /IF PAREN COUNT ZERO, EXIT -- IF NOT ZERO,
       JMP    RW60	     /	 GET NEXT CONVERSION.
       JMP    RW83
/MINUS SIGN PROCESSOR.
RW72   JMS    FMTFCH	     /FETCH NEGATIVE SCALE FACTOR
       JMS    NUMCHK
       JMP    RW73
	.IFUND	ERMSG
ER08F	JMP EF		/ERROR: MINUS NOT FOLLOWED BY A NUMBER.
	.ENDC
	.IFDEF	ERMSG
ER08F	ERS	<'  08F'>,SKP,EF
	.ENDC
RW73   DZM    NUMFLG
/       SAD    S00120	     /CHECK CHARACTER FOLLOWING SCALE FACTOR
/       JMP    RW74	     /	 FOR P.
/	JMP RW86		/ERROR: P MISSING.
ER09F	ERS	<'  09F'>,<SAD S00120>,EF
RW74   JMS    FMTFCH	     /FETCH NEXT CHARACTER.
       JMP    RW64	     /REENTER SKIP CHAIN.
/LEFT  PAREN PROCESSOR.
RW75   ISZ    FPCNT	     /BUMP PAREN COUNT.
/SLASH PROCESSOR
RW76   JMS    FMTFCH	     /FETCH NEXT CHARACTER.
       JMP    RW62	     /REENTER SKIP CHAIN.
/P PROCESSOR
RW77   LAC    NUMFLG	     /IS P PRECEDED BY A NUMBER.
/       SNA
/	JMP RW86		/ERROR: NO NUMBER PRECEDING P.
ER10F	ERN	<'  10F'>,SNA,EF
       JMS    FMTFCH	     /	 YES, FETCH NEXT CHAR.
       JMP    RW64	     /REENTER SKIP CHAIN
/H PROCESSOR
RW78   LAC    NUMFLG	     /IS H PRECEDED BY A NUMBER.
/       SNA
/	JMP RW86		/ERROR: NO NUMBER PRECEDING H.
ER11F	ERN	<'  11F'>,SNA,EF
       DZM    NUMFLG
       LAC    LS	     /	 YES, IS THE NUMBER = ZERO.
/       SNA
/	JMP RW86		/ERROR: ZERO PRECEDING H.
ER12F	ERN	<'  12F'>,SNA,EF
       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.
/       SNA
/	JMP RW86		/ERROR: NO NUMBER PRECEDING X.
ER13F	ERN	<'  13F'>,SNA,EF
       DZM    NUMFLG
       LAC    LS	     /	 YES, IS THE NUMBER = ZERO.
/       SNA
/RW86	JMP EF	/ERROR: ILLEGAL W IN NSW.D.
ER14F	ERN	<'  14F'>,SNA,EF
       JMP    RW60	     /	    NO, REENTER SKIP CHAIN AT TOP.
/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
	.EOT
