	.TITLE FORTRAN IV - V12A (TAPE 1 EDIT #10:10-22-70)
/
/FORTRAN 4 COMPILER 
/
/COPYRIGHT 1969, DIGITAL EQUIPMENT
/CORP., MAYNARD, MASS.
/
/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 
/        PDP9=0 ASSEMBLE FOR PDP9
/        IF PTP,PDP7, AND PDP9 ARE UNDEFINED, ASSEMBLE
/	FOR A PDP-15 SYSTEM
/	IF IMBED DEFINED USE IMBEDDED I/O
/	IF K16 DEFINED MAKE EXPANDED FORTRAN
/	IF BF DEFINED MAKE BACKGROUND/FOREGROUND VERSION
/	IF BIN DEFINED MAKE RELOCATABLE VERSION
/
	.IFUND BANK
BANK=0
	.ENDC
	.IFUND	PDP7
	.IFUND	PDP9
PDP15=0
	.IFUND	BF
	.IFUND	IMBED
X4K=0
	.ENDC
	.ENDC
	.ENDC
	.ENDC
	.IFDEF	K16
KF16=0
X4K=0
	.ENDC
	.IFDEF	KF16
BIN=0
	.ENDC
	.IFDEF	BIN
	.IODEV	-11,-12,-13
	.ENDC
BASE1=3635
APTP=0
A%F2=0
B%F2=0
C%F2=0
D%F2=0
E%F2=0
APDP7=0
APDP15=0
BPDP15=0
CPDP15=0
ABF=0
AIMBED=0
%F4I=0
AX4K=0
BX4K=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
	.IFUND	PTP
	.IFDEF	BF
ABF=141
	.ENDC
	.ENDC
	.IFDEF %F2
A%F2=1273
B%F2=6
C%F2=27
D%F2=-13
E%F2=-7
	.ENDC
	.IFDEF PDP7
APDP7=-154
	.ENDC
	.IFDEF PDP15
APDP15=-22
BPDP15=1
CPDP15=1
	.ENDC
	.IFDEF	IMBED
AIMBED=232+D%F2+BPDP15
	.IFDEF	X4K
	.END
	.ENDC
	.IFDEF	PTP
	.END
	.ENDC
	.ENDC
	.IFDEF	X4K
AX4K=-344+C%F2
BX4K=1
	.ENDC
	.IFDEF	PTP
APTP=230+E%F2+CPDP15+BX4K
	.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
	.IFUND	BIN
	.ABS
	.LOC BANK*20000+BASE1+APTP+AIMBED+A%F2+APDP7+APDP15+ABF+AOPS
	.ENDC
	.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
SINBFH=.
	.ENDC
	.IFUND	IMBED
BEGIN	LAC DLNOP
	DAC RSTRT
	LAC* S00100
	AND S60000	/GET BANK BITS
	DAC BNKBTS
	.IFUND	BIN
	.IFUND	PTP
	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
	.ENDC
	.ENDC
/
/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=.
	.IFUND	PTP
	CAL 767		/.INIT INPUT (-11)
	1
	INIT02
	0
	LAC .-1
	SAD S00377
	JMP .+3		/BULK STORAGE
	LAC DLNOP		/NOT BULK STORAGE
	SKP
	LAC DLJMP
	.ENDC
	.IFDEF	PTP
	LAC	DLNOP
	.ENDC
	DAC EPS1SW	/INTO END PASS 1 SWITCH
	JMP	BUGF1
DLNOP	JMS SUB990
DLJMP	JMP INIT01
	.IFDEF	X4K
DL1	JMS	SYMSAF
DL2	JMS	CONSAF	/CHECK FOR BOUNDARY
	.ENDC
	.IFUND	BIN
	.IFUND	PTP
BNKTAB	MODF
BNKCTR	0
BNKTMP	0
	.ENDC
	.ENDC
	.IFDEF	X4K
ENDIN1	SYMSAF-1
S07777	7777
S70000	70000
	.ENDC
	.IFUND	BIN
	.IFUND	PTP
/ADDRESS TABLE-OVERLAYED
MODF=.
	OVRLAY+2
	N00767+2
	INM11
	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
	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
	NMODE
	SINPUT+3
	OBINRY+4
	.IFUND %F2
	OBJ521+4
	OBJ545
	OBJ400
	.ENDC
	OPTRAN
	RELOPC
	LOCTAB
	LOCTBM
	CHRTAB
	CHRTBX
MODL=.
MODCT	MODL-MODF\777777+1
	.ENDC
	.ENDC
	.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               /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 17
	-1
BUGF1	LAC	DLCR
	DAC	SINBFH+44
	LAC	ENDINT
	DAC	CONTB0
	.IFDEF	IMBED
BEGIN=.
	.ENDC
	LAC	DL155
	DAC	BINBFH
	JMP	INIT02
DL155	15500
DLCR	64000
ENDINT	BEGF4
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
	.IFUND	KF16
SSCTR=OSYMBL                 /SPECIFIED SUBSCRIPT COUNTER
	.ENDC
	.IFDEF	KF16
SSCTR	0
	.ENDC
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
RSTRT	JMP	BEGIN
	.ENDC
	.IFDEF	IMBED
INIT02=.
RSTRT	JMS	INITIO
	JMS	SUB990
	.ENDC
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
/
	.IFUND	IMBED
	CAL	767		/.INIT -11
	1
INM11	INIT02
START	0
	.ENDC
	LAC CHR1	/INTERNAL FOR CR AND ESC IS 36
	DAC CHARCR
	LAC CHR2
	DAC CHARLT
	.IFDEF	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*                 /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
	SMA		/DIGIT STRING OF 1 TO 5 DECIMAL DIGITS.
	JMP	CTR01
	CLA
	JMP	CTRL03
CTR01       AND    S60000         /WHEN A STATEMENT LABEL IS PRESENT, ITS
       SNA                   /ASSIGNMENT WORD IS EXAMINED TO DETERMINE
       JMP    CTRL04         /IF THE LABEL HAS PREVIOUSLY BEEN
       LAC*   SYMTBC         /ASSIGNED.
       AND    S17777         /A PREVIOUS ASSIGNMENT MAY HAVE OCCURED
       SAD    PC             /DURING THIS PASS OR IT MAY HAVE OCCURED
       JMP    CTRL05         /LAST PASS. THE DEFINITION OF THE LABEL
	DAC	PC		/SET PC EQUAL TO WHAT IT WAS ON PASS 1
/	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    CTRL05         /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
       JMP   CTRL11         /01   NUMERIC       0123456789
       JMP   CTRL12         /02   ALPHABETIC    BCJKMNOQRSTUVWYZ
       JMP   CTRL12         /03   ALPHABETIC    ED
       JMP   CTRL12         /04   ALPHABETIC    AEFGHILPX
       JMP   CTRL13         /05   OPERATOR      +-
       JMP   CTRL13         /06   OPERATOR      */
       JMP   CTRL13         /07   PERIOD        .
       JMP   CTRL14         /08   PARENTHESIS   (
       JMP   CTRL15         /09   PARENTHESIS   )
       JMP   CTRL16         /10   DELIMETER     ,=
       JMP   CTRL13         /11   SPACE
/
/ SYMBOLIC MODE ROW
CTRLSM JMP   CTRLSM         /TYPE CHARACTER
       JMP   CTRL18         /01   NUMERIC       0123456789
       JMP   CTRL18         /02   ALPHABETIC    BCJKMNOQRSTUVWYZ
       JMP   CTRL18         /03   ALPHABETIC    ED
       JMP   CTRL18         /04   ALPHABETIC    AFGHILPX
       JMP   CTRL13         /05   OPERATOR      +-
       JMP   CTRL13         /06   OPERATOR      */
       JMP   CTRL13         /07   PERIOD        .
       JMP   CTRL14         /08   PARENTHESIS   (
	JMP CTRL15	/09    PARENTHESIS )
	JMP CTRL16	/10   DELIMITER ,=
	JMP CTRL18	/11   SPACE
/
/NUMERIC MODE ROW
CTRLNM	JMP CTRLNM	/TYPE CHARACTER
	JMP CTRL18	/01 NUMERIC 0123456789
	JMP CTRL13	/02 ALPHABETIC BCJKMNOQRSTUVWYZ
	JMP CTRL13	/03 ALPHABETIC ED
	JMP CTRL19	/04 ALPHABETIC AFGHILPX
	JMP CTRL13	/05 OPERATOR +-
	JMP CTRL13	/06 OPERATOR */
	JMP CTRL13	/07 PERIOD .
	JMP CTRL14	/08 PARENTHSEIS (
	JMP CTRL15	/09 PARENTHESIS )
	JMP CTRL16	/10 DELIMETER ,=
	JMP CTRL18	/11 SPACE
	.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 MEM