	.TITLE FORTRAN IV - V10A (TAPE 2 EDIT #4:9-25-70)
/
/FORTRAN 4 COMPILER
/
/COPYRIGHT 1969, DIGITAL EQUIPMENT
/CORP. MAYNARD, MASS.
/
/SUBROUTINE TO FETCH, TEST, PACK, AND OUTPUT A FORMAT CHARACTER.
/  CALLING SEQUENCE -- JMS   FMTFCH
FMTFCH CAL    0
       LAC    HFLG           /TEST HOLLERITH FLAG.  IF SET, FETCH CHAR-
       SNA                   /   ACTER.  IF NOT SET, FETCH NON-BLANK
       JMP    FMTFC0         /   CHARACTER.
       JMS    FETCHR
       SKP
FMTFC0 JMS    FNBCHR
/       JMS    CTRL60         /TEST XCHAR FOR CARRIAGE RETURN.
/       SKP                /   NO, OK.
/	JMP EF		/ERROR: TOO MANY LEFT PARENS.
ER15F	ERS	<'  15F'>,<JMS CTRL60>,EF
       JMS    FMTPAK         /PACK XCHAR IN MS/LS.
       JMS    FMTOUT         /   IF MS/LS FULL, OUTPUT 2 OBJECT WORDS.
       LAC    XCHAR          /EXIT WITH (XCHAR) IN AC.
       JMP*   FMTFCH
       .EJECT
/SUBROUTINE TO SHIFT MS/LS LEFT 7 AND MERGE CHARACTER.
/  CALLING SEQUENCE -- LAC   CHARACTER (ASCII-7)
/		   JMS   FMTPAK
/		   JMP   MS/LS FULL (5 CHARACTERS PACKED)
/                    XXX   MS/LS NOT FULL (1-4 CHARACTERS PACKED)
/  INITIALIZATION -- SET FMTCNT TO -5.
FMTPAK CAL    0
       AND    S00177
       DAC    TRW1           /SAVE CHARACTER TO BE PACKED.
       LAW    -7             /INITIALIZE SHIFT-CONNT.
       DAC    TRW2
FMTPK1 JMS    DSHL           /SHIFT MS/LS 7 LEFT OPEN.
       ISZ    TRW2
       JMP    FMTPK1
       LAC    FLS            /MERGE IN SAVED CHARACTER.
       XOR    TRW1
       DAC    FLS
       ISZ    FMTCNT         /CHECK IF 5 CHARACTERS HAVE BEEN PACKED.
       JMP    FMTPK2         /   NO, BUMP RETURN ADDRESS AND EXIT.
       JMS    DSHL           /   YES, LEFT JUSTIFY MS/LS AND REINITIAL-
       LAW    -5             /        IZE CHARACTER COUNTER.
       DAC    FMTCNT
       JMP*   FMTPAK         /EXIT FOR MS/LS FULL.
FMTPK2 ISZ    FMTPAK         /EXIT FOR MS/LS NOT FULL.
       JMP*   FMTPAK
       .EJECT
/SUBROUTINE TO FILL MS/LS WITH BLANK CHARACTERS
/  CALLING SEQUENCE -- JMS   FMTFIL
/		   JMP   (FILL REQUIRED AND WAS EXECUTED)
/		   XXX   (FILL NOT REQUIRED -- NO CHANGE)
FMTFIL CAL    0
	LAW -5		/IF MS/LS ALREADY CONTAINS 5 CHARACTERS,
       SAD    FMTCNT         /   BUMP RETURN ADDRESS AND EXIT WITH
       JMP    FMTFL2         /   MS/LS UNCHANGED.
FMTFL1 LAC    S00040         /IF MS/LS IS PARTIALLY FULL, PACK BLANKS
       JMS    FMTPAK         /   UNTIL IT IS FULL, THEN EXIT.
       JMP*   FMTFIL
       JMP    FMTFL1
FMTFL2 ISZ    FMTFIL
       JMP*   FMTFIL
       .EJECT
/SUBROUTINE TO OUTPUT M/S
/  CALLING SEQUENCE -- JMS   FMTOUT
FMTOUT CAL    0
       LAC    FMS            /OUTPUT MS
       JMS    ABSBIN
       LAC    FLS            /OUTPUT LS
       JMS    ABSBIN
       JMP*   FMTOUT         /EXIT
       .EJECT
/SUBROUTINE TO CHECK FOR A NUMBER AND COMPLETE ITS CONVERSION.
/  CALLING SEQUENCE -- LAC   CHARACTER (ASCII-7)
/		   JMS   NUMCHK
/		   JMP   YES
/		 XXX   NO 
NUMCHK CAL    0
       JMS    NUMTST         /IS CHARACTER A NUMBER.
       JMP    NUMCH3         /   NO, BUMP RETURN ADDRESS AND EXIT.
       DAC    LS             /   YES, SAVE ITS VALUE.
CLCCMD CLC                   /SET NUMBER FLAG
       DAC    NUMFLG
       DZM    MS
       JMP    NUMCH2         /ENTER LOOP
NUMCH1 DAC    TRW1           /TEMP STORE BINARY INTEGER.
       JMS   MULTEN         /MULTIPLY MS/LS BY 10 AND ADD NEW NUMBER
       LAC    LS             /   TO TOTAL
       TAD    TRW1
       DAC    LS
NUMCH2	JMS FMTFCH	/FETCH NEXT CHARACTER.
       JMS    NUMTST         /IS IT A NUMBER.
       JMP*   NUMCHK         /   NO, EXIT WITH NEXT (XCHAR) IN AC.
       JMP    NUMCH1         /   YES, UPDATE TOTAL.
NUMCH3 ISZ    NUMCHK         /EXIT HERE IF 1ST CHARACTER NON-NUMERIC.
       JMP*   NUMCHK         /EXIT WITH CURRENT XCHAR IN AC.
       .EJECT
/SUBROUTINE TO TEST FOR A NUMBER
/  CALLING SEQUENCE -- LAC   CHARACTER
/		  JMS   NUMTST
/		   JMP   NO
/		   XXX   YES
NUMTST CAL    0
       TAD    Z77706         /IS CHARACTER LESS THEN OR EQUAL TO NINE
       SMA                   /   YES, TEST AGAIN.
       JMP    NUMTS1         /   NO, EXIT.
       TAD    C00010         /IS IT GREATER THAN OR EQUAL TO ZERO.
       SPA                   /   YES, VALID NUMBER.
       JMP    NUMTS1         /   NO, EXIT
       ISZ    NUMTST         /BUMP RETURN ADDRESS AND EXIT WITH BINARY
       JMP*   NUMTST         /   VALUE OF CHARACTER IN AC.
NUMTS1 LAC    XCHAR          /EXIT WITH CHARACTER IN AC.
       JMP*   NUMTST
       .EJECT
/SUBROUTINE TO SHIFT FMS/FLS LEFT ONE OPEN.
/  CALLING SEQUENCE -- JMS   DSHL
DSHL   CAL    0
	LAC FLS
       RCL
       DAC    FLS
       LAC    FMS
       RAL
       DAC    FMS
       JMP*   DSHL
       .EJECT
	.IFUND	%F2
/		     GOTO  ASSIGNMENT STATEMENT PROCESSOR
/		         ASSIGN K TO I
/							
ASSIGN LAC    PC
       TAD    C00002         /OUTPUT .....
       XOR    JMPCMD         /            JMP   .+2
       JMS    RELBIN
       JMS    FDFSNO         /FETCH DEFINED STATEMENT NUMBER.
       JMS    VECBIN         /OUTPUT ...  .DSA    .NNNNN
       LAC    XCHAR          / WAS TERMINATING CHAR A -T-
/       SAD    S00124         /  (EXTERNAL T)
/       SKP                /  YES.CONTINUE.
/ASGN01 JMS    EI          /ERROR IF -TO- NOT PRESENT
ER06I	ERS	<'  06I'>,<SAD S00124>,EI
       JMS    FNBCHR         / CHECK FOR -O-
/       SAD    S00117         /  (EXTENAL O)
/       SKP                   /OK-CONTINUE
/       JMP    ASGN01         /NOT O, REPORT ERROR
ER07I	ERS	<'  07I'>,<SAD S00117>,EI
       LAC    PC
       TAD    K00001
       XOR    LACCMD         /BUILD......  LAC    .-1
       JMS    RELBIN         /OUTPUT INSTRUCTION
       JMS    FIARGO         /FETCH INTEGER ARGUMENT, OP
       JMS    VARTST         /ARGUMENT MUST BE A VARIABLE
       LAC    C00008         /SET STORE INSTRUCTION
       JMP    ENDF01         /OUTPUT INSTRUCTION AND EXIT
	.ENDC
       .EJECT
/		     GOTO  STATEMENT PROCESSOR
/							
GOTO   JMS    FNBCHR         /FETCH NEXT NON-BLANK CHAR
	SAD S00050	/IS CHAR AN OPEN PARENS (?
       JMP    GOTO01         /  YES, IS ((), THIS IS COMPUTED GOTO
       DZM    UNFNBC         /  NO, UNFETCH AND TEST LAST CHAR FOR A-Z
       AND    S00100         / (ALPHA HAS BIT 11 SET)
/       SZA                   / NOT A/Z, MUST BE UNCONDITIONAL GOTO
/	.IFUND	%F2
/       JMP    GOTO07         / IS A-Z, MUST BE ASSIGNED GOTO
/	.ENDC
/	.IFDEF	%F2
/	JMP	EI
/	.ENDC
	.IFUND	%F2
	SZA
	JMP	GOTO07
	.ENDC
	.IFDEF	%F2
ER08I	ERN	<'  08I'>,SZA,EI
	.ENDC
/		     UNCONDITIONAL GOTO
/			 GOTO K				
GOTO13 JMS    AIF500         /FETCH AND BUILD -JMP STATEMENT ADDRESS
       JMP    CRTEST         /EXIT TO TEST FOR C/R IN XCHAR
       .EJECT
/		     COMPUTED GOTO
/		    GOTO (S1,S2,S3,..SN), V
GOTO01 JMS    INAOPI         /INITIALIZE INTEGER ARG, OP
GOTO02 JMS    FDFSNO         /FETCH DEFINED STATEMENT NO.
	DAC ARG		/STORE AS ARG
       LAC    SYMTBC
       DAC    OP
       JMS    ENTER          /ENTER ARG IN LIST
       LAC    XCHAR          /TEST LAST CHAR FOR COMMA (,)
       SAD    S00054         / (EXT 54)
       JMP    GOTO02         / YES, IS COMMA, CYCLE BACK FOR NEXT STMNT
/       SAD    S00051         /  NO, TEST FOR END OF LIST ())
/       SKP    	            /    YES, IS END
/	JMP EX		/ERROR: LIST NOT PROPERLY DELIMITED.
ER04X	ERS	<'  04X'>,<SAD S00051>,EX
       JMS    FNBCHR         /FETCH NEXT NON-BLANK CHARACTER
/       SAD    S00054         / IS IT A COMMA
/       SKP                /  YES
/	JMP EX		/ERROR: LIST NOT PROPERLY DELIMITED.
ER05X	ERS	<'  05X'>,<SAD S00054>,EX
       JMS    FIARGO         /FETCH INTEGER ARG, OP
       JMS    VARTST         /ARGUMENT MUST BE A VARIABLE
       LAC    C00004         /SET INDEX VALVE FOR INTEGER LOAD (LAC)
       JMS    OPOPA2         /OUTPUT PREVIOUS OP, ARG2   (LAC V)
       LAC    ARG
       LAC    CGOMNE         /SET CAT .GO
       JMS    EXP580         /OUTPUT INSTRUCTION (JMS+ .GO)
       XOR    JMSCMD
       LAC    ARGI           /DETERMINE NO OF STATEMENT NOS. IN LIST (N)
       JMS    TWOCMA
       TAD    ARG0           / MOW HAVE (-N)
       JMS    ABSBIN         /OUTPUT (-N)
	JMS EXP540	/INITIALIZE TEMP TO S0
       JMS    INAOPI
GOTO06 ISZ    ARGI           / BUMP POINTER (SN = SN + 1)
       ISZ    OPI
       LAC*   OPI
       DAC    SYMTBC
       LAC*   ARGI           /GET STATEMENT ADDR(N)
       XOR    JMPCMD
       JMS    RELBIN         /OUTPUT AS XFER VECTOR
       LAC    ARGI           /ALL STATEMENTS BEEN OUTPUT
       SAD    TARGI
       JMP    CRTEST         /  YES-EXIT TO TEST FOR C/R IN XCHAR
       JMP    GOTO06         /  NO, CYCLE AGAIN
       .EJECT
	.IFUND	%F2
/		     ASSIGNED  GOTO
/		   GO TO I, (S1, S2, S3,...SN)
GOTO07 JMS    FIARGO         /FETCH INTEGER ARG, OP
       JMS    VARTST         /ARGUMENT MUST BE A VARIABLE
       LAC*   ARG            /STORE ADDRESS OF ARGUMENT (OR ADDRESS OF
       AND    S17777         /(VECTOR IF COMMON OR DUMMY)
       XOR    S20000         / SET INDIRECT BIT
       DAC    ADDRA2
       LAC*   ARG            /IS ARGUMENT COMMON OR DUMMY
       AND    T00000
       SNA
       JMP    GOTO09         / NO, IS LOCAL. GENERATE -JMP* (ARG)-
       LAC    ADDRA2         / YES, IS COMMON OR DUMMY
       XOR    LACCMD         / GENERATE -LAC* (ADDR OF VECTOR)-
       JMS    RELBIN
       LAC    PC
       TAD    C00002
	XOR DACCMD
       JMS    RELBIN         / GENERATE -DAC  .+2-
       LAC    PC
       TAD    C00001
       XOR    JMPCMD
       XOR    S20000
       JMS    RELBIN         / GENERATE -JMP*  .+1
       JMS    ABSBIN         / GENERATE STORAGE SLOT
       JMP    GOTO11
GOTO09 LAC    ADDRA2
       XOR    JMPCMD         /BUILD JMP* ARG
       JMS    RELBIN         /OUTPUT INSTRUCTION
GOTO11 LAC    OPVALU
       SAD    C00030         /IS OP A COMMA
       SKP
       JMP    CRTEST         /NO, EXIT TO TEST FOR C/R IN XCHAR
       JMS    FNBCHR         /YES, GET NEXT CHAR
/       SAD    S00050         / IS CHAR A LEFT PARENTHESIS (
/       SKP             /  YES
/	JMP EX		/ERROR: LIST NO PRECEEDED BY (.
ER06X	ERS	<'  06X'>,<SAD S00050>,EX
GOTO10 JMS    FDFSNO         /FETCH DEFINED STATEMENT NO.
       LAC    XCHAR
       SAD    S00054         /TERMINATED WITH (,)
       JMP    GOTO10         / YES, CYCLE BACK TO FETCH NEXT STATEMENT
/       SAD    S00051         / NO, TERMINATED WITH ())
/       SKP                   / YES
/       JMP    EX             /  NO, ERROR (LIST NOT PROPERLY DELIMITED)
ER07X	ERS	<'  07X'>,<SAD S00051>,EX
	.ENDC
       .EJECT
/ CONTINUE STATEMENT PROCESSOR
/							
CONTIN JMS    FNBCHR         /GET LAST CHARACTER
       JMP    CRTEST         /EXIT AND TEST FOR C/R IN XCHAR
/ PAUSE STATEMENT PROCESSOR
/							
PAUSE  LAC    JMSCMD         /SET UP FOR  JMS* .PA INSTRUCTION
       DAC    POP            / HOLD -JMS-
       LAC    PAMNE          / GET .PA
       JMP    STOP01
/ STOP STATEMENT PROCESSOR
/							
STOP   LAC    JMPCMD         /SET UP FOR  JMP* .ST INSTRUCTION
       DAC    POP            / HOLD -JMP-
       LAC    STMNE          / GET .ST
STOP01 DAC    ARG2           / HOLD .PA OR .ST
       DZM    S              /INITIALIZE CONSTANT TO ZERO
       LAW    -7             /INITIALIZE DIGIT COUNTER
       DAC    ARGCTR
STOP02 JMS    FNBCHR         /FETCH NEXT NON-BLANK CHARACTER
       SAD    C00013         /TEST FOR C/R
       JMP    STOP04         /YES- GO TO OUTPUT
       AND    Z77770         /NO- TEST FOR OCTAL DIGIT (0-7)
	XOR S00060
/       SZA		/YES - GO TO SHIFT INTO CONSTANT
/       JMP    EX             / NO- ERROR  (NON-OCTAL DIGIT)
ER08X	ERN	<'  08X'>,SZA,EX
	LAC	XCHAR	/KEEP ONLY LOW 3 BITS
       AND    C00007
       DAC    XCHAR
       LAC    C00003         / POSITIVE 3 INDICATES SHIFT LEFT 3
       JMS    SHIFT
       LAC    S
       XOR    XCHAR          /ADD IN NEW DIGIT
       DAC    S
	.IFUND	ERMSG
       ISZ    ARGCTR         /BUMP DIGIT COUNTER
       JMP    STOP02         /OK IF .LT. 7 DIGITS
ER09X       JMP    EX             /OR ERROR (TOO MANY DIGITS)
	.ENDC
	.IFDEF	ERMSG
ER09X	ERS	<'  09X'>,<ISZ ARGCTR>,EX
	JMP	STOP02
	.ENDC
STOP04 DZM    NAME0          /SET MODE OF CONSTANT (ABSOLUTE INTEGER)
       JMS    CONSSE         /ENTER CONSTANT IN CONTAB
       DAC    SYMTBC
       LAC*   CONTBC
       AND    S17777
       XOR    LACCMD         /BUILD -LAC ADDRESS OF CONSTANT
       JMS    RELBIN         /OUTPUT INSTRUCTION
       LAC    ARG2           /GET .PA OR .ST
       JMS    EXP580	     /BUILD AND OUTPUT JMS* .PA OR JMP* .ST
       XOR    POP	     / (JMS OR JMP)
       JMP    STEXIT	     /STATEMENT EXIT
       .EJECT
/ DATA STATEMENT PROCESSOR
/
DATA	LAW -1
	DAC DATAFL
	JMS CTRL70	/CATCH STMT LABEL FOR CONTINUE ERROR.
DATA25	JMS INAOPI	/INITIALIZE ARG(I) AND OP(I) LISTS
DATA01 JMS    FVORAR	     /FETCH SIMPLE OR SUBSCRIPTED VARIABLE, OP
       JMS    SYMTYP	     /IS VARIABLE COMMON
       XOR    T00000
       JMP    DATA02	     / NO
       LAW    -1	     / YES, IS BLOCK DATA FLAG (FCNFLG = -1)
	.IFUND	ERMSG
       SAD    FCNFLG
       JMP    DATA03	     /	YES, OK
ER16C	JMP	EC		/NO, ERROR (COMMON VARIABLE, NOT BLOCK)
	.ENDC
	.IFDEF	ERMSG
ER16C	ERS	<'  16C'>,<SAD FCNFLG>,EC
	JMP	DATA03
	.ENDC
DATA02 LAW    -1	     / (NOT COMMON) IS BLOCK DATA FLAG SET
/       SAD    FCNFLG	     /	(FCNFLG = -1)
/DATA26	JMP EC		/ERROR: BLOCK DATA FLAG BUT NON-COMMON VARIABLE.
ER13C	ERN	<'  13C'>,<SAD FCNFLG>,EC
DATA03 LAC*   ARG	     /GET WORD1 OF VARIABLE
       SPA		     / TEST FOR ARRAY
       JMS    SUBCNT	     / IS ARRAY, TEST DIMENSIONS
       JMS    ENTER	     /ENTER ARG, OP IN ARG(I), OP(I) LISTS
       LAC    T0	     /PLACE SUBSRIPT VALUE
       DAC*   OPI	     / IN OP(I)
       LAC    OPVALU	     /IS OPERATOR A COMMA (,)
       SAD    C00030
       JMP    DATA01	     /	YES, CYCLE BACK FOR NEXT VARIABLE
/       SAD    C00018	     /	NO, IS OPERATOR A SLASH (1)
/       SKP       	     /	  YES, GO TO PROCESS CONSTANTS
/       JMP    EX   	     /	  NO, ERROR (VARIABLE LIST NOT DELIMITED
ER10X	ERS	<'  10X'>,<SAD C00018>,EX
       JMS    EXP540	     /MOVE ARG(I) TO TARG(I)
       JMS    INAOPI	     /RE-INITIALIZE THE LIST
       DZM    TFAO01
DATA05 LAW    -1	     /SET FLAG TO -1
       DAC    ARGCTR
DATA20 JMS    FARGOP	     /FETCH ARGUMENT, OP
       LAC    ARG	     /GET ARGUMENT DESCRIPTION WORD
       AND    Z00000	     /IS ARGUMENT A CONSTANT
/       SAD    U00000
/       SKP       	     /	YES
/       JMP    EV	     /	NO, ERROR (ARGUMENT NOT A CONSTANT)
ER09V	ERS	<'  09V'>,<SAD U00000>,EV
       LAC    OPVALU	     /IS OPERATER AN ASTERISK (*)
       SAD    C00021
       JMP    DATA16	     / YES, PROCESS FORM (K * C)
DATA13 ISZ    ARGI	     / NO, BUMP (I)
       ISZ    OPI
       LAC*   ARGI	     /GET ARGUMENT DESCRIPTION WORD (I)
       JMS    SETA2	     /BUST ARGUMENT
       JMS    SETADR	     / TO GENERATE VARIABLE ADDRESSES
       LAC    NAME0	     /IS MODE OF VARIABLE - MODE OF CONSTANT
	.IFUND	ERMSG
       SAD    MODEA2
	 SKP!RTL	     / YES
ER10V       JMP    EV	     / NO, ERROR (MODES OF VAR, CON DISAGREE)
	.ENDC
	.IFDEF	ERMSG
ER10V	ERS	<'  10V'>,<SAD MODEA2>,EV
	RTL
	.ENDC
	AND V00000	/SHIFT BITS 3,4 TO BITS 1,2
       DAC    MODEA1	     /	FOR OUTPUT OF DATA DEFINITION WORD(S)
       LAC    S 	     /OUTPUT FIRST DATA WORD
       JMS    BINOUT	     / WITH
       XOR    C00015	     /	LOADER CODE 15
       LAC    MODEA2	     /IF MODE OF CONSTANT IS INTEGER OR LOGICAL,
       SNA		     / SKIP OUTPUT OF SECOND DATA WORD
       JMP    DATA08
       SAD    S60000
       JMP    DATA08
       LAC    NAME1	     /OUTPUT SECOND DATA WORD
       JMS    BINOUT	     / WITH
       XOR    C00016	     /	LOADER CODE 16
       LAC    MODEA2	     /IF MODE OF CONSTANT IS REAL,
       SAD    S20000
       JMP    DATA08	     / SKIP OUTPUT OF THIRD DATA WORD
	LAC NAME2	/OUTPUT THIRD DATA WORD
       JMS    BINOUT	     / WITH
       XOR    C00017	     /	LOADER CODE 17
DATA08 LAC*   SYMTBC	     /GET SYMBOL DESCRIPTION
       AND    Z00000	     / SAVE ARRAY, COMMON INDICATORS
       RCL		     / (PLACE ARRAY INDICATOR IN LINK)
       SAD    U00000
       JMP    DATA10	     / YES, USE SIMPLE VARIABLE OUTPUT FORM
       SZL		     /NOT COMMON, IS ARRAY
       JMP    DATA09	     /	 YES
DATA10 LAC*   SYMTBC	     /	 NO, GET ARG DESCRIPTION WORD (WORD 1)
       AND    S17777	     /	  KEEP ADDRESS OF VARIABLE
       JMP    DATA12
DATA09 LAC*   SYMTW3	     /GET ADDRESS OF ARRAY
DATA12 TAD*   OPI	     / ADD SUBSCRIPT VALUE (0 IF NOT ARRAY)
       TAD    MODEA1	     /	  ADD MODE BITS IN BITS 1,2
       JMS    BINOUT	     /	   OUTPUT DEFINITION WORD
       XOR    C00018	     /	    WITH LOADER CODE 18
       LAW    -1	     /DECREMENT FLAG
       TAD    ARGCTR
       DAC    ARGCTR
       LAC    ARGI	     /COMPARE SIZE OF VARIABLE LIST TO CONSTANTS
       SAD    TARGI
       JMP    DATA21	     / IF EQUAL, ALL VARIABLES HAVE BEEN PROCESS
       LAC    ARGCTR	     /	IF NOT, CHECK FOR COMMA IF (*) NOT
       SMA		     /	 ENCOUNTERED (FLAG .LE. ZERO)
       JMP    DATA13
	 LAC    OPVALU	     / IS OPERATOR A COMMA
	.IFUND	ERMSG
       SAD    C00030
       JMP    DATA05	     /YES, CYCLE BACK TO PROCESS CONSTANT
ER11V       JMP    EV	     /NO, ERROR (CONSTANT NOT SEPARATED BY COMMA
	.ENDC
	.IFDEF	ERMSG
ER11V	ERS	<'  11V'>,<SAD C00030>,EV
	JMP	DATA05
	.ENDC
			/OR MORE VARIABLES THAN CONSTANTS.
DATA16 LAW    -1	     / IF OPERATOR IS (*), TEST IF (**)
/       SAD    ARGCTR	     /	(IS FLAG STILL INITIALIZED)
/       SKP    	     /	 YES, OK
/       JMP    EC	     /	 NO, ERROR (OPERATORS ** ARE ILLEGAL)
ER14C	ERS	<'  14C'>,<SAD ARGCTR>,EC
       LAC    NAME0	     / IS MODE OF ARGUMENT INTEGER
/       SZA		/	YES, OK
/	JMP EC		/ERROR: ARG PRECEDING (*) MUST BE INTEGER.
ER15C	ERN	<'  15C'>,SZA,EC
       JMS    CONTST
       TAD    K00001
       DAC    ARGCTR	     /STORE VALUE -1 IN FLAG
       JMP    DATA20
DATA21 LAC    ARGCTR	     /END OF LIST HAS BEEN REACHED
/       SMA		     / HAVE ALL CONSTANTS (*) BEEN PROCESSED
/       JMP    DATA23	     /	NO, ERROR
ER12V	ERN	<'  12V'>,SMA,EV
       LAC    OPVALU	     / IS NEXT OPERATOR A (/)
/       SAD    C00018
/       SKP	    	     / YES, NO OF VARIABLES AND CONSTANTS AGREE
/DATA23 JMP    EV	     / NO, ERROR (MORE CONSTANTS THAN VARIABLES)
ER13V	ERS	<'  13V'>,<SAD C00018>,EV
       JMS    FNBCHR	     /GET NEXT NON-BLANK CHAR
       SAD    S00054	     / IS IT A COMMA
       JMP    DATA25	     /	YES, REINITIALIZE FOR NEW SET OF VARIABL
       JMP    CRTEST	     /	NO, TEST FOR C/R AND EXIT
       .EJECT
/ IF STATEMENT PROCESSOR
/
IF     LAC    C00024	     /THE IF INDICATOR IS SET AS AN OPEN
       DAC    IFFLAG	     /PARENTHESIS FOR EXPRESSION DECODING.
       JMS    EXPRSN	     /THE IF EXPRESSION IS DECODED AND THE
       LAC    OPVALU	     /NECESSARY CODE IS GENERATED SO THAT THE
/       SAD    C00031	     /RESULT WILL BE LEFT IN THE ACCUMULATOR.
/       SKP
/	JMP EX		/ERROR: STMT NOT DELIMITED BY A CLOSING PAREN.
ER11X	ERS	<'  11X'>,<SAD C00031>,EX
       LAC    MODEA2
       SAD    S60000	     /THE MODE OF THE EXPRESSION RESULT
       JMP    LGCLIF	     /DESIGNATES THE TYPE OF IF STATEMENT.
       .EJECT
/ARITHMETIC IF STATEMENT WRAP-UP
ARTHIF DZM    LOGIF
       SNA
       JMP    AIF01	     /THE SECOND WORD OF THE FLOATING POINT
       LAC    ACCMNE	     /ACCUMULATOR CONTAINS THE NECESSARY
       JMS    EXP580	     /INFORMATION TO TEST THE EXPRESSION RESULT
       XOR    LACCMD	     /FOR NEGATIVE, ZERO, OR POSITIVE.
AIF01  LAC    SPACMD
       JMS    ABSBIN	     /	 LAC*  .AB   FLOATING POINT EXPRESSION
	JMS AIF500	/(RESULT IN AC) INTEGER EXPRESSION.
/       SAD    S00054
/       SKP
/AIF04	JMP EX		/ERROR: COMMA DOES NOT SEPARATE STMT NUMBERS.
ER12X	ERS	<'  12X'>,<SAD S00054>,EX
       LAC    SNACMD
       JMS    ABSBIN	     /THE ARITHMETIC IF STATEMENT CODE
       JMS    AIF500	     /GENERATION IS...
	.IFUND	ERMSG
       SAD    S00054	     /	 SPA
       JMP    GOTO13	     /	 JMP  S1   NEGATIVE EXIT
ER13X       JMP    EX	     /	 SNA
	.ENDC
	.IFDEF	ERMSG
ER13X	ERS	<'  13X'>,<SAD S00054>,EX
	JMP	GOTO13
	.ENDC
/			     /	 JMP  S2   ZERO     EXIT
/			     /	 JMP  S3   POSITIVE EXIT
       .EJECT
/ LOGICAL IF STATEMENT WRAP-UP
/
LGCLIF LAC    LOGIF
/	SZA		/ERROR: THIS LOGICAL IF IS A LOGICAL IF
/       JMP    EI	/TRUE STATEMENT.
ER09I	ERN	<'  09I'>,SZA,EI
	
       LAC    SNACMD	     /THE LOGICAL IF STATEMENT CODE GENERATION
       DAC    LOGIF	     /IS... (EXPRESSION RESULT IN AC)
       JMS    ABSBIN	     /	    SNA
       JMS    EXP550	     /	    JMP AA  FALSE EXIT
       XOR    JMPCMD	     /	    .	    TRUE  EXIT (STATEMENT)
       DAC    STRNGA	     /	    .
       JMP    CTRL41	     /	AA  NEXT STATEMENT
       .EJECT
/ SUBROUTINE TO OUTPUT A BRANCH INSTRUCTION TO A STATEMENT LABEL
/ CALLING SEQUENCE...
/      JMS    AIF500
/
AIF500 CAL    0
       JMS    FDFSNO	     /THE DEFINED-ONLY STATEMENT NUMBER IS
       XOR    JMPCMD	     /FETCHED AND ITS ASSIGNED ADDRESS IS
       JMS    RELBIN	     /MERGED WITH A JMP OPCODE TO FORM A BRANCH
       LAC    XCHAR	     /INSTRUCTION.
	JMP* AIF500
       .EJECT
/ SUBROUTINE TO FETCH DEFINED-ONLY STATEMENT NUMBER
/ CALLING SEQUENCE...
/      JMS    FDFSNO
/
FDFSNO CAL    0
       JMS    FETSNO	     /THE CALLING PROGRAM REQUIRES THAT A
/       SPA		    /DEFINED STATEMENT NUMBER BE PRESENT.
/	JMP EN		/ERROR: NO STMT NUMBER SPECIFIED.
ER05N	ERN	<'  05N'>,SPA,EN
       AND    S60000	/STATEMENT NUMBERS MAY NOT HAVE BEEN
       XCT    PASS	/SPECIFIED AS LABELS YET IF THIS IS STILL
       SAD    S60000	/THE FIRST PASS.
	SKP		/ERROR: STMT NO. NEVER USED AS PROPER
	.IFUND	ERMSG
ER06N	JMP EN		/STATEMENT LABEL.
	.ENDC
	.IFDEF	ERMSG
ER06N	ERS	<'  06N'>,SKP,EN
	.ENDC
       LAC*   SYMTBC	     /THE ASSIGED ADD9ESS IS 9ETURNED TO THE
       AND    S17777	     /CALLING PROGRAM.
       JMP*   FDFSNO
       .EJECT
/ STATEMENT FUNCTION STATEMENT PROCESSOR
/
STAFCN LAC    SORDER	     /STATEMENT FUNCTIONS MUST PRECEDE
/       SAD    V40000	     /EXECUTABLE CODE WHICH HAS A STATEMENT
/       JMP    CTRL44	     /ORDER OF SEVEN.
ER16I	ERN	<'  16I'>,<SAD V40000>,EI
       LAC    V00000	     /STATEMENT FUNCTIONS HAVE AN IMPLIED
       DAC    TORDER	     /STATEMENT ORDER OF SIX.
       XCT    PASS
       JMP    SFCN01	     /STATEMENT FUNCTION NAMES CANNOT BE
	LAC	NAME1	/EXPLICITLY TYPED AS EXTERNAL FUNCTIONS.
/	SZA	/ERROR: STMT FUNCTION NAME NOT UNIQUE
/	JMP EE		/(JUST ENTERED INTO THE SYMBOL TABLE).
ER03E	ERN	<'  03E'>,SZA,EE
       LAC*   SYMTBC
       AND    S60000
       XOR    PC
       XOR    Y00000         /STATEMENT FUNCTIONS ARE DIFFERENTIATED
       DAC*   SYMTBC	     /FROM EXTERNAL FUNCTIONS.
SFCN01 LAC    NAME0          /SAVE MODE OF FUNCTION
       DAC    START
       JMS    CTRL70	     /STATEMENT FUNCTIONS CANNOT BE LABELED.
/		 	     /THE DUMMY ARGUMENTS LISTED ARE VALID ONLY
       JMS    SUBR60	     /FOR THIS STATEMENT AND MAY DUPLICATE
       ISZ    TSMTBN         /PREVIOUSLY DECLARED NAMES. THE AREA IN
       JMS    SUBR50         /FRONT OF THE SYMBOL TABLE IS USED TO
       LAC    XCHAR          /TEMPORARILY CONTAIN THESE ERASABLE
/       SAD    S00075         /VARIABLES.
/       SKP                /AN ERROR IS ANNOUNCED IF AN EQUAL SIGN
/       JMP    EE	     /DOES NOT DELIMIT THE FUNCTION REFERENCE.
ER04E	ERS	<'  04E'>,<SAD S00075>,EE
	
       LAC    C00001	     /THE PROPER NEXT ENTRY ADDRESS IS RESET
       DAC    IFFLAG	     /SO THAT NON-DUMMY VARIABLES IN THE
       DZM    TSMTBN	     /EXPRESSION MAY BE ENTERED PERMANENTLY.
	LAC	STAF
	TAD	S03100
	DAC	STAF
       JMS    EXPRSN	     /THE BODY OF THE FUNCTION IS DECODED AND
       LAC    START
       JMS    EXP740
       LAC    TXITCM	     /THE NECESSARY CODE GENERATED.
       JMS    RELBIN	     /THE SUBROUTINE IS CLOSED WHEN THE EXIT
       LAC    PC	     /INSTRUCTION IS OUTPUT.
       DAC    START	     /THE ADDRESS OF THE FIRST EXECUTABLE INSTR
       JMP    STEXIT	     /IS UPDATED ACCORDINGLY.
STAF	0		/STATEMENT FUNCTION TEMPORARY STORAGE SUFFIX
S03100	3100		/A--
       .EJECT
/ T FUNCTION STATEMENT PROCESSOR
/
TFUNCT LAC    SORDER	     /A T FUNCTION STATEMENT BEGINS IN THE
/       SNA		     /TYPE (T) STATEMENTS. I.E. INTEGER,REAL,ETC
/       JMP    FUNCTI	     /AN ERROR IS ANNOUNCED IF A PROGRAM UNIT
/       JMP    CTRL44	     /CONTAINS MORE THAN ONE FUNCTION STATEMENT
ER17I	ERN	<'  17I'>,SZA,EI
	JMP	FUNCTI
       .EJECT
/ SUBROUTINE/FUNCTION STATEMENT PROCESSOR
/
SUBROU LAC    S20000	     /A FUNCTION IS DIFFERENTIATED FROM A
FUNCTI XOR    JMPCMD	     /SUBROUTINE IN THAT A FUNCTION MUST RETURN
       DAC    FCNFLG	     /A VALUE IN THE ACCUMULATOR TO THE CALLING
       DZM    TORDER
       JMS    FVARGO	     /PROGRAM. THE SUBPROGRAM NAME IS FETCHED
	XCT PASS
	JMP	FUN002		/MODE SET IF PASS 2
FUN001	LAC	MODE
       SPA		     /THE MODE-TYPE IS EXPLICITLY SET WHEN
FUN002	LAC*	SYMTBC		/THIS IS A T FUNCTION STATEMENT
       AND    S77777	     /THE NAME IS ENTERED AS A SIMPLE VARIABLE
       DAC*   SYMTBC	      /WITH THE USE FLAG RESET.
       JMS    OSYMBL	    /THE NAME OF THE SUBPROGRAM IS OUTPUT AS
       CLA		     /AN INTERNAL GLOBAL SYMBOL WITH A
       JMS    BINOUT	     /DEFINITION OF ZERO.
       XOR    C00010
       JMS    SUBR60
	LAC TXITCM
	DAC XITCMD
       LAC    OPVALU
       SAD    C00028
       JMS    SUBR50
       LAC    S40000	     /THE ARGUMENT LIST IS FETCHED AND THE
       DAC    TORDER	     /SUBROUTINE ENTRY IS GENERATED.
       JMS    EXP550	     /SAVE STRING ADDRESS IN THE EVENT THAT
	XOR	JMPCMD
       DAC    STRNGC	     /STATEMENT FUNCTIONS ARE PRESENT.
       JMP    CRTEST
       .EJECT
/ SUBROUTINE TO GENERATE A SUBROUTINE ENTRY
/ CALLING SEQUENCE...
/      JMS    SUBR60
/
SUBR60 CAL    0
       DZM    STRNGB
       LAC    JMPICM	     /A JMP* ENTRY POINT (PC) IS GENERATED AS
       XOR    PC	     /THE EXIT INSTRUCTION FOR THIS SUBROUTINE.
       DAC    TXITCM
       LAC    PC	     /THE SUBROUTINE ENTRY POINT IS OUTPUT AS
       JMS    VECBIN	     /A SELF-REFERENCING TRANSFER VECTOR.
       LAC    OPVALU
       SAD    C00028	     /A SUBROUTINE SUBPROGRAM MAY BE WRITTEN
       JMP    SUBR51	     /WITHOUT AN ARGUMENT LIST.
       LAC    FCNFLG
	.IFUND	ERMSG
       SAD    JMPICM	     /AN ARGUMENT LIST MUST BE SPECIFIED FOR
       JMP*   SUBR60	     /A STATEMENT FUNCTION OR A FUNCTIONSTMT.
ER05E	JMP EE		/ERROR: ARG LIST NOT INDICATED.
	.ENDC
	.IFDEF	ERMSG
ER05E	ERS	<'  05E'>,<SAD JMPICM>,EE
	JMP*	SUBR60
	.ENDC
SUBR51 LAC    GETARG
       JMS    EXP580	     / THE SUBROUTINE ENTRY CODE IS...
       XOR    JMSCMD
       JMS    EXP550	     /	 ENTRY	.DSA	ENTRY
       XOR    JMPCMD	     /		JMS*	.G    GET ARGUMENTS
       DAC    STRNGB	     /		JMP	A(N)+1
       JMP*   SUBR60
       .EJECT
/ SUBROUTINE TO FETCH DUMMY ARGUMENTS
/ CALLING SEQUENCE ...
/       JMS    SUBR50
/
SUBR50 CAL 0
	.IFUND	DUMY
K00010 LAW    -12	     /	 A(1)	.DSA	P(1)  PARAMETER
	.ENDC
	.IFDEF	DUMY
	LAW	-24
	.ENDC
       DAC    ARGCTR	     /	 A(2)	.DSA	P(2)
SUBR55 JMS    FVARGO	     /	 .	.	.
       XCT    PASS	     /	 .	.	.
       JMP    SUBR52	     /	 A(N)	.DSA	P(N)
       LAC    NAME1	     /		XXX	      NEXT INSTRUCTION
/       SZA
/	JMP EV		/ERROR: ARG OTHERWISE SPECIFIED.
ER14V	ERN	<'  14V'>,SZA,EV
SUBR52	LAC TSMTBN
	SZA
	JMP .+3	/STATEMENT FUNCTION.
	XCT PASS
	JMP SUBR56
	LAC* SYMTBC	/ALL ARGS IN THE LIST ARE TYPED AS
	AND S77777
       XOR    V00000	     /DUMMY VARIABLES AND ASSIGNED THE VALUE OF
       DAC*   SYMTBC	     /THE CURRENT LOCATION COUNTER.
	CLA
	XCT PASS
SUBR56	JMS	DEFNSM
	XOR PC	
       JMS    VECBIN	     /THE ARGUMENT LIST IS OUTPUT AS A LIST OF
       LAC    OPVALU	     /SELF-REFERENCING TRANSFER VECTORS.
       SAD    C00030
       JMP    SUBR53	     /THE ARGUMENTS MUST BE SIMPLE VARIABLES
	.IFUND	ERMSG
	SAD C00031	/SEPARATED BY COMMAS.
       JMP    SUBR54
ER03S	JMP ES		/ERROR: LIST NOT TERMINATED BY CLOSING PARENS.
	.ENDC
	.IFDEF	ERMSG
ER03S	ERS	<'  03S'>,<SAD C00031>,ES
	JMP	SUBR54
	.ENDC
	.IFUND	ERMSG
SUBR53 ISZ    ARGCTR
       JMP    SUBR55	     /AN ERROR IS ANNOUNCED WHEN THE MAXIMUM
ER05M       JMP    EM	     /NUMBER OF DUMMY ARGUMENTS IS EXCEEDED.
	.ENDC
	.IFDEF	ERMSG
SUBR53=.
ER05M	ERS	<'  05M'>,<ISZ ARGCTR>,EM
	JMP	SUBR55
	.ENDC
SUBR54 LAC    STRNGB	/STRING JUMP ROUND
	JMS	STRING	/ARGUMENT LIST
	JMS	FNBCHR
       JMP*   SUBR50
       .EJECT
/ BLOCK DATA STATEMENT PROCESSOR
/
BLOCKD LAC    K00001	     /THE SUBPROGRAM FLAG IS SET TO INDICATE
       DAC    FCNFLG	     /A BLOCK DATA SUBPROGRAM.
       LAC    LOWRAD	     /THE BLOCK DATA DECLARATION IS OUTPUT AS
       JMS    BINOUT	     /THE CUMULATIVE SIZE OF THE DECLARED
       XOR    C00011	     /COMMON BLOCKS
       LAC    S40000	     /THE STATEMENT ORDER IS SET TO ONE TO
       DAC    TORDER	     /PREVENT ANOTHER SUBPROGRAM DECLARATION
       JMP    CONTIN	     /FROM BEING ACCEPTED.
       .EJECT
/ RETURN STATEMENT PROCESSOR
/
RETURN	LAC	SYMTB0
	DAC	SYMTBC
	LAC	FCNFLG		/A RET. ST. IS ONLY LEGAL IN
       SAD    JMPCMD	     /SUBROUTINE OR FUNCTION SUBPROGRAM.
       JMP    RETN01
	.IFUND	ERMSG
       SAD    JMPICM
	JMP RETN02		/ERROR: RETURN STMT APPEARS IN
ER10I	JMP EI		/MAIN-PROGRAM UNIT.
	.ENDC
	.IFDEF	ERMSG
ER10I	ERS	<'  10I'>,<SAD JMPICM>,EI
	JMP	RETN02
	.ENDC
RETN01 LAC    FNCMNE	     /A RETURN STATEMENT IN A FUNCTION
       DZM    NAME2	     /(ENTER AS 2 WORDS FOR OBJECT LIST)
       JMS    EXP580	     /SUBPROGRAM CAUSES THE GENERATION OF A JMP
       XOR    JMPICM	     /TO A SINGLE RETURN LOCATION TO BE
       LAC    SYMTBC	     /SPECIFIED BY THE END STATEMENT.
       DAC    FCNRET
       JMP    CONTIN
RETN02	JMS	RELBIN		/RETURN CAUSES
       JMP    CONTIN         /JMP* ENTRY INSTRUCTION.
	.EJECT
/ CALL STATEMENT PROCESSOR
/							
CALL   JMS    FA2NOP         /THE NAME OF THE SUBROUTINE BEING CALLED
       JMS    VARTST         /IS FETCHED AND ENTERED INTO THE ARG(I);
	LAC*	SYMTBC
	AND	Z00000
	SAD	U00000
	JMP	CALL03
	.IFDEF	K16
	SAD	V00000
	JMP	CALL01
	.ENDC
/       JMS    SYMTYP         /OP(I) LISTS.
/       XOR    U00000         /THE NAME IS EXAMINED TO DETERMINE IF IT
/       SKP                   /HAS BEEN PREVIOUSLY BEEN DECLARED AS A
/       JMP    CALL03         /FUNCTION OR IF THIS IS ITS FIRST
       LAC    NAME1          /APPEARANCE IN THIS PROGRAM.
/	SZA		/ERROR: NAME USED TO REQUEST SUBPROGRAM
/	JMP EE		/CANNOT BE IDENTIFIED A SUBPROGRAM NAME.
ER06E	ERN	<'  06E'>,SZA,EE
CALL02	LAC*	SYMTBC
	.IFDEF	K16
	AND	S77777
	.ENDC
       XOR    U00000         /THE NAME IS TYPED AS A FUNCTION NAME IF
       DAC*   SYMTBC         /THIS IS ITS FIRST APPEARANCE.
CALL03 LAC    OPVALU
       SAD    C00028         /A SUBROUTINE MAY BE CALLED WITH OR
       JMP    CALL06         /WITHOUT SPECIFYING A PARAMETER LIST.
       LAC*   SYMTBC
       AND    S17777         /A SIMPLE .JMP* SUBR. IS GENERATED WHEN
       XOR    S20000         /A PARAMETER LIST IS NOT SPECIFIED.
       XOR    JMSCMD
       JMS    RELBIN
       JMP    CRTEST         /THE EXPRESSION DECODING ROUTINE IS USED
CALL06 LAC    CALL05         /TO GENERATE THE SUBROUTINE CALL WITH
	DAC EXPRSN	/FORMAL PARAMETERS.
       JMP    EXP011
CALL05 .DSA   CRTEST
	.IFDEF	K16
CALL01	LAC	U00000
	XOR*	SYMTW2
	DAC*	SYMTW2
	JMP	CALL02
	.ENDC
       .EJECT
/ END STATEMENT PROCESSOR
/							
END    JMS    CTRL70         /END STATEMENTS SHOULD NOT BE LABELED.
       JMS    CLENUP         /STORAGE ASSIGNMENTS ARE MADE IF THIS
       LAC    K00001         /PROGRAM CONTAINS ONLY SPECIFICATION
       DAC    PROCAD         /STATEMENTS.
       SAD    FCNFLG
       JMP    PASS           /THE STATEMENT PRECEDING THE END STATEMENT
       LAC    LSTCMD         /(EXCEPT IN A BLOCK DATA SUBPROGRAM) MUST
       AND    Z40000         /BE A TRANSFER OF CONTROL STATEMENT.
       SAD    JMPCMD         /I.E., STOP, GOTO, ARITHMETIC IF, RETURN.
       JMP    .+3
/	LAW 16220		/ERROR: PREVIOUS
/       JMS    ERROR1         /STATEMENT DOES NOT EFFECT A CONTROL
ER11I	ERR	<'  11I'>,16220
       LAC    FCNFLG         /CHANGE.
	SAD	JMPCMD
	SKP
	JMP	END04
	SAD	SUBRN0		/THE NAME OF A FUN. SUB. MUST HAVE BEEN USED
	JMP	END01		/AS A NON-COMMON SIMPLE VAR. IN AN
				/EXECUTEABLE STATEMENT
/       LAW    16120         /AN ERROR IS ANNOUNCED IF THE NAME WAS NOT
/       JMS    ERROR1         /USED OR IF IT WAS USED IMPROPERLY.
ER07E	ERR	<'  07E'>,16120
       JMP    END04
END01	LAC	PC	/THE FUN. RET. LOC. IS DEF.
       DAC*   FCNRET         /AS THE CURRENT VALUE OF THE PROGRAM
       LAC    FCNRET         /COUNTER.
       DAC    LABEL          /(SET FOR LISTING PURPOSES)
       LAC    SYMTB0
       XOR    T00000
       DAC    ARG            /THE FUNCTION SUBPROGRAM EXIT IS
       LAC*   SYMTB0
       JMS    SETN           /COMPLETED BY GENERATING A LOAD COMMAND
       TAD    C00003         /WITH THE FUNCTION NAME AS THE ARGUMENT.
       JMS    OPOPA2
       LAC    ARG            /THIS IS FOLLOWED BY A BRANCH RETURN TO
       LAC    JMPICM        /THE CALLING PROGRAM (INDIRECT VIA ENTRY).

       JMS    RELBIN
END04  LAC    CTRLSW+1
       TAD    FCNFLG
       SZA                   /A CALL TO THE OTS
       JMP    .+12           /I-O INITIALIZER SUBR.
       LAC    FNCMNE+1       /IS OUTPUT IF THIS
       JMS    EXP580          /IS A MAIN-BODY
       XOR    JMSCMD          /PROGRAM CONTAINING
       LAC    START           /I-O STATEMENTS
       XOR    JMPCMD
       JMS    RELBIN         /THE PROGRAM STARTING
       LAW    -2             /ADDRESS IS ADJUSTED
       TAD    PC             /SO THAT THE OTS I-O
       DAC    START          /INIT. IS EXECUTED FIRST.
       LAC    CONTB0
       DAC    TCTR
END09  SAD    CONTBN
       JMP    END13
       LAC*   TCTR           /DECLARED AND CREATED CONSTANTS ARE
       AND    Z60000         /ASSIGNED MEMORY LOCATIONS IMMEDIATELY
       XOR    PC             /FOLLOWING THE PROGRAM BODY.
       DAC*   TCTR
       JMS    SETN           /THE CONSTANTS ARE OUTPUT AS THEY ARE
       JMS    TWOCMA         /ASSIGNED.
       DAC    TEMP0
END10  JMS    CNSE50
       LAC*   TCTR
       JMS    ABSBIN
       ISZ    TEMP0
       JMP    END10
       JMS    CNSE50
	.IFDEF	X4K
	XCT	CNSE52
	DAC	TCTR
	.ENDC
       JMP    END09
END13  LAC    SYMTB0
       DAC    SYMTBC
       SAD    SYMTBN         /SEARCH THE SYMBOL
	JMP END07	/TABLE FOR EXTERNAL
       JMS    SETADR         /FUNCTION REFERENCES.
       LAC*    SYMTBC
       SMA
       JMS    SYMTYP
       XOR    U00000
       JMP    END15          /TRANSFER VECTORS ARE OUTPUT AS SELF
	LAC*	SYMTW2	/DO NOT GENERATE TRANSFER VECTOR
	AND	U00000	/IF FUNCTION REFERENCE IS A
	SZA		/DUMMY ARGUMENT AS VECTOR IS
	JMP	END15	/AREADY CREATED
       JMS   DEFNSM          /REFERENCING ADDRESS
       XOR    PC            /TRANSFER
       JMS    VECBIN
       JMS    OSYMBL         /THE NAME IS OUTPUT ALONG WITH ITS
       LAC*    SYMTBC         /DEFINITION AS A VIRTUAL GLOBAL DEFINITION
       AND    S17777
       JMS    BINOUT
       XOR    C00009
END15  JMS    SBSE50
       JMP    END13+1
END07  LAC    SYMTB0
END14  DAC    SYMTBC         /UNASSIGNED NON-COMMON SIMPLE VARIABLES
       SAD    SYMTBN         /AND TRANSFER VECTORS FOR VIRTUAL GLOBAL
       JMP    PASS           /REFERENCES ARE OUTPUT FOLLOWING THE
       JMS    SETADR         /CONSTANTS.
       JMS    SYMTYP
       XOR    V00000
       SKP
       JMP    END16
       LAC*   SYMTBC
	SMA
       AND    S17777
       SAD    S17776         /UNDEFINED NAMES ARE RECOGNIZED BY A
       JMP    .+3            /PHONEY ADDRESS OF 8190.
END16  JMS    SBSE50
       JMP    END14
       JMS    DEFNSM
       XOR    PC
       LAC*   SYMTBC         /SIMPLE VARIABLES ARE OUTPUT AS
       JMS    SETN           /UNINITIALIZED BLOCKS OF MEMORY (BLOCK
       JMS    BINOUT         /SIZE DEPENDS ON NUMBER OF WORDS
	XOR C00006	/REQUIRED TO CONTAIN DATA OF THE SAME
       JMP    END16          /MODE-TYPE.
PASS   SKP
       JMP    END12          / END OF COMPILATION
/
/ PASS 2 INITIALIZATION
/							
       LAC    PASS2          /INITIALIZE...
       DAC    PASS           /  PASS FLAG
	.IFUND	IMBED
       CAL+767
       6
	.ENDC
	JMS   SUB990
       .DSA   MESSY4-2
	.IFUND	IMBED
EPS1SW XX                    /DON'T WAIT FOR ^P.
       .DSA   MESSY3-2
Z77000	777000
	DAC	CTLPSW
       JMP    .               /WAIT FOR ^P
	.ENDC
	.IFDEF	IMBED
	JMP	INIT01
	.ENDC
       .EJECT
/ END OF COMPILATION
/							
END12  LAC    FCNFLG
       RCR
       SZL!SNA               /THE BRANCH AROUND THE PARAMETER LISTS,
       JMP    END17          /DATA STORAGE, AND STATEMENT FUNCTIONS
       LAC    START          /IS STRUNG IF THIS IS A SUBPROGRAM
       DAC    PC             /PROGRAM UNIT (NOT BLOCK DATA).
       LAC    STRNGC
       SZA
       JMS    STRING
	.IFUND	%F2
END17  LAC    PASS2
       DAC    BINO06
       LAC    SYMTB0
	.ENDC
	.IFDEF	%F2
END17	LAC	SYMTB0
	.ENDC
       DAC    SYMTBC
	.IFUND	%F2
END23  JMS    OBJ500         /INITIALIZE OUTPUT BUFFER FOR SYMBOL TABLE
	  LAC	SYMTBC	     /PRINTING.
	.ENDC
	.IFDEF	%F2
END23	LAC	SYMTBC
	.ENDC
       SAD    SYMTBN
	JMP END22
	
       JMS    SETADR
       JMS    SIN530
       JMS    OSYMBL         /EACH SYMBOL IS OUTPUT AS AN INTERNAL
       LAC*    SYMTBC         /SYMBOL FOR DDT. THE USER MUST MAINTAIN
       AND    S17777           /SOME DISCRETION WHEN IT COMES TO THE USE
	SAD	S17777
	JMP	.+3
       JMS    BINOUT
       XOR    C00019
	.IFUND	%F2
       LAW    -1
       SAD*   SYMTBC
       LAC    S00057
       SMA
       JMP    .+5
       JMS    SYMTYP         /THE SYMBOL TABLE IS PRINTED WITH FOUR
       XOR    U00000         /SYMBOLS AND THEIR DEFINITIONS PER LINE.
       LAC    K00010
       TAD    S00052         /EXTERNAL NAMES (AND STATEMENT FUNCTIONS)
	JMS OBJ510	/ARE INDICATED BY AN ASTERISK BEFORE
       JMS    OBJ630         /THE SYMBOL AND ITS DEFINITION.
       JMS    OBJ550
       LAC*   SYMTW2         /THREE CHARACTER NAMES ARE FILLED OUT TO
       SPA                   /SIX CHARACTER NAMES.
       JMP    END19
       JMS    OBJ630         /FORMAT A SPACE,
       JMS    OBJ630         /AND ANOTHER,
       JMS    OBJ630         /AND ANOTHER.
END19	JMS	OBJ630
	LAC*	SYMTBC
	AND	Z00000
	SAD	Y00000
	JMP	END50
       LAC*   SYMTBC
       SPA
       LAC*   SYMTW3
	SKP
END50	LAC*	SYMTBC
       JMS    OBJ640         /FORMAT SYMBOL DEFINITION.
       JMS    OBJ630         /FORMAT A SPACE
	.ENDC
       JMS    SBSE50
       DAC    SYMTBC         /UPDATE SYMBOL ADDRESS TO NEXT ENTRY
	.IFUND %F2
SYMMAP SKP
       JMS    OBJ520         /OUTPUT SYMBOL BUFFER
	.ENDC
       JMP    END23
END22  LAC    START
       JMS    BINOUT         /OUTPUT END CODE WITH STARTING ADDRESS OF
       XOR    C00023         /PROGRAM UNIT AS THE DATA WORD
	.IFDEF	PDP15
F4K	XX
	JMP	.+3
	JMS	SUB990
END02	.DSA	MESSY2-2
	.ENDC
	.IFUND	IMBED
/      .CLOSE -11              /NOW IS THE TIME TO CLOSE ALL FILES
       CAL    00767
       .DSA   000006
/      .CLOSE -12
	XCT LIST
	JMP .+3
       CAL    00766
       .DSA   000006
/      .CL0SE -13
	XCT	OBINRY
	JMP	.+3
       CAL    00765
       .DSA   000006
	.ENDC
	.IFDEF	IMBED
	XCT	DLIST
	SKP
	JMS	DCLOSE
	XCT	OBINRY
	SKP
	JMS	DCLOSE
	.ENDC
       LAC    TITLEA
       SAD    C00013
       JMP    INIT02         /ALLOW BATCH PROCESSING OF SOURCE PROGRAMS.
	.IFUND	IMBED
/      .EXIT
       CAL    0
C00013 .DSA   000015
	.ENDC
	.IFDEF	IMBED
	JMP	17646
	.ENDC
       .EJECT
/SUBROUTINE TO OUTPUT MESSAGES
/CALLING SEQUENCE...
/      JMS    SUB990
/      .DSA   MESSAGE ADDRESS (-2 FOR DUMMY HEADER)
/
SUB990 CAL    0
       LAC*   SUB990
	.IFUND	IMBED
       DAC    .+3
/      .WRITE -3
S990CL	CAL 2775
	.DSA 000011
       .DSA   000000
Z77677 .DSA   777677
	DZM	.-2
	LAC	S02775
	.ENDC
	.IFDEF	IMBED
	DAC	.+2
S990CL	JMS	TTYOUT
	XX
	LAC	LISTT
	.ENDC
	DAC	S990CL
       ISZ    SUB990
       JMP*   SUB990
MESSY1=.
	.IFUND	K16
	.IFUND	IMBED
	.IFUND	%F2
	.IFUND	BF
	.IFDEF	PDP15
	.ASCII	/F4  V10A/<15>
	.ENDC
	.IFUND	PDP15
	.ASCII	/F49 V10A/<15>
	.ENDC
	.ENDC
	.IFDEF	BF
	.ASCII	/F4 BF10A/<15>
	.ENDC
	.ENDC
	.IFDEF	%F2
	.IFUND	BF
	.ASCII	/F4A V10A/<15>
	.ENDC
	.IFDEF	BF
	.ASCII	/F4A BF10A/<15>
	.ENDC
	.ENDC
	.ENDC
	.IFDEF	IMBED
	.ASCII	/F4I V10A/<15>
	.ENDC
	.ENDC
	.IFDEF	K16
	.IFUND	BF
	.IFDEF	PDP15
	.ASCII	/F4S V10A/<15>
	.ENDC
	.IFUND	PDP15
	.ASCII	/F4S9 V10A/<15>
	.ENDC
	.ENDC
	.IFDEF	BF
	.ASCII	/F4S BF10A/<15>
	.ENDC
	.ENDC
MESSY4       .DSA   426350         /.ASCII /END PASS1/<15>
       .DSA   420240
       .DSA   406472
       .DSA   330432
MESSY5       .DSA   373720	/.ASCII />/<175>
MESSY3       .DSA   572417	/.ASCII /^P/<175>
X77777	.DSA 577777
	.IFUND	ERMSG
	2002
	0
MESSY6	XX		/ERROR LETTER
	.DSA	406400	/.ASCII '<' <15>
	.ENDC
	.IFDEF	ERMSG
	3002
	0
MESSY6	.ASCII	' '<76>'00I'<74>' '<15>
	.ENDC
CMDERT	.ASCII /?/<15>
	.LOC .-1
	.IFDEF	PDP15
MESSY2	.ASCII	<12>/ PROG > 4K/<15>
	.LOC	.-1
	.ENDC
	.EJECT
/ SUBROUTINE TO INITIALIZE ARG(I) AND OP(I) LISTS
/ CALLING SEQUENCE...
/      JMS    INAOPI
/							
INAOPI CAL    0
       LAC    ARG0
       DAC    ARGI           / 0 TO I
       DAC    ARG1           / ARG(0) TO ARG1
       DAC    TYPEA1         / SET NO ARGUMENT 1
       LAC    OP0
       DAC    OPI            / 0 TO I
       DZM*   OPI            / OP(0) TO POP
       JMS    EXP640         /0 TO LEVEL(POP)
       LAC    TSIMNE
       DAC    TSI            / INITIALIZE CREATED TEMPORARY STORAGE
       LAC    TSRMNE
       DAC    TSR            / FOR INTEGER-LOGICAL, REAL, AND
       LAC    TSDMNE
       DAC    TSD            / DOUBLE PRECESION.
       JMS    INFAOP         / INITIALIZE FETCH ARG-OP SUBROUTINE
       JMP*   INAOPI
       .EJECT
/ SUBROUTINE TO DECODE ARITHMETIC AND LOGICAL EXPRESSIONS
/ CALLING SEQUENCE...
/      JMS    EXPRSN
/							
EXPRSN CAL    0
       JMS    INAOPI         /INITIALIZE ARG(I), OP(I) LISTS
       LAC    IFFLAG         /THE LAST ITEM PROCESSED IS PRE-SET TO AN
       DAC    TFAO01         /OPEN PARENTHESIS FOR AN IF STATEMENT.
EXP001 JMS    FA2NOP
       LAC    TYPEA2         /THE NEXT ARGUMENT (ARG2) AND OPERATOR-
       SAD    Y00000         /DELIMITER (NOP) IS FETCHED
       SKP
       JMP    EXP003         /WHEN THE NEXT ARGUMENT REPRESENTS A
       LAC    MODEA1         /IF ARG1 IS
       SAD    S20000         /EITHER LOGICAL OR
       JMP    EXP002          /INTEGER, STORE
       SAD    S40000         /TEMPORARILY
       JMP    EXP002         /AS THE ACCUMULATOR
       JMS    EXP710         /IS NEEDED.)
EXP002 JMS    OUTSSC         /NECESSARY TO CALCULATE THE ELEMENTS
       DAC*   ARGI           /POSITION ARE IMMEDIATELY GENERATED. THE
	JMS SETA2	/ARG IS REPLACED WITH A STRING
       LAC*   NOP            /ARGUMENT WHICH REPRESENTS THE ELEMENT
       DAC*   OPI            /ADDRESS.
	 LAC    OPI            /THE ARGUMENTS AND OPERATORS WHICH
       DAC    NOP            /DESCRIBED THE ARRAY ELEMENT ARE REMOVED
       LAC    ARGI           /FROM THE ARG(I) AND OP(I) LISTS.
       DAC    ARG2
EXP003 LAC    LEVNOP         /INSTRUCTIONS ARE GENERATED IN HEIRARCHAL
       JMS    TWOCMA         /FASHION. EACH OPERATION IS ASSIGNED A
       TAD    LEVPOP         /PRIORITY LEVEL. INDIVIDUAL PRIORITIES MAY
       SMA                   /CHANGE DUE TO THE INFLUENCE OF
       JMP    EXP004         /PARENTHETICAL GROUPING. INSTRUCTIONS ARE
EXP011 JMS    EXP710         /NOT GENERATED WHEN THE PRIORITY OF THE
/		         /LAST OPERATOR IS LESS THAN THE PRIORITY
/		         /OF THE NEXT OPERATOR.
/		         /WHEN AN  ARG1.POP.ARG2 TRIPLE IS BYPASSED
/		         /DUE TO THE RELATIVE PRIORITIES OF THE
EXP005 LAC    ARG2           /OPERATORS, THE ACCUMULATOR IS STORED IF
       DAC    ARG1           /IT IS AN ARGUMENT.
       LAC    NOP            /THE LIST IS PUSHED DOWN AS THE NEXT
       JMS    EXP640         /ARGUMENT AND NEXT OPERATOR PAIR (ARG2.NOP)
       JMP    EXP001         /BECOME THE LAST ARGUMENT AND LAST OPERATOR
EXP004 LAC    IDXNOP         /AN INDICATION TO GENERATE INSTRUCTIONS
       SAD    C00030         /MAY NOT ALWAYS RESULT IN THE IMMEDIATE
       JMP    EXP006         /GENERATION OF INSTRUCTIONS.
       SAD    C00032         /COMMAS (FUNCTION PARAMETER SEPARATORS)
       JMP    EXP007         /AND PARAMETER LIST TERMINATION DELIMETERS
	JMS EXP530	/ARE HANDLED INDEPENDANTLY.
       JMP    EXP008
       LAC    IDXNOP
	.IFUND	ERMSG
       SAD    C00028
	JMP EXP011	/ERROR: FUNCTION NAME NOT FOLLOWED BY PARAMETER
ER08E	JMP EE		/LIST & IS NOT ITSELF A FUNCTION PARAMETER.
	.ENDC
	.IFDEF	ERMSG
ER08E	ERS	<'  08E'>,<SAD C00028>,EE
	JMP	EXP011
	.ENDC
EXP006 LAC*   BASEJ          /A COMMA CAN BE USED ONLY AS A DELIMETER
/       SNA                   /TO SEPARATE ITEMS IN A LIST AND CAN OCCUR
/	JMP EX	/ONLY WITHIN PARENTHETICAL GROUPING.
ER23X	ERN	<'  23X'>,SNA,EX
			/ERROR: COMMA OUTSIDE OF PARENS.
EXP007 LAC    IDXPOP         /FUNCTION PARAMETERS MAY BE SINGLE
       SAD    C00030         /TERMS OR EXPRESSIONS.
       JMP    EXP009         /FUNCTION AND ARRAY NAMES MAY BE FUNCTION
       SAD    C00028         /PARAMETERS AS LONG AS THEY ARE NOT
       JMP    EXP009         /COMBINED INTO AN EXPRESSION.
	.IFUND	ERMSG
       JMS    EXP530
       JMP    EXP010         /AN ERROR IS ANNOUNCED IF A FUNCTION OR
ER09E       JMP    EE          /ARRAY NAME IS USED IN AN EXPRESSION
	.ENDC
	.IFDEF	ERMSG
ER09E	ERS	<'  09E'>,<JMS EXP530>,EE
	JMP	EXP010
	.ENDC
EXP009 JMS    EXP690	/REPRESENTING A FUNCTION PARAMETER
       LAC    SIGNA2         /ALL PARAMETER EXPRESSIONS ONCE TERMINATED
       SMA                   /ARE REDUCED TO A SINGLE TERM. IF AN
       JMP    EXP012         /EXPRESSION IS INVOLVED, THE CALCULATED
       JMS    EXP680         /VALUE OF THE PARAMETER IS TEMPORIARLY
       JMS    EXP690         /STORED AND THE STORAGE LOCATION USED AS
EXP012	LAC IDXNOP	/THE PARAMETER ADDRESS.
       SAD    C00030         /THE SPECIAL ARGUMENT AND OPERATOR
       JMP    EXP005         /FOLLOWING THE FUNCTION REFERENCE ARE
       JMS    FA2NOP         /FETCHED WHEN THE PARAMETER LIST IS
EXP013 JMS    EXP520         /TERMINATED.
       TAD    K00001
       LAC*   OPI            /THE LIST INDICES ARE PUSHED UP UNTIL THE
       AND    S00077
       SAD    C00028         /START OF THE PARAMETER LIST IS FOUND.
       JMP    EXP014
       JMP    EXP013
EXP014 JMS    EXP540         /THE FUNCTION CALL IS GENERATED AS EITHER
       LAC*   TARGI          /A JMS* OR A JMS. A JMS IS GENERATED WHEN
       JMS    SETA2          /THE FUNCTION NAMED IS A STATEMENT FUNCTION
       LAC*   ADDRA2         /A TRANSFER VECTOR IS UN-NECESSARY FOR
       SMA                   /STATEMENT FUNCTIONS AS THEY ARE LOCALLY
       JMP    EXP015         /DEFINED RATHER THAN EXTERNALLY DEFINED.
       AND    S17777
       JMP    EXP016         /THE CALLING SEQUENCE FOR A STANDARD
EXP015 AND    S17777         /LIBRARY ROUTINE IS AS FOLLOWS...
       XOR    S20000
EXP016 XOR    JMSCMD         /.GLOBAL SUB   VIRTUAL SPECIFICATION
       JMS    RELBIN         / JMS*  SUB   BRANCH VIA TRANSFER VECTOR
/		         / JMP   PN+1  BRANCH AROUND PARAMETERS
       JMS    EXP550         / P1           FIRST PARAMETER
       XOR    JMPCMD         / P2           SECOND PARAMETER
       XOR    MODEA2
       DAC*   ARGI           / P3           THIRD PARAMETER
EXP018	ISZ TARGI	/ ..
       ISZ    TOPI           / PN           NTH PARAMETER
       LAC*   TARGI
       JMS    EXP720
       LAC*   TOPI
       AND    S00077
       SAD    C00032
       SKP
       JMP    EXP018         /AFTER THE LAST PARAMETER HAS BEEN OUTPUT,
       LAC*   ARGI           /THE STRING CODE NECESSARY TO FILL IN THE
       JMS    STRING         /JMP ADDRESS IS OUTPUT. THIS COMPLETES THE
       LAC*   OPI            /GENERATION OF CODE FOR A FUNCTION
       DAC    SIGNA2         /REFERENCE.
       AND    W00000         /THE LIST IS PUSHED UP AS THE FUNCTION
       XOR*   NOP
       DAC*   OPI            /REFERENCE (INCLUDING THE PARAMETER LIST)
       LAC*   ARGI           /IS REPLACED WITH THE ACCUMULATOR AS
       JMS    SETA2          /ARGUMENT 2. THE NEXT OPERATOR IS THE LAST
       LAC    OPI	/ONE OBTAINED. THE MODE AND THE SIGN OF THE 
       DAC    POP	/FUNCTION NAME ARE RETAINED AS THE MODE
       LAC    ARGI
       JMP    EXP020         /AND SIGN OF THE ACCUMULATOR.
EXP008	LAC	IDXNOP	/THE INSTRUCTIONS GENERATED AS THE RESULT
       SAD    C00001         /OF THE REPLACEMENT (=) OPERATOR BEING
       SKP                   /USED ARE DEFERRED UNTIL ALL THE CODE TO
       JMP    EXP010         /THE RIGHT OF THE OPERATOR HAS BEEN
       LAC    IDXPOP         /EXAMINED.
       SAD    C00001         /MULTIPLE EQUAL SIGNS ARE ALLOWED AS LONG
       JMP    EXP011         /AS SUCCESSIVE ASSIGNMENT ARGUMENTS ARE
       LAC    POP            /NOT EXPRESSIONS.
	.IFUND	ERMSG
       SAD    OP0
       JMP    EXP011         /AN ERROR IS ANNOUNCED IF AN EXPRESSION
ER14X       JMP    EX          /PRECEDES A REPLACEMENT OPERATOR.
	.ENDC
	.IFDEF	ERMSG
ER14X	ERS	<'  14X'>,<SAD OP0>,EX
	JMP	EXP011
	.ENDC
							
EXP010 LAC    POP            /THE EXPRESSION IS COMPLETLY DECODED WHEN
       SAD    OP0            /THE PREVIOUS OPERATOR HAS BEEN PUSHED UP
       SKP                   /TO THE BEGINNING OF THE LIST.
       JMP    EXP022
       JMS    EXP680         /THE VALUE OF THE EXPRESSION IS ALWAYS
       JMS    EXP670         /LEFT IN THE ACCUMULATOR.
	 LAC*   BASE0
       SNA                   /AN ERROR IS ANNOUNCED IF THE EXPRESSION
       JMP*   EXPRSN         /CONTAINED MORE RIGHT PARENTHESIS THAN
       LAW    -67
       TAD    OPVALU
       TAD    IFFLAG
/       SNA
/       JMP*   EXPRSN
/       JMP    EX          /LEFT PARENTHESIS.
ER15X	ERN	<'  15X'>,SZA,EX
	JMP*	EXPRSN
EXP022 LAC    IDXPOP         /THE REPLACEMENT, EXPONENTIATION, AND
       SAD    C00001         /UNARY OPERATORS ARE SEPARATED OUT AND
       JMP    EXP024         /EXAMINED SEPARATELY.
	SAD C00026
       JMP    EXP025
       SAD    C00004
       JMP    EXP067
       SAD    C00024
       JMP    EXP026
       DZM    RELOPT
       LAC    MODEA1         /IN GENERAL THE MODES OF THE TWO ARGUMENTS
      SAD    MODEA2         /MUST AGREE.
       JMP    EXP027
       SAD    S20000         /FOR OPERATORS OTHER THAN =, **, AND UNARY
       JMP    EXP028         /THE ONLY LEGAL MODE MIXING IS REAL AND
	.IFUND	ERMSG
       SAD    S40000         /DOUBLE PRECESION.
       JMP    EXP029
ER17V	JMP EV	/ERROR:ARG1 NEITHER REAL NOR DOUBLE PRECISION.
	.ENDC
	.IFDEF	ERMSG
ER17V	ERS	<'  17V'>,<SAD S40000>,EV
	JMP	EXP029
	.ENDC
EXP028 LAC    MODEA2
	.IFUND	ERMSG
       SAD    S40000
       JMP    EXP030
ER15V	JMP EV	/ERROR: ARG1 REAL, ARG2 NOT DOUBLE PRECISION.
	.ENDC
	.IFDEF	ERMSG
ER15V	ERS	<'  15V'>,<SAD S40000>,EV
	JMP	EXP030
	.ENDC
EXP029 LAC    MODEA2         /AN ERROR IS ANNOUNCED IF ARG1 IS DOUBLE
/       SAD    S20000         /PRECESION, BUT ARG2 IS NOT REAL.
/       SKP                   /WHEN DOUBLE AND REAL ARE MIXED, THE
/       JMP    EXP100          /ARGUMENTS ARE ORDERED (IF NOT ALREADY)
ER18V	ERS	<'  18V'>,<SAD S20000>,EV
		         /SUCH THAT THE REAL ARGUMENT IS ARG1. IF
       JMS    EXP650         /ORDERING OCCURS, THE OPERATION IS REVERSED
EXP030 JMS    EXP610         /.POP. IS
       JMP    EXP032         / MULTIPLY OR DIVIDE,
       JMP    EXP033         / ADD OR SUBTRACT, OR
       JMP    EXP034         / RELATIONAL
	.IFUND	ERMSG
ER16V	JMP EV		/ERROR; LOG. OPERATOR USED W/ ARITH. ARGS.
	.ENDC
	.IFDEF	ERMSG
ER16V	ERS	<'  16V'>,SKP,EV
	.ENDC
EXP032 LAC    SIGNA2         /THE SIGN OF THE ACCUMULATOR AFTER THE
       XOR    SIGNA1         /MULTIPLICATION OR DIVISION IS PERFORMED
	DAC SIGNA2	/IS POSITIVE IF BOTH ARGUMENT SIGNS ARE
       JMP    EXP035         /ALIKE AND NEGATIVE IF DIFFERENT.
EXP034 LAC    IDXPOP         /RELATIONAL OPERATIONS ARE EVALUATED BY
       TAD    RELOPC         /SUBTRACTING THE TWO ARGUMENTS AND
       DAC    RELOPT         /EXAMINING THE RESULT. THE ORIGINAL
       LAC    C00012         /OPERATOR IS SAVED FOR FUTURE USE AND THE
       DAC    IDXPOP         /SUBTRACT OPERATOR SUBSTITUTED. SIGN
EXP033 JMS    EXP625         /CONTROL FOR PLUS-MINUS OPERATORS IS USED
EXP035 JMS    EXP690         /SO THAT THE MOST EFFICIENT CODE IS
EXP037 LAC*   POP            /GENERATED.
       AND    U00000         /WHEN THE ARGUMENT MODES ARE DIFFERENT,
       SNA                   /THE REAL ARGUMENT IS ALWAYS LOADED INTO
       JMP    EXP036         /THE ACCUMULATOR AND THE DOUBLE PRECESION
       LAC    IDXPOP         /OPERATION INVOKED.
       SAD    C00012         /REVERSE DIVIDE OR SUBTRACT OPERATIONS
       LAC    C00042         /ARE SET WHEN THE ARGUMENTS WERE
       SAD    C00018         /INTERCHANGED. MULTIPLICATION AND
       LAC    C00039         /ADDITION ARE COMMUTATIVE.
       DAC    IDXPOP         /THE REAL ARGUMENT IS THEN LOADED INTO THE
EXP036 JMS    EXP630         /ACCUMULATOR.
       JMS    EXP590         /THE INSTRUCTION (.POP.ARG2) IS THEN
       TAD    IDXPOP         /OUTPUT.
       LAC    RELOPT         /WHEN THE ORIGINAL OPERATOR WAS A
       SNA                   /RELATIONAL OPERATOR, THE RESULT OF THE
       JMP    EXP038         /SUBTRACTION IS CONVERTED TO ONE OF THE
       LAC    MODEA2         /TWO LOGICAL QUANTITIES (.TRUE. OR .FALSE.)
       SNA                   /THE PROPER RESULT CAN BE DETERMINED BY
       JMP    EXP039         /TESTING THE ARITHMETIC RESULT FOR
       LAC    ACCMNE         /NEGATIVE, ZERO, OR POSITIVE. THE SECOND
       JMS    EXP580         /WORD OF THE FLOATING POINT ACCUMULATOR
       XOR    LACCMD         /CONTAINS THIS INFORMATION.
EXP039 LAC    SIGNA2
       SPA!CLA               /THE ACCUMULATOR IS NEGATED IF THE
		         /SUB-EXPRESSION SIGN IS MINUS.
		         /INTEGER NEGATION IS USED TO MAINTAIN
       JMS    EXP570         /A TRUE ZERO RESULT.
	LAC* RELOPT	/ARG1 - ARG2 TO AC
	
       JMS    ABSBIN         /  XXX    IS...  SPA!SNA!CLA FOR .LE.
       LAC    CLCCMD         /  CLA!CMA  /    SPA!CLA     FOR .LT.
       JMS    ABSBIN         /                SNA!CLA     FOR .EQ.
       DZM    SIGNA2         /                SZA!CLA     FOR .NE.
       LAC    S60000         /                SMA!SZA!CLA     FOR .GT.
EXP066 DAC    MODEA2         /                SMA!CLA FOR .GE.
EXP038 LAC    MODEA2
       DAC*   ARG1           /THE SUBEXPRESSION ARG1.POP.ARG2 IS
       JMS    SETA2          /REMOVED FROM THE LISTS AND REPLACED WITH
       LAC*   NOP            /A NEW ARG1, NOP, AND THE ACCUMULATOR.
       AND    T77777
       DAC*   POP            /THE LIST INDICES ARE PUSHED UP AND THE
       LAC    SIGNA2         /NEW VALUES ASSOCIATED WITH THE
       AND    W00000         / ARG1.POP.ARG2.NOP. SEQUENCE ARE UPDATED.
       XOR*   POP
       DAC*   POP
       LAC    ARG1
EXP020 DAC    ARG2
       DAC    ARGI
       TAD    K00001
       DAC    ARG1
       LAC    POP
       DAC    NOP
       DAC    OPI
       TAD    K00001
       JMS    EXP640
       JMP    EXP003
EXP027 JMS    EXP610         /WHEN THE ARGUMENT MODES AGREE, POP IS
       JMP    EXP041         /DETERMINED TO BE...MULTIPLY-DIVIDE
       JMP    EXP042         /                ...ADD OR SUBTRACT
       JMP    EXP043         /                ...RELATIONAL
       LAC    MODEA2         /                ...LOGICAL
/       SAD    S60000
/       JMP    EXP070         /AN ERROR IS ANNOUNCED IF ARITHMETIC
/	JMP EXP100	/ARGUMENTS ARE USED WITH LOGICAL OPERATORS.
ER19V	ERS	<'  19V'>,<SAD S60000>,EV
EXP070 LAC    TYPEA1
       SNA                   /THE TWO LOGICAL OPERATORS ARE....
       JMP    EXP044         /.AND. (LOGICAL CONJUNCTION) AND
       LAC    TYPEA2         /.OR.  (LOGICAL DISJUNCTION)
       SZA                   /SIGN CONTROL AND BASIC LOGICAL IDENTITIES
       JMP    EXP045         /ARE USED TO DETERMINE WHICH INSTRUCTIONS
       JMS    EXP600         /ARE TO BE GENERATED. REVERSE OPERATIONS
EXP044 LAC    SIGNA1         /ARE UN-NECESSARY AS BOTH OPERATORS ARE
       SMA                   /COMMUTATIVE. (THE ACCUMULATOR IS ARG1).
       JMP    EXP046
       LAC    SIGNA2         /IDENTITIES USED ARE...
       SPA                   / A.AND.(.NOT.B) = .NOT.((.NOT.A).OR.B)
       JMP    EXP102         / A.OR.(.NOT.B) = .NOT.((.NOT.A).AND.B)
EXP052 LAC    S60000         / (.NOT.A).AND.(.NOT.B)=.NOT.(A.OR.B)
       JMS    EXP570         / (.NOT.A).OR.(.NOT.B)=.NOT.(A.AND.B)
EXP049 LAC    IDXPOP         / (.NOT.A).AND.B = (.NOT.A).AND.B
       SAD    C00002         / (.NOT.A).OR.B = (.NOT.A).OR.B
       JMP    EXP048
EXP101       JMS    OPOPA2
       LAC*   ARG2
       JMP    EXP038
EXP048 LAC    SNACMD         /THE .OR.ARG2 INSTRUCTION IS ENCODED AS...
       JMS    ABSBIN         /  SNA       .TRUE..OR.X = .TRUE.
       JMS    EXP590         /  LAC ARG2  .FALSE..OR.X = X
       TAD    C00004
       JMP    EXP038
EXP046	LAC SIGNA2
       SMA
       JMP    EXP049
EXP047 LAC    C00002
       SAD    IDXPOP
       LAC    C00003
       DAC    IDXPOP
       JMP    EXP052
EXP102	LAC	C00003
	SAD	IDXPOP
	JMP	EXP048
	JMP	EXP101
EXP045 LAC    SIGNA1         /WHEN NEITHER ARGUMENT IS THE ACCUMULATOR,
       XOR    SIGNA2         /THE ARGUMENTS ARE ORDERED BY SIGN CONTROL
       SMA                   /AND THE RESULTING ARGUMENT1 LOADED.
       JMP    EXP053         /THE ORDERING IS SUCH THAT...
       LAC    SIGNA2         /  A.OP.B  = A.OP.B
       SPA                   /(.NOT.A).OP.(.NOT.B) =(.NOT.A).OP.(NOT.B)
       JMS    EXP600         /  A.OP.(.NOT.B) = (.NOT. B) .OP. A
EXP053 JMS    EXP630         /(.NOT.A).OP.B  =  (.NOT. A) .OP. B
       JMP    EXP044
EXP041 LAC    SIGNA2         /THE SIGN OF THE SUB-EXPRESSION IS SET AS
       XOR    SIGNA1         /THE ALGEBRAIC SIGN OF THE MULTIPLICATION
       DAC    SIGNA2         /OR DIVISION OPERATION.
       LAC    TYPEA2
       SNA                   /THE ARGUMENTS ARE INTERCHANGED AND THE
       JMS    EXP650         /OPERATOR REVERSED IF ARGUMENT 2 IS THE
       JMP    EXP054         /ACCUMULATOR.
EXP043 LAC    IDXPOP
       TAD    RELOPC         /RELATIONAL OPERATIONS ARE EVALUATED BY
       DAC    RELOPT         /FIRST SUBTRACTING THE TWO ARGUMENTS AND
	LAC C00012	/THEN EXAMINING THE RESULT FOR NEGATIVE,
       DAC    IDXPOP         /ZERO, OR POSITIVE.
EXP042 LAC    TYPEA2
       SNA                   /THE ARGUMENTS OF A SUB-EXPRESSION
       JMS    EXP650         /CONTAINING A PLUS OR MINUS OPERATOR ARE
       LAC    TYPEA1
       SAD    S00121	     /START OF THE EXPONENT FIELD.
       JMP    FAO183    /IF IT IS A Q, THE CONVERSION OF THE
       JMP    FAO140	     /NUMBER IS COMPLETED AND THE LOGIC OP GOT.
/
/ PARENTHESIS (CLOSING) IN THE NUMERIC MODE
FAO190 JMS    FAO570	     /THE CONVERSION IS COMPLETED AND THE
       JMP    FAO073	     /PARENTHESIS LEVEL COUNT UPDATED.
       .EJECT
/ NUMERIC, ALPHABETIC (ALL) CHARACTERS IN THE SYMBOLIC MODE
FAO200 JMS    FAO620	     /ONLY UNCONVERTED ARGUMENTS CONTAIN LETTERS
       JMS    CAT	     /SYMBOLIC NAMES ARE CONCATENATED THREE
       ISZ    TCTR	     /CHARACTER PER WORD USING A RADIX 50
	JMP FAO080	/CONVERSION ALGORITHM.
       LAC    NAME1	     /A SYMBOLIC NAME IS A CHARACTER STRING OF
/       SZA		     /ALPHABETIC AND NUMERIC CHARACTERS. THE
/	JMP EX		/ERROR: SYMBOL CONTAINS MORE THAN 6 ALPHANUMERICS
ER21X	ERN	<'  21X'>,SZA,EX
       LAC    NAME2	     /CONCATENATED STRINGS OCCUPY ONE OR TWO
       DAC    NAME1	     /WORDS IN THE SYMBOL TABLE. THREE OR LESS
       DZM    NAME2	     /CHARACTERS REQUIRE ONLY ONE WORD.
       DZM    CHRCTR
K00004 LAW    -4	     /NAMES CONSISTING OF FOUR TO SIX CHARACTERS
       JMP    FAO023	     /OCCUPY TWO WORDS.
/
/ OPERATOR (*,/) IN THE SYMBOLIC MODE
FAO220 JMS    FAO540	     /TEST FOR THE EXPONENTIATION OPERATOR.
/
/
/ OPERATOR-DELIMETER (+ - , = * / ** C/R) IN THE SYMBOLIC MODE
FAO210 JMS    FAO590	     /SYMBOLIC CONVERSION IS COMPLETED, AND THE
       JMP    FAO002	     /CHARACTER SET AS THE OPERATOR.
/
/ PERIOD (.) IN THE SYMBOLIC MODE
FAO230 JMS    FAO590	     /WITH SYMBOLIC CONVERSION COMPLETED, THE
       JMS    FNBCHR	     /PROCESSOR IS INITIALIZED TO FETCH A
       JMP    FAO110	     /LOGICAL OR RELATIONAL OPERATOR.
       .EJECT
/ PARENTHESIS (OPEN) IN THE SYMBOLIC MODE
FAO240 JMS    FAO590	     /AN OPEN PARENTHESIS DELIMITING A SYMBOLIC
	LAC RSVDTP	/NAME INDICATES THAT THE NAME MAY BE A
	SZA			 /FUNCTION, AN ARRAY ELEMENT, OR AN ARRAY
       JMP    FAO241	     /DECLARATION.
       XCT    CLEN01	     /IF THE SYMBOL WAS JUST ENTERED INTO THE
       JMP    FAO242	     /SYMBOL TABLE, IT IS EITHER A FUNCTION OR
FAO244 LAC    TORDER
       SNA
       JMP    FAO242
       LAC    C00027         /AN ARRAY DECLARATION. THE SYMBOL IS
       JMP    FAO243	     /ASSUMED TO BE AN ARRAY DECLARATION IF A
FAO247 JMS   SYMTYP	     /SPECIFICATION STATEMENT IS BEING PROCESSED
	XOR	V00000
	.IFUND	ERMSG
ER29V	JMP	EV	/ERROR:DO NOT REDEFINE SIMPLE VARIABLE
	.ENDC
	.IFDEF	ERMSG
ER29V	ERS	<'  29V'>,SKP,EV
	.ENDC
	LAC	U00000	/INDICATE
	XOR*	SYMTW2	/DUMMY
	DAC*	SYMTW2	/FUNCTION
FAO242	LAC*	SYMTBC
	AND	W77777	/THE NAME IS ASSUMED TO BE A FUNCTION IF
       XOR    U00000	     /AN EXECUTABLE STATEMENT IS BEING PROCESSED
       DAC*   SYMTBC	     /AS SUCH THE NEW NAME IS TYPED AS A FUNC.
FAO248 LAC    C00028	     /IN ORDER TO DETERMINE WHEN A CLOSING PAREN
       DAC    OPVALU	     /IS THE TERMINATION OF THE ARGUMENT LIST,
       LAC    BASEJ	     /PARENTHESIS LEVEL COUNTING WITHIN THE
       TAD    C00001	     /ARGUMENT LIST IS KEPT SEPARATE FROM THE
/       SAD    BASEMX	     /CURRENT PARENTHESIS LEVEL COUNT. AS SUCH
/FAO245 JMP    EL    	     /A LIMIT IS PLACED ON THE NUMBER OF
ER03L	ERN	<'  03L'>,<SAD BASEMX>,EL
       LAC*   BASEJ	     /FUNCTIONS WHICH MAY APPEAR AS ARGUMENTS OF
       ISZ    BASEJ	     /FUNCTIONS (I.E. NESTED FUNCTIONS). THE
       DAC*   BASEJ	     /NESTING LEVEL IS INCREASED EACH TIME A
       JMP    FAO246	     /FUNCTION IS ENCOUNTED AND SIMILIARLY
			/DECREASED EACH TIME AN ARG LIST IS TERMINATED.
FAO241	JMS SYMTYP	/A SYMBOL WHICH HAS BEEN PREVIOUSLY ENTERED
	XOR U00000	/INTO THE SYMBOL TABLE CAN BE ANY ONE OF
       SKP		     /THE THREE TYPES.
       JMP    FAO248	     /A FUNCTION OR AN ARRAY ELEMENT TYPE IS
       LAC*   SYMTBC	     /EASILY IDENTIFIED AS NO ASSUMPTIONS HAVE
       SPA		     /TO BE MADE BY THE PROCESSOR (THE SYMBOL
       JMP    FAO249	     /TABLE ENTRY CARRIES TYPING INFORMATION).
       XCT    CLEN01	     /THE NAME IS ASSUMED TO BE AN ARRAY
       JMP	FAO247	     /DECLARATION IF TYPING INFORMATION IS
	JMP FAO244	/UNAVAILABLE & A SPEC STMT BEING PROCESSED
			/ERROR: NAME HAS BEEN USED AS AVAILABLE.
FAO249 LAC    C00029	     /SPECIAL DELIMETERS ARE USED AS OPERATORS
FAO243 DAC    OPVALU	     /TO INDICATE THAT THE ARGUMENTS ARE NOT
/       XCT    FAO070	     /SIMPLE VARIABLES AND THE REAL OPERATOR ISTO COME.
/	SKP
/	JMP ES		/ERROR: SUBSCRIPTED VARIABLE USED AS SUBSCRIPT.
ER13S	ERS	<'  13S'>,<XCT FAO070>,ES
       LAC    PASS1	     /THE SUBSCRIPT FLAG IS SET TO INDICATE THAT
       DAC    FAO070	     /THE NEXT CLOSING PAREN IS THE TERMINATION
FAO246 LAC    S01200	     /OF A SUBSCRIPT LIST.
       TAD*   BASEJ	     /THE PARENTHESIS LEVEL COUNT IS UPDATED
       DAC*   BASEJ	     /FOR ALL OPENING PARENTHESIS.
       JMP    FAO002
/
/PARENTHESIS (CLOSING) IN THE SYMBOLIC MODE
FAO250 JMS    FAO590	     /THE CONVERSION IS COMPLETED AND THE
       JMP    FAO073	     /PARENTHESIS LEVEL COUNT UPDATED.
       .EJECT
/ ALPHABETIC (ALL) CHARACTER IN THE LOGIC OPERATOR MODE
FAO260 JMS    CAT	     /THE CONVERSION OF THE LOGICAL OPERATOR OR
       JMP    FAO080	     /CONSTANT OR THE RELATIONAL OP CONTINUES.
/
/ PERIOD (.) IN THE LOGIC OPERATOR MODE
FAO270 LAC    LOCTAB	     /A PERIOD IS THE ONLY LEGAL DELIMETER FOR
       DAC    TCTR	     /THE LOGICAL AND RELATIONAL OPERATORS AND
FAO273	LAC* TCTR	/THE LOGICAL CONSTANTS .TRUE. AND .FALSE.
       SAD    NAME2
       JMP    FAO271	     /THE CONCATENATED MNEMONIC IS COMPARED
       ISZ    TCTR	     /WITH THE TABLE OF ALLOWABLE OPERATORS AND
       LAC    TCTR	     /CONSTANTS.
/       SAD    LOCTBM
/       JMP    EI	/ERROR: MNEMONIC NOT 1 OF ALLOWABLE TERMS.
ER19I	ERN	<'  19I'>,<SAD LOCTBM>,EI
       JMP    FAO273
FAO271 LAC    LOCTAB
       JMS    TWOCMA	     /THE OPERATOR VALUE OF THE TERM IS A
       TAD    TCTR	     /FUNCTION OF ITS POSITION IN THE TABLE.
       DAC    OPVALU
       SNA
       JMP    FAO274	     /THE LOGICAL CONSTANTS .TRUE. AND .FALSE.
       SAD    C00001	     /AND THE UNARY LOGICAL OPERATOR .NOT.
       JMP    FAO274	     /CONNOT BE OBTAINED OTHER THAN AS A FIRST
       TAD    K00004         /ELEMENT OF THE ARGUMENT-OPERATOR PAIR.
       SMA!SZA
       LAC    S00500	     /THE LOGICAL OPERATORS .OR.,.AND., AND
       SPA                   /.NOT. ARE RANKED 3, 3 AND 4 RESPECTIVELY.
       LAC    S00300	     /ALL THE RELATIONAL OPERATORS ARE RANKED
       SNA
       LAC    S00400
       DAC    LEVEL
       SAD    S00400	     /THE SAME AT 5.
       JMP    FAO274
       LAC    TFAO06
       SAD    FAOPUM	     /THE REMAINDER OF THE LOGICAL AND
       JMP    FAO035         /RELATIONAL OPERATORS MUST OCCUR IN CONTEXT
       JMP    FAO002	     /AS BINARY OPERATORS (I.E. PRECEDED AND
/		         /FOLLOWED BY ARGUMENTS). AN ERROR CONDITION
/		         /EXISTS WHEN THIS IS NOT TRUE.
FAO274 LAC    TFAO06
/	SAD FAOPUM	/ERROR: LOGICAL TERMS .NOT.,.TRUE.,&.FALSE.
/	SKP		/DID NOT OCCUR AS UNARY TERMS(I.E. STANDING
/	JMP EX		/ALONE OR PRECEDED OR FOLLOWED BY OPERATORS.)
ER22X	ERS	<'  22X'>,<SAD FAOPUM>,EX
	JMS FAO500
       LAC    OPVALU	     /THE UNARY OPERATOR .NOT. IS HANDLED IN
	SAD C00004	/THE SAME MANNER AS THE UNARY MINUS
       JMP    FAO034	     /OPERATOR.
       LAC    S60000
       DAC    NAME0	     /THE LOGIC CONSTANT MNEMONIC IS CONVERTED
       LAC    OPVALU	     /TO THE PROPER BINARY REPRESENTATION.
       JMS   TWOCMA         /.TRUE.  IS REPRESENTED BY (777777).
       DAC    S
       JMS    FAO610	     /AS WITH NUMERIC ARGUMENTS, THE ARGUMENT
       LAC    W00004	     /NEGATION OPERATOR IS APPLIED DIRECTLY TO
       CMA		     /LOGICAL CONSTANTS, BUT ONLY WHEN THE
       DAC    S 	     /NEGATION OPERATOR IS .NOT..
       JMS    CONSSE	     /THE CONSTANT IS UNCONDITIONALLY ENTERED
       XOR    U00000
       DAC    ARG
       DZM    TFAO04	     /INTO THE CONSTANT POOL AND THE CONVERSION
       JMP    FAO013	     /COMPLETE FLAG IS SET.
       .EJECT
/ UNKNOWN CHARACTER IN ANY MODE
	    		/ALL UNRECOGNIZABLE CHARACTERS NOT IN THE
	       		   /SET ARE TREATED AS ERRONEOUS.
/ ILLEGAL CHARACTER IN THE UNDECIDED MODE
FAO120=FAO090
/ ILLEGAL CHARACTER IN THE NUMERIC MODE
FAO280=FAO090
/ ILLEGAL CHARACTER IN THE LOGIC OPS MODE
FAO290=FAO090
       .EJECT
/ SUBROUTINE TO TEST FOR EXISTING ARGUMENT
/ CALLING SEQUENCE...
/      JMS    FAO500
/
FAO500 CAL    0 	     /TWO ARGUMENTS CANNOT BE WRITTEN BACK-TO-
	.IFUND	ERMSG
       JMS    FAO510	     /BACK. THE ALLOWANCE OF SPECIAL DELIMETERS
       JMP*   FAO500	     /REQUIRES THAT OPERATORS AS FIRST ITEMS BE
ER14S       JMP    ES             	     /EXAMINED CAREFULLY.
	.ENDC
	.IFDEF	ERMSG
ER14S	ERS	<'  14S'>,<JMS FAO510>,ES
	JMP*	FAO500
	.ENDC
       .EJECT
/ SUBROUTINE TO TEST LAST ELEMENT FOR SPECIAL DELIMETER
/ CALLING SEQUENCE...
/      JMS    FAO510
/      JMP    NO	     /LAST ITEM IS NOT	)F OR )S
/      NEXT INSTRUCTION      /LAST ITEM WAS )F	OR  )S
/
FAO510 CAL    0 	     /THE FIRST ITEM PROCESSED CANNOT BE AN
       LAC    TFAO01	     /ARGUMENT IF THE LAST ITEM PROCESSED (LAST
       SAD    C00032	     /CALL TO FARGOP) IS ONE OF THE SPECIAL
       JMP    FAO511	     /DELIMETERS. CLOSING PARENTHESIS FOR BOTH
       SAD    C00033	     /SUBSCRIPT LISTS AND FUNCTION ARGUMENT
FAO511 ISZ    FAO510	     /LISTS ARE SPECIAL DELIMETERS. AS THESE
       JMP*   FAO510	     /DELIMETERS REALLY MARK THE END OF AN
/			     /ARGUMENT, THE FIRST ITEM TO BE PROCESSED
/			     /MUST BE AN OPERATOR.
       .EJECT
/ SUBROUTINE TO SET ARGUMENT AS FUNCTION OR SUBSCRIPTED VARIABLE
/ CALLING SEQUENCE...
/      JMS    FAO520
/
FAO520 CAL    0 	     /WHEN FETCH ARG-OP COMES UP WITH ONLY AN
       LAW    -33	     /OPERATOR IT IS BECAUSE THE ARGUMENT
       TAD    TFAO01	     /ALREADY EXISTS AND SPECIAL DELIMITERS
       DAC    ARG            /HAVE BEEN USED. THIS TIME A SPECIAL
       LAC    C00015		/ARGUMENT IS RETURNED WITH A REAL OPERATOR.
       JMS    SHIFT	     /WHICH ARGUMENT (FUNCTION OR SUBSCRIPTION)
       LAC    ARG            /IS DETERMINED BY THE LAST ITEM PROCESSED.
       DAC    ARG
       JMP*   FAO520
       .EJECT
/ SUBROUTINE TO LOOK AHEAD ONE CHARACTER
/ CALLING SEQUENCE...
/     JMS    FAO530
/
FAO530 CAL    0 	     /THE NEXT NON-BLANK CHARACTER IS OBTAINED
       JMS    FNBCHR	     /IN SUCH A MANNER AS TO ALLOW IT TO BE
       DZM    UNFNBC	     /OBTAINED THE NEXT TIME A CHARACTER FETCH
       JMP*   FAO530
       .EJECT
/ SUBROUTINE TO TEST FOR ** OPERATOR
/ CALLING SEQUENCE...
/      JMS    FAO540
/
FAO540 CAL    0 	     /BOTH MULTIPLICATION AND EXPONENTIATION
       SAD    C00018	     /ARE INDICATED BY USING THE ASTERISK (*)
       JMP*   FAO540	     /CHARACTER. MULTIPLICATION BY ONE (*) AND
       JMS    FNBCHR	     /EXPONENTIATION BY TWO (**).
/			     /WHENEVER AN ASTERISK IS ENCOUNTERED, THE
       SAD    C00042	     /CHARACTER FOLLOWING IT IS EXAMINED TO
       JMP    FAO541		/DETERMINE IF IT IS ALSO AN ASTERISK. IF
       DZM    UNFNBC	     /NOT THE CHARACTER IS UNFETCHED AND THE
	  LAC S00700
	  DAC LEVEL
       JMP*   FAO540	     /OPERATOR REMAINS AS MULTIPLICATION.
FAO541	LAC S01100	/EXPONENTIATION IS RANKED AS 8.
       DAC    LEVEL
       LAC    C00026	     /IF IT IS AN ASTERISK, THE EXPONENTIATION
       DAC    OPVALU	     /OPERATOR IS SET.
       JMP*   FAO540
       .EJECT
/SUBROUTINE TO MOVE CONVERTED MANTISSA TO BETTER PLACE
/CALLING SEQUENCE...
/      JMS    FAO550
/
FAO550 CAL    0 	     /THE CONVERTED MANTISSA IS MOVED AS THE
       LAC    LS	     /SAME STORAGE IS USED FOR THE CONVERSION
       DAC    NAME2	     /OF THE EXPONENT AND THE GENERATION OF
       LAC    MS	     /THE POWER NUMBER FOR FRACTIONAL MANTISSAE.
       DAC    NAME1
       JMP*   FAO550
       .EJECT
/ SUBROUTINE TO CHECK MAGNITUDE OF INTEGER NUMBER
/ CALLING SEQUENCE...
/      JMS    FAO560
/
FAO560 CAL    0 	     /ALL NUMBERS ARE CONVERTED AS IF THEY ARE
       LAC    MS	     /DOUBLE PRECESION CONSTANTS.
/       SZA		     /WHEN IT IS DETERMINED (THROUGH SYNTAX)
/       JMP    .+4	     /THAT THE NUMBER IS AN INTEGER, ITS
ER11M	ERN	<'  11M'>,SZA,EM
       LAC    LS	     /MAGNITUDE MUST BE EXAMINED.
/	SMA		/THE MAGNITUDE OF AN INTEGER CANNOT EXCEED
/       JMP*   FAO560	     /(2**17)-1  (377777)
/       JMP    EM             	     /IF IT DOES, AN ERROR IS ANNOUNCED.
ER06M	ERN	<'  06M'>,SPA,EM
	JMP*	FAO560
       .EJECT
/ SUBROUTINE TO COMPLETE CONVERSION OF A NUMERIC ARGUMENT
/ CALLING SEQUENCE...
/      JMS    FAO570
/
FAO570 CAL    0
       LAC    TFAO04	     /RETURN IS IMMEDIATE WHEN THE NUMBER HAS
       SNA		     /ALREADY BEEN CONVERTED.
       JMP*   FAO570
       LAC    NAME0	     /NUMBERS ARE INTEGERS, REAL FLOATING POINT.
       SNA		     /OR DOUBLE PRECESION FLATING POINT.
       JMP    FAO572
       XCT    FAO131	     /FLOATING POINT NUMBERS MAY OR MAY NOT BE
       JMP    FAO573	     /WRITTEN WITH AN EXPONENT FIELD.
       LAC    TFAO05
/       SMA!SZA
/       JMP    FAO589	     /AN ERROR IS ANNOUNCED IS AN EXPONENT
/	JMP EV		/FIELD WAS INDICATED BUT NEVER OBTAINED.
ER30V	ERN	<'  30V'>,SPA!SNA,EV
	JMP	FAO589
FAO573 JMS    FAO550	     /REAL NUMBERS WITHOUT EXPONENTS ARE
       DZM    LS	     /SUPPLIED WITH AN EXPONENT OF ZERO.
FAO589 LAC    LS	     /FOATING POINT NUMBERS CONSIST OF AN
       DAC    TFAO04	     /EXPONENT (INITIALLY AN EXPONENT OF TEN.(
       LAC    NAME2	     /AND A MANTISSA (INITIALLY AN INTEGER).
       DAC    LS
       LAC    NAME1
       DAC    MS	     /A REAL OR DOUBLE PRECESION NUMBER IS
       TAD    NAME2	     /REPRESENTED INTERNALLY BY TWO OR THREE
       SZA		     /WORDS RESPECTIVELY. A FLOATING POINT
       JMP    FAO575	     /NUMBER WHOSE MAGNITUDE IS ZERO IS
       DZM    S 	     /REPRESENTED INTERNALLY BY TWO (OR THREE)
       JMP    FAO576	     /ZERO WORDS.
FAO575 LAC    C00035	     /THE INITIAL SCALE OF A D.P. INTEGER IS 35.
       DAC    S 	     /THE MANTISSA IS NORMALIZED TO OBTAIN THE
       JMS    DNORM	     /MAXIMUM SIGNIFICANCE FOR THE NUMBER.
       LAC    TFAO05
       SAD    C00012
       JMP    FAO577
       LAC    TFAO04	     /THE CONVERTED EXPONENT IS ADJUSTED TO
       JMS    TWOCMA	     /ACCOUNT FOR THE FRACTIONAL DIGITS IN THE
       DAC    TFAO04	     /MANTISSA. (I.E. THE DIGIT COUNT IS
FAO577 LAC    TFAO04	     /SUBTRACTED FROM THE ALGEBRAIC VALUE OF
       TAD    TFAO03	     /THE INPUTTED TENS EXPONENT.)
       DAC    TFAO04
       SPA		     /THE MAGNITUDE OF THE ADJUSTED EXPONENT
       JMS    TWOCMA	     /IS EXAMINED AND IF IT IS GREATER THAN
       TAD    K00077	     /76 AN ERROR IS ANNOUNCED.
/	SMA
/       JMP    EM	/ERROR: EXPONENT GREATER THAN 76.
ER07M	ERN	<'  07M'>,SMA,EM
       LAC    TFAO04
       DZM    TFAO05	     /THE CONVERSION OF THE NUMBER IS COMPLETE
       SNA		     /IF THE ADJUSTED EXPONENT IS ZERO. (THE
       JMP    FAO578	     /MANTISSA IS NORMALIZED AND THE TWOS SCALE
       SPA		     /FACTOR IS THE EXPONENT.)
       JMP    FAO579	     /THE ALGEBRAIC SIGN OF THE ADJUSTED
       JMS    TWOCMA	     /EXPONENTS DETERMINES WHETHER THE MANTISSA
       DAC    TFAO05	     /IS TO BE MULTIPLIED (+) OR DIVIDED (-) BY
       DAC    TFAO04	     /TEN RAISED TO THE ABSOLUTE VALUE OF THE
       LAC    S 	     /ADJUSTED EXPONENT.
       DAC    TFAO03	     /WHEN THE EXPONENT IS POSITIVE, THE
       LAC    C00001	     /MANTISSA CAN BE SUCCESSIVELY MULTIPLIED
       DAC    S 	     /BY TEN WITHOUT ANY ACCURACY LOSS.
       JMS    FAO550	     /HOWEVER, SUCCESSIVE DIVISIONS BY TEN WILL
       DZM    LS	     /RESULT IN AN ACCURACY LOSS. TO MINIMIZE
       LAC    U00000	     /THE ACCURACY LOSS WHEN NEGATIVE EXPONENTS
       DAC    MS	     /ARE INVOLVED, A NUMBER EQUIVALENT TO THE
FAO579 JMS    NRMULT	     /PROPER TENS POWER IS FORMED AND A SINGLE
       ISZ    TFAO04	     /DIVISION PERFORMED. THE POWER NUMBER IS
       JMP    FAO579	     /FORMED BY SUBSTITUTING A NORMALIZED ONE
       LAC    TFAO05	     /FOR THE MANTISSA. THE RESULT OF EACH
       SNA		     /MULTIPLICATION IS NORMALIZED TO MAINTAIN
       JMP    FAO578	     /THE 35 MOST SIGNIFICANT BITS.
       LAW    -44	     /THE NUMBER CONVERSION IS COMPLETE EXCEPT
       DAC    TCTR	     /FOR FORMING THE NUMBER IF THE EXPONENT IS
       LAC    LS	     /POSITIVE.
       JMS    TWOCMA	     /THE DIVISION MUST BE PERFORMED IF THE
       DAC    TLS	     /EXPONENT IS NEGATIVE.
       LAC    MS
       CMA!SZL		     /THE DIVISOR IS NEGATED FOR SUBTRACTION
       TAD    C00001	     /PURPOSES.
       DAC    TMS
       DZM    MS	     /THE QUOTIENT IS INITIALIZED TO ZERO.
	DZM LS
       LAC    S
       JMS    TWOCMA	     /THE QUOTIENT EXPONENT IS CALCULATED AND
       TAD    TFAO03	     /STORED. (DIVIDEND EXPONENT MINUS DIVISOR
       DAC    S 	     /EXPONENT)
FAO583 JMS    DLSHFT	     /DIVISION OCCURS BETWEEN TWO POSITIVE,
       SPA		     /NORMALIZED NUMBERS. THE QUOTIENT WILL
       JMP    FAO580	     /ALSO BE NORMALIZED OR AT MOST GREATER BY
       LAC    NAME2	     /ONE AS THE RESULT OF THE DIVISION MAY BE
       TAD    TLS	     /AN OVERSCALED NUMBER.
       DAC    TFAO06	     /THIRTY-SIX QUOTIENT BITS ARE GENERATED TO
       GLK		     /ALLOW FOR THE OVERSCALING. THE QUOTIENT
       TAD    NAME1	     /IS NORMALIZED TO THIRTY-FIVE BITS WHEN
       TAD    TMS	     /THIS OCCURS.
       SMA		     /THE DIVISION IS PERFORMED AS SUCCESSIVE
       JMP    FAO581	     /SUBTRACTIONS OF THE DIVISOR ON DECESENDING
       LAC    NAME2	     /POWERS OF TWO OF THE DIVIDEND.
       JMP    FAO582
FAO581 DAC    NAME1
       LAC    C00001	     /A QUOTIENT BIT IS GENERATED EACH TIME THE
       XOR    LS	     /DIVIDEND IS EQUAL TO OR LARGER THAN THE
       DAC    LS	     /DIVISOR. THE DIVIDEND IS REPLACED WITH ITS
       LAC    TFAO06	     /ADJUSTED VALUE. THE QUOTIENT BITS ARE
FAO582 RCL		     /GENERATED IN ASCENDING POWERS OF TWO.
       DAC    NAME2
       LAC    NAME1	     /THE DIVIDEND IS LEFT SHIFTED SO THAT THE
       RAL		     /NEXT SUBTRACTION INVOLVES A LESSER POWER
       DAC    NAME1	     /OF TWO TERM.
       ISZ    TCTR
       JMP    FAO583	     /THE QUOTIENT IS NOW EITHER NORMALIZED OR
FAO580 JMS    DNORM	     /OVERSHIFTED BY ONE.
FAO578 DZM    TMS
       LAC    S20000	     /THE CONVERTED MANTISSA IS ROUNDED AT THE
       SAD    NAME0	     /LEAST SIGNIFICANT BIT. (AT THIS POINT
       LAC    S20377		/REAL NUMBERS ARE SIGNIFICANT TO 28 BITS
       TAD    Z60001		/AND DOUBLE PRECISION NUMBERS ARE
       JMS    DADD	     /SIGNIFICANT TO 36 BITS.) THE NUMBER IS
       JMS    DNORM	     /RE-NORMALIZED IN CASE THE ROUNDING CAUSED
/			     /A CARRY OUT OF THE MOST SIGNIFICANT BIT.
       LAC    NAME0	     /REAL NUMBERS ONLY OCCUPY TWO WORDS IN
       SAD    S40000		/MEMORY. THE NINE LEAST SIGNIFICANT BITS
       JMP    FAO585	     /OF THE EXPONENT AND THE NINE LEAST
       LAC    LS	     /SIGNIFICANT BITS OF THE MANTISSA OCCUPY
       AND    Z77000	     /THE FIRST WORD. THE MOST SIGNIFICANT
       DAC    LS	     /SEVENTEEN BITS OF THE NORMALIZED MANTISSA
       LAC    S 	     /OCCUPY THE SECOND WORD. THE MATISSA IS
       AND    S00777	     /ACCURATE TO 27 BITS (APPROX. 8+ DECIMAL
       XOR    LS	     /DIGITS), THE EXP. TO 8 BITS (10**76).
       DAC    S              /DOUBLE PRECISION NUMBERS OCCUPY THREE
FAO585 LAC    LS	     /WORDS IN MEMORY, WITH THE EXPONENT, THE
       AND    Z77776	     /MOST SIGNIFICANT 17 MANTISSA BITS AND THE
       DAC    LS             /LEAST SIGNIFICANT 17 MANTISSA BITS EACH
       JMS    FAO610	     /OCCUPYING ONE WORD. THE MANTISSA IS
       LAC    W00030	     /ACCURATE TO 34 BITS (APPROX. 10+ DEC DIG).
       XOR    W00000	     /THE ARGUMENT SIGN HAVING BEEN DIRECTLY
       XOR    S
       XOR    MS	     /ASSIMULATED INTO THE ARGUMENT WAS EXAMINED
       DAC    MS	     /TO PREVENT THE LOGICAL UNARY OPERATOR
       JMS    FAO550	     /.NOT. FROM BEING APPLIED TO AN ARITH TERM.
       JMP    FAO576
FAO572 JMS    FAO560	     /INTEGER NUMBERS MUST BE EXAMINED TO
       DAC    S 	     /DETERMINE IF THEIR MAGNITUDE IS GREATER
       JMS    FAO610	     /THAN (2**17)-1.
	LAC W00030	/THE ARGUMENT SIGN CAN BE DIRECTLY APPLIED
       JMS    TWOCMA	     /TO CONSTANTS. POSITIVE CONSTANTS ARE LEFT
       DAC    S 	     /UNTOUCHED AND NEGATIVE CONSTANTS ARE
FAO576 JMS    TSTORD	     /NEGATED AND TREATED AS POSITIVE CONSTANTS.
       SNA		     /CONSTANTS ARE NOT ENTERED INTO THE
       JMP    FAO588	    /CONSTANT TABLE IF THEY APPEAR ON
       JMS    CONSSE	     /PRE-EXECUTABLE OR DATA STATEMENTS.
FAO574 XOR    U00000	     /THE CONSTANTS ADDRESS IN THE CONSTANT
       DAC    ARG	     /TABLE PLUS AN INDENTIFICATION CODE ARE
/			     /USED TO FORM THE ARGUMENT.
       DZM    TFAO04	     /THE CONVERSION IS FLAGGED AS COMPLETE AND
       DZM    SIGN
       JMP*   FAO570	     /RETURN IS MADE TO THE CALLING PROGRAM.
FAO588 LAC    NMODE
       JMP    FAO574	     /SET DUMMY ADDRESS
NMODE .DSA NAME0
       .EJECT
/ SUBROUTINE TO FORM A SYMBOLIC ARGUMENT
/ CALLING SEQUENCE...
/      JMS    FAO590
/
FAO590 CAL    0
       LAC    TFAO04	     /RETURN IS IMMEDIATE IF THE SYMBOL HAS
       SNA		     /ALREADY BEEN ENTERED INTO THE SYMBOL
       JMP*   FAO590	     /TABLE. OTHERWISE, THE SYMBOLIC ARGUMENT
       JMS    FAO600	     /IS ENTERED INTO THE SYMBOL TABLE.
       JMS    SYMBSE	     /THE JUST ENTERED-PREVIOUSLY ENTERED
       LAC    T00000	/INDICATOR IS RETAINED FOR FUTURE USE.
       XOR    SYMTBC	     /THE ARGUMENT IS FORMED BY COMBINING THE
       DAC    ARG	     /ENTRY ADDRESS AND AN INDICATOR IDENTIFYING
       LAC*   SYMTBC	     /THE ARGUMENT AS SYMBOLIC.
       AND    S60000	     /NEGATION OPERATORS CANNOT BE DIRECTLY
       SAD    S60000	     /APPLIED TO SYMBOLIC ARGUMENTS. HOWEVER,
/			     /THEY CAN BE UTILIZED TO ADVANTAGE BY
       JMP    FAO592	     /EMPLOYING SIGN CONTROL ALGORITHMS (THIS
       JMS    FAO610	     /HAS THE EFFECT OF REDUCING THE NUMBER OF
       LAC    W00030	     /UNARY ACCUMULATOR NEGATIONS).
       OPR		     /THE MODE OF THE NEGATION OPERATOR (IF IT
       JMP    FAO593	     /EXISTS) IS COMPARED WITH THE MODE OF THE
FAO592 JMS    FAO610	     /SYMBOLIC ARGUMENT. AN ERROR IS ANNOUNCED
       LAC    W00004	     /WHEN THE TWO DO NOT MATCH.
       OPR		     /I.E. LOGICAL .NOT. WITH ARITHMETIC NAME
FAO593 DZM    TFAO04	     /OR ARITHMETIC MINUS WITH A LOGICAL NAME.
       JMP*   FAO590
       .EJECT
/ SUBROUTINE TO SET UP NAME WORDS FOR ENTRY IN THE SYMBOL TABLE
/ CALLING SEQUENCE...
/      JMS    FAO600
/
FAO600 CAL    0
       LAC    CHRCTR	     /SYMBOLS AND STATEMENT NUMBERS ARE ENTERED
       SNA		     /INTO THE SYMBOL TABLE AS EITHER THREE OR
       JMP    FAO603	     /SIX CHARACTER NAMES.
       TAD    K00003        /NAMES WHICH ARE LESS THAN EITHER THREE
       SMA
       JMP    FAO603
       DAC    TFAO04	     /OR SIX CHARACTERS IN LENGTH ARE PADDED
       DZM    CHAR	     /WITH SPACES TO MAKE UP THE RIGHT NUMBER.
FAO604 JMS    CAT
       ISZ    TFAO04	     /THIS BIT OF FUSSING AROUND MAKES LIFE
       JMP    FAO604	     /MORE BEARABLE FOR SYMBOL TABLE SORTS AND
FAO603 LAC    NAME1	     /WORD ENTRY INTO THE SYMBOL TABLE.
       SZA
       JMP    FAO601	     /A ONE WORD ENTRY IS INDICATED BY THE LACK
       LAC    NAME2	     /OF AN ENTRY IN ONE OF THE WORDS.
       DZM    NAME2
FAO602 DAC    NAME1
       JMP*   FAO600
FAO601 LAC    NAME2	     /A TWO WORD ENTRY REQUIRES THAT THE FIRST
       SNA		     /WORD BE TAGGED AS SUCH FOR FUTURE
       JMP*   FAO600	     /RECOGNITION AND IDENTIFICATION.
       LAC    W00000
       XOR    NAME1
       JMP    FAO602
       .EJECT
/ SUBROUTINE TO CHECK MODE MIX OF ARGUMENT AND NEGATION OPERATOR
/ CALLING SEQUENCE...
/      JMS    FAO610	     /TYPE IS (400013) FOR ARITHMETIC ARGUMENTS
/      LAC    TYPE	     /TYPE IS (400004) FOR LOGICAL ARGUMENTS
/      JMP    YES	     /PROPER NEGATION SIGN IS SET
/      NEXT INSTRUCTION      /SIGN IS +
/
FAO610 CAL    0 	     /AN ERROR CONDITION EXISTS WHEN A NEGATION
       XCT*   FAO610	     /OPERATOR OF ONE MODE IS APPLIED TO AN
       ISZ    FAO610	     /ARGUMENT OF A DIFFERENT MODE.
       XOR    SIGN	     /I.E. THE LOGICAL OPERATOR .NOT. CANNOT BE
       SNA		     /APPLIED TO AN ARITHMETIC ITEM, NOR CAN
       JMP    FAO611	     /THE ARITHMETIC OPERATOR MINUS BE APPLIED
       ISZ    FAO610	     /TO A LOGICAL TERM.
       LAC    SIGN
/       SZA
/       JMP    EXP100         /AN ERROR IS ANNOUNCED IF MODE MIXING OCCURS.
ER31V	ERN	<'  31V'>,SZA,EV
FAO611 LAC    S 	     /THE INTEGER (LOGICAL) CONSTANT IS RETURNED
       JMP*   FAO610	     /SO THAT IT MAY BE EASILY NEGATED PROPERLY.
       .EJECT
/ SUBROUTINE TO ANNOUNCE AN ERROR IF THE ARGUMENT CONVERSION IS FINISHED
/ CALLING SEQUENCE...
/      JMS    FAO620
/
FAO620 CAL    0
       LAC    TFAO04	     /AN ERROR IS ANNOUNCED IF A DIGIT OR
/       SZA		     /LETTER IS OBTAINED IN THE ARGUMENT MODE
/       JMP*   FAO620	     /AFTER THE ARGUMENT HAS BEEN CONVERTED
/       JMP    ES             	     /BUT AN OPERATOR HAS NOT BEEN FOUND.
ER15S	ERN	<'  15S'>,SNA,ES
	JMP*	FAO620
       .EJECT
/ SUBROUTINE TO SEARCH-ENTER NAMES IN THE SYMBOL TABLE
/ CALLING SEQUENCE
/      JMS    SYMBSE
/			     /NAME JUST ENTERED IF ZERO ACC
/			     /NAME PREVIOUSLY ENTERED IF NON-ZERO ACC
/
SYMBSE CAL    0 	     /INITIALIZE THE SEARCH ADDRESS TO THE FIRST
	ISZ	FILFLG
	SKP
	JMP	CMDA1
	DZM	FILFLG
       LAC    SYMTB0	     /ENTRY IN THE SYMBOL TABLE.
       DZM    CHRCTR	     /INITIALIZE RELATIVE POSITION
SBSE01 DAC    SYMTBC
       ISZ    CHRCTR
       SAD    SYMTBN	     /THE SEARCH ADDRESS IS COMPARED AGAINST
       JMP    SBSE02	     /THE NEXT ENTRY ADDRESS. IF EQUAL, THE
       JMS    SETADR	     /NAME IS NOT IN THE TABLE.
       LAC*   SYMTW2	     /OTHERWISE THE NAME IS COMPARED AGAINST
       AND    X77777
       SAD    NAME1	     /THE CURRENT SEARCH SYMBOL.
       SKP
       JMP    SBSE04
       SMA		     /THE NAME IS CONSIDERED FOUND WHEN THE
       JMP    SBSE05	     /NAME WORDS COMPARE.
       LAC*   SYMT2A
       SAD    NAME2
       JMP    SBSE05
SBSE04	JMS	SBSE50		/WHEN THE NAME DOES NOT MATCH THE CURRENT SEARCH SYMBOL
				/THE NEXT SYMBOL IS FETCHED
       JMP    SBSE01	     /ARRAYS.
SBSE05 LAC*   SYMTBC
       AND    S60000
       DAC    NAME0          /THE MODE OF THE FOUND VARIABLE IS
	LAC TSMTBN	/RETAINED AS THE MODE OF THE CURRENT VAR.
       SNA
       JMP    SBSE08         /THESE DUMMY VARIABLES ARE UNIQUE ONLY
       LAC    SYMTBC         /TO THE CURRENT STATEMENT FUNCTION.
       JMS    TWOCMA         /HOWEVER, THEY DO RETAIN THE SAME MODE
       TAD    DOTABX         /AS THE PERMANENT VARIABLE BY THE SAME
       SPA!SNA               /NAME.
       JMP    SBSE03
SBSE08 LAC*   SYMTBC
	SPA
       JMP    SBSE06           /(COMMON BLOCK NAME)
       AND    S17777
       SAD    S17777
       XCT	PASS		/IGNORE PASS 2
       JMP    SBSE06
       LAC*   SYMTBC         /NAMES REFERENCED BY EXECUTABLE CODE
       XOR    C00001         /FOR THE FIRST TIME ARE TREATED (EXTERNALLY)
       DAC*   SYMTBC         /AS IF THEY HAVE JUST BEEN ENTERED INTO
       AND    Z00000         /THE SYMBOL TABLE (SIMPLE NON-COMMON
/       SNA                   /VARIABLES APPEARING ON SPECIFICATION
/       JMP    CLACMD         /STMNTS. MAY BE RE-TYPED AS FUNCTIONS)
/       LAC    SYMTBC         /THE SYMTAB ADDRESS IS RETURNED AS AN
/       JMP    SBSE07	     /INDICATOR THAT THE SYMBOL WAS FOUND.
	SZA
	JMP	SBSE06
	LAC	SYMTBC
	SAD	SYMTB0
	LAC	FCNFLG
	AND	Z40000
	SAD	JMPCMD
	SKP
	JMP	CLACMD
	DAC	SUBRN0
SBSE06	LAC	SYMTBC
	JMP	SBSE07
/
/ ENTER SYMBOL INTO THE SYMBOL TABLE
/
SBSE02 LAC    TSMTBN
       SZA
       JMP    SBSE03
       LAC    C00006	     /WHEN THE NAME IS NOT IN THE TABLE AN
       XCT    CLEN01
       TAD    K00004
       JMS    TABOFL	     /ATTEMPT IS MADE TO ENTER IT.
       LAC    NAME0	     /THE NAME IS ORIGINALLY ENTERED AS IF IT IS
       JMS    SETN	     /AS A SIMPLE VARIABLE.
       XOR    NAME0	     /THE NUMBER OF MACHINE WORDS PER ITEM,
/			     /BASED ON THE MODE, IS INITIALLY ENTERED
       DAC*   SYMTBN	     /FOR THE SYMBOLS DEFINITION.
       ISZ    SYMTBN	     /THE NEXT ENTRY ADDRESS IS UPDATED BY
       LAC    NAME1	     /EITHER TWO OR THREE DEPENDING UPON THE
       DAC*   SYMTBN	     /NUMBER OF CHARACTERS WHICH CONSTITUTE THE
       ISZ    SYMTBN	     /NAME.
       SMA
       JMP    SBSE10
       LAC    NAME2	     /STORE THE SECOND HALF NAME WORD IF THE
       DAC*   SYMTBN	     /SYMBOL CONTAINS MORE THAN THREE CHARACTERS
SBSE10 JMS    SETADR
       XCT    CLEN01	     /IF THE ENTRY IS TO BE MADE BEFORE THE
       JMP    SBSE11	     /FIRST EXECUTABLE STATEMENT, FOUR
       LAC    S17777         /WORD 3 IS INITIALIZED TO CONTAIN AN
       DAC*   SYMTW3	     /UNDEFINED RELATIVE ADDRESS.
       LAC    CHRCTR	     /WORD FOUR IS INITIALIZED TO CONTAIN A
       DAC*   SYMTW4	     /SELF REFERENCING LINKAGE ADDRESS.
       DZM*   SYMTW5	     /THE INFORMATION WHICH MAY BE ADDED IS
       DZM*   SYMTW6	     /ARRAY DIMENSIONS AND EQUIVALENCE CLASS
	JMP	SBSE12-1		/OR COMMON BLOCK LINKAGE ADDRESSES.
SBSE11 LAC    NAME0	     /NAMES ENTERED AFTER THE ASSIGNMENT OF
       XOR    S17776	     /EQUIVALENCE CLASSES ARE FLAGGED AS
       DAC*   SYMTBC	     /UNDEFINED FOR LATER ASSIGNMENT.
       JMS    SBSE50	     /THE NEXT ENTRY ADDRESS IS UPDATED
SBSE12 DAC    SYMTBN	     /ACCORDINGLY.
CLACMD CLA
SBSE07 DAC    NAME1	     /THE ACCUMULATOR IS CLEARED AS AN INDICATOR
/	SAD SUBRAD	/THAT THE NAME WAS JUST ENTERED.
/       SKP
       JMP*   SYMBSE	      /IF NAME IS FIRST ENTRY IN
/       LAC    JMPCMD	       /SYMTAB (POSSIBLE FUNCTION NAME)
/       DAC    SUBRN0	      /SET FUNCTION NAME USED
/       LAC    NAME1	      /INDICATOR (IGNORED BY NON-SUBPROGRAM
/       JMP*   SYMBSE		 /PROCESSING).
SBSE03 LAC    SYMTB0
	DAC TCTR
       JMS    CNSE50         /ERASEABLE DUMMY VARIABLES
       LAC    NAME2         /(FROM STATEMENT FUNCTIONS)
       DAC*   TCTR          /ARE ENTERED IN FRONT OF THE
       LAC    NAME1          /PERMANENT SYMBOL TABLE.
       SPA
       JMS    CNSE50
       LAC    NAME1
       DAC*   TCTR
       JMS    CNSE50
       DAC    SYMTB0
       DAC    SYMTBC
       LAC    NAME0
       DAC*   TCTR
       JMP    CLACMD
       .EJECT
/ SUBROUTINE TO UPDATE CURRENT SYMBOL ADDRESS TO NEXT ENTRY
/ CALLING SEQUENCE...
/      JMS    SBSE50
/							
SBSE50 CAL    0
	XCT	PASS
	JMP	SBSE14
	XCT	CLEN01
	JMP	SBSE14
	LAC	SYMTW6
	TAD	C00001
	JMP	SBSE51+1
SBSE14	LAC*	SYMTBC
       SAD    K00001         /COMMON BLOCK NAMES OCCUPY 4 WORDS. (5)
       JMP    SBSE51
       RCL
	SNL
	JMP	SBSE09
	SPA						
       JMP    SBSE52
SBSE13       LAC    SYMTW6         /ARRAY NAMES AND INTERNAL FUNCTIONS
       TAD    C00001         /OCCUPY SIX WORDS. ,SEVEN WORDS)
	JMP	SBSE51+1
SBSE52	RCL
	SPA
	JMP	SBSE13
SBSE09	JMS	SYMTYP
       XOR    T00000
	LAW -2		/SIMPLE VARIABLES IN COMMON OCCUPY 4 WORDS
       TAD    SYMTW5         /(5WORDS)
	SKP
SBSE51 LAC    SYMTW5
	.IFDEF	X4K
	OPR		/GETS INIT. TO JMS SYMSAF WHEN EXTRA 4K PRESENT
	.ENDC
       JMP*   SBSE50
	.IFDEF	X4K
TEMSAF	0		/STORE PROPOSED FIRST ENTRY ADDRESS HERE
	.ENDC
       .EJECT
/ SUBROUTINE TO SEARCH-ENTER CONSTANTS IN THE CONSTANT TABLE
/ CALLING SEQUENCE...
/      JMS    CONSSE
/							
CONSSE CAL    0              /INITIALIZE THE SEARCH ADDRESS TO THE FIRST
       LAC   CONTB0         /ENTRY IN THE CONSTANT TABLE
CNSE05 DAC    TCTR           /THE CURRENT ENTRY ADDRESS IS RETAINED SO
       DAC    CONTBC         /THAT IT MAY BE RETURNED TO THE CALLING
       SAD    CONTBN         /PROGRAM. WHEN THE CURRENT SEARCH ADDRESS
       JMP    CNSE02         /IS EQUAL TO THE NEXT ENTRY ADDRESS, THE
       LAC*   TCTR           /CONSTANT IS NOT IN THE TABLE AND MUST BE
       AND    W60000         /ENTERED. IF NOT, THE CONSTANT LOCATED AT
       DAC    TEMP0          /THE SEARCH ADDRESS IS COMPARED AGAINST
       XOR    NAME0          /THE INCOMING CONSTANT. CONSTANTS MUST
       SZA                   /AGREE BOTH IN MODE AND MAGNITUDE BEFORE
       JMP    CNSE03         /THEY CAN BE CONSIDERED IDENTICAL.
       JMS    CNSE50         /WITH MODES IDENTICAL, THE SEARCH ADDRESS
       LAC*   TCTR           /IS UPDATED TO THE FIRST CONSTANT WORD.
       SAD    S              /IF THE FIRST WORDS DONT COMPARE, THE
       JMP    CNSE04         /SEARCH ADDRESS IS UPDATED TO THE NEXT
CNSE03 JMS    CNSE51         /ENTRY IN THE CONSTANT TABLE AND THE SEARCH
       JMP    CNSE05         /CONTINUES.
CNSE04	LAC TEMP0	/THE MODE IS EXAMINED FOR INTEGER OR
       SNA                   /LOGICAL WHEN THE FIRST WORDS COMPARE.
       JMP    CNSE08         /THE CONSTANT HAS BEEN FOUND IF THE MODE
       XOR    S60000         /IS EITHER INTEGER OR LOGICAL.
       SNA                   /WHEN THE MODE IS EITHER REAL OR DOUBLE,
       JMP    CNSE08         /THE SEARCH ADDRESS IS UPDATED SO THAT THE
       JMS    CNSE50         /SECOND CONSTANT WORDS MAY BE COMPARED.
       LAC*   TCTR
       SAD    NAME1          /IF THE SECOND CONSTANT WORDS COMPARE
       SKP                   /THE MODE IS EXAMINED TO DETERMINE IF THE
       JMP    CNSE03         /CONSTANT IS A REAL OR DOUBLE PRECESION
       LAC    TEMP0          /CONSTANT. WHEN THE SECOND WORDS DO NOT
       XOR    S20000         /COMPARE THE NEXT ENTRY IS EXAMINED.
       SNA                   /IF THE CONSTANT IS A REAL CONSTANT, A
       JMP    CNSE08         /MATCH HAS BEEN FOUND AND EXIT IS IMMEDIATE
       JMS    CNSE50         /IF THE CONSTANT IS A DOUBLE PRECESION
       LAC*   TCTR           /CONSTANT, THE THIRD CONSTANT WORDS ARE
       SAD    NAME2          /COMPARED. IF EQUAL, A MATCH IS FOUND. IF
       JMP    CNSE08         /NOT EQUAL, THE NEXT ENTRY IS EXAMINED.
       JMP    CNSE03
CNSE02 LAC    C00003
       JMS    TABOFL         /BEFORE A NEW CONSTANT IS ENTERED INTO THE
       LAC    NAME0          /TABLE, IT MUST BE DETERMINED IF THERE IS
       DAC*   TCTR           /ENOUGH ROOM FOR IT. AT THIS POINT (FOR THE
       JMS    CNSE50         /SAKE OF SIMPLICITY) ALL CONSTANTS ARE
       LAC    S              /ASSUMED TO BE DOUBLE PRECESION. WHEN ROOM
       DAC*   TCTR           /EXISTS, ALL FOUR WORDS OF THE ASSUMED
       JMS    CNSE50         /DOUBLE PRECESION CONSTANT ARE ENTERED
       LAC    NAME1          /INTO THE TABLE.
       DAC*   TCTR
	JMS CNSE50
       LAC    NAME2
       DAC*   TCTR
       JMS    CNSE51         /THE NEXT ENTRY ADDRESS IS UPDATED, HOWEVER
       DAC    CONTBN         /ACCORDING TO THE MODE OF THE CONSTANT.
CNSE08 LAC    CONTBC         /THE ENTRY ADDRESS OF THE CONSTANT IS
       JMP*   CONSSE         /RETURNED TO THE CALLING PROGRAM.
       .EJECT
/ SUBROUTINE TO UPDATE THE CONSTANT TABLE SEARCH ADDRESS BY ONE
/ CALLING SEQUENCE...
/      JMS    CNSE50
/							
CNSE50 CAL    0              /THE CONSTANT TABLE OCCUPIES THE TOP-HALF
K00001 LAW    -1             /OF THE CONSTANT-SYMBOL TABLE.
       TAD    TCTR           /ENTRIES ARE MADE FROM THE TOP DOWN. THERE-
       DAC    TCTR           /FORE THE SEARCH ADDRESS MUST BE NEGATIVELY
	.IFDEF	DUMY
/	SAD*	.FFREE		/TOO MANY DUMMY VAR. IN A STATEMENT FUNCTION
/	JMP	ET
ER02T	ERN	<'  02T'>,<SAD* .FFREE>,ET
	.ENDC
       JMP*   CNSE50         /UPDATED.
       .EJECT
/ SUBROUTINE TO UPDATE CONSTANT TABLE INTRY ADDRESS
/ CALLING SEQUENCE...
/      JMS    CNSE51
/							
CNSE51 CAL    0              /THE CURRENT ENTRY ADDRESS IS UPDATED BY
       LAC*   CONTBC         /THE NUMBER OF WORDS OCCUPIED BY THE ENTRY.
       JMS    SETN           /THAT NUMBER IS A FUNCTION OF THE MODE OF
       JMS    TWOCMA         /THE CURRENT ENTRY.
       TAD    CONTBC         /AN ENTRY CONSISTS OF TWO (INTEGER-LOGICAL)
       TAD    K00001         /THREE (REAL, HOLLERITH), OR FOUR (DOUBLE)
	.IFDEF	X4K
CNSE52	OPR		/THIS GETS MODIFIED TO JMS CONSAF WHEN EXTRA 4K PRESENT
	.ENDC
       JMP*   CNSE51         /WORDS. THE UPDATED ADDRESS IS RETURNED.
       .EJECT
/ SUBROUTINE TO TEST FOR SYMBOL-CONSTANT TABLE OVERFLOW
/ CALLING SEQUENCE...
/      LAC    N              /N IS THE LENGTH OF THE ENTRY MINUS ONE
/      JMS    TABOFL         /(THE MINUS ONE IS FOR TWOS COMPLEMENT)
/							
TABOFL	CAL 0		/THE SYMBOL AND CONSTANT TABLES ARE REALLY
       TAD    SYMTBN         /JUST ONE BIG TABLE. SYMBOLS ARE ENTERED
       CMA                   /FROM THE BOTTOM UP. CONSTANTS ARE ENTERED
       TAD    CONTBN         /FROM THE TOP DOWN.
/	SMA		/ERROR: PROPOSED ENTRY WILL OVERLAY AN
/	JMP* TABOFL	/EXISTING ENTRY IN THE OTHER TABLE.
/	JMP ET		/SYMBOL-CONSTANT TABLE OVERFLOW.
ER03T	ERN	<'  03T'>,SPA,ET
	JMP*	TABOFL
       .EJECT
/ SUBROUTINE TO DETERMINE NUMBER OF MACHINE WORDS OCCUPIED BY AN ITEM
/ BASED ON THE MODE OF THE ITEM.
/ CALLING SEQUENCE...
/      LAC    MODE           /MODE IS CONTAINED IN BITS 3 AND 4
/      JMS    SETN
/							
SETN   CAL    0
       AND    S60000         /ITEM MODE IS SPECIFIED BY A TWO BIT FIELD
       DAC    TEMP0          /IN BITS ONE AND TWO OF A WORD. THE FIELD
       LAW    -15         /SPECIFIES FOUR MODES OF ITEMS. THE FORMS
       JMS    SHIFT          /ARE INTEGER (00), REAL (01), DOUBLE (10),
       LAC    TEMP0          /AND LOGICAL (11). THE NUMBER OF MACHINE
       TAD    C00001         /WORDS REQUIRED TO REPRESENT EACH MODE
       AND    C00003         /INTERNALLY IS,,,INTEGER (1), RAL (2),
       SNA                   /DOUBLE (3), AND LOGICAL (1).
       LAC    C00001
       JMP*   SETN
       .EJECT
/ SUBROUTINE TO CONVERT DECIMAL TO BINARY
/ CALLING SEQUENCE
/      JMS    DECBIN
/							
DECBIN CAL    0
       JMS    MULTEN         /(ACC)*10
	DZM TMS
       LAC    CHAR           /CONVERT INTERNAL REPRESENTATION OF DIGIT
       TAD    K00029         /TO PURE BINARY CHARACTER (00 TO 11)
       JMS    DADD           /(ACC*10)+DIGIT
/       SPA
/       JMP    MTWO01         /NUMBER IS GREATER THAN (2**35)-1
ER08M	ERN	<'  08M'>,SPA,EM
       JMP*   DECBIN
       .EJECT
/ SUBROUTINE TO CONCATENATE SYMBOLS
/ CALLING SEQUENCE
/      JMS    CAT
/							
CAT    CAL    0              /SYMBOLS ARE CONCATENATED USING A RADIX 40
       LAC    C00002         /SCHEME..I.E. NORMAL BASE CONVERSION EXCEPT
       JMS    SHIFT          /THERE ARE 40 ELEMENTS IN THE SYSTEM.
       LAC    NAME2          /(WORD)*4
       TAD    NAME2          /(WORD*4)+(WORD*1)
       DAC    NAME2
       LAC    C00003
       JMS    SHIFT
       LAC    NAME2          /(WORD*5)*8
       TAD    CHAR
       DAC    NAME2          /(WORD*40)+CHAR
       ISZ    CHRCTR         /COUNT THE CONCATENATED CHARACTERS.
       JMP*   CAT
       JMP*   CAT
       .EJECT
/ SUBROUTINE TO DETERMINE IF THE FIRST EXECUTABLE STATEMENT HAS BEEN
/  ENCOUNTERED.
/ CALLING SEQUENCE...
/      JMS    TSTORD
/      JMP    YES            /YES
/      NEXT INSTRUCTION      /NO
/							
TSTORD CAL    0              /ALL STATEMENTS CONTRIBUTING TO THE
	LAC TORDER	/SPECIFICATION OF DATA STORAGE HAVE AN
       TAD    X40000        /ORDER NUMBER LESS THAN  5 . ALL SUCH
       SPA                   /STATEMENTS MUST OCCUR BEFORE THE FIRST
/		         /EXECUTABLE STATEMENT (DATA AND FORMAT
       ISZ    TSTORD         /MUST ALSO OCCUR AFTER SPECIFICATION
       JMP*   TSTORD         /STATEMENTS.
       .EJECT
/ SUBROUTINE TO DETERMINE TYPE OF CURRENT SYMBOL TABLE ENTRY
/ CALLING SEQUENCE...
/      JMS    SYMTYP         /X IS...0 FOR NON-COMMON, 1 FOR COMMON,
/      XOR    (X00000)       /       2 FOR FUNCTION, 3 FOR DUMMY
/      JMP    NO             /NOT TYPE TESTED
/      NEXT INSTRUCTION      /IS THE TYPE TESTED
/							
SYMTYP CAL    0 	     /THE DESCRIPTION WORD OF THE CURRENT
       LAC*   SYMTBC	     /SUMBOL TABLE ENTRY IS FETCHED AND THE
       AND    V00000	     /SYMBOLS TYPE IS ISOLATED.
       XCT*   SYMTYP	     /THIS TYPE IS MATCHED AGAINST THAT
       ISZ    SYMTYP	     /SPECIFIED BY THE CALLING SEQUENCE.
SNACMD SNA
/		         /THE EXIT POINT IS DETERMINED BY THE
       ISZ    SYMTYP	     /RESULT OF THE COMPARISON.
       JMP*   SYMTYP
       .EJECT
/ SUBROUTINE TO FETCH STATEMENT NUMBER
/ CALLING SEQUENCE...
/      JMS    FETSNO
/
FETSNO CAL    0 	     /A STATEMENT NUMBER IS A SYMBOL MADE UP OF
FSNO07 JMS    FNBCHR	     /ALL NUMERIC CHARACTERS. FIVE ARE ALLOWED.
       LAC    CHRTYP
       SAD    C00001	     /IF THE FIRST CHARACTER IS NOT NUMERIC, NO
       JMP    FSNO01	     /STATEMENT NUMBER HAS BEEN FOUND AND THIS
       DZM    UNFNBC	     /FACT IS INDICATED TO THE CALLING PROGRAM
	LAW -1		/BY RETURNING WITH A ZERO ACCUMULATOR. THE
       JMP*   FETSNO	     /COLUMN COUNT IS RESET TO ALLOW THE CHAR
FSNO01 LAC    CHAR	     /TO BE RE-FETCHED.
       SAD    C00029	     /LEADING ZEROES IN A STATEMENT NUMBER ARE
       JMP    FSNO07	     /IGNORED.
       DZM    NAME1
       LAC    C00002
       DAC    CHRCTR
       LAW    -2	     /INITIALLY THE FIRST NAME WORD IS CLEARED
FSNO06 DAC    TCTR	     /AND THE CHARACTER PUT INTO WORKING STORAGE
       LAC    CHAR	     /A MAXIMUM OF TWO MORE CHARACTERS WILL BE
       DAC    NAME2	     /CONCATENATED TO FORM THE FIRST HALF OF THE
/			  /SYMBOL FORM OF A STATEMENT NUMBER.
FSNO05 JMS    FNBCHR
       LAC    CHRTYP
       SAD    C00001	     /THE NEXT NON-DIGIT CHARACTER ENCOUNTERED
       JMP    FSNO02	     /IS INTERPRETED AS THE TERMINAL CHARACTER
       JMS    FAO600	     /OF THE STATEMENT NUMBERS.
       LAC    NAME1	     /ALL STATEMENT NUMBERS ARE ENTERED INTO THE
       SMA		     /SYMBOL TABLA AS TWO WORD NAMES.
       XOR    W00000
       TAD    DECPNT	     /A PERIOD IS PLACED IN FRONT OF THE
       DAC    NAME1	     /STATEMENT NUMBER FOR IDENTIFICATION.
       LAC    V00000
       DAC    NAME0
       JMS    SYMBSE	     /THE SYMBOL IS FLAGGED AS A STATEMENT
       LAC*   SYMTBC	     /NUMBER AND EXIT IS MADE WITH THE SYMBOL
       JMP*   FETSNO	     /DESCRIPTION IN THE ACCUMULATOR.
FSNO02 ISZ    TCTR	     /A COUNT IS MAINTENED ON THE NUMBER OF
       JMP    FSNO03	     /DIGITS IN THE NUMBER TO PERMIT TWO WORD
       LAC    NAME1	     /CONCATENATION OF THE STATEMENT LABEL.
/       SZA		     /IF THE CURRENT COUNT RUNS OUT, AND BOTH
/	JMP EN		/WORDS FULL,ERROR:STMT NO. MORE THAN 5 DIGITS.
ER07N	ERN	<'  07N'>,SZA,EN
FSNO04 LAC    NAME2	     /WHEN THREE DIGITS HAVE BEEN ENCOUNTERED,
	DAC NAME1	/THE FIRST TWO PLUS A PERIOD (ADDED LATER
       LAC    C00001
       DAC    CHRCTR
K00003 LAW    -3	     /IS THE FIRST NAME WORD AND THE LAST THREE
       JMP    FSNO06	     /IS THE SECOND NAME WORD.
FSNO03	JMS	CAT		/CONCATENATE THE CURRENT CHARACTER AND GO
	JMP	FSNO05		/FETCH THE NEXT ONE.
       .EJECT
/ SUBROUTINE TO FETCH THE NEXT CHARACTER FROM THE CURRENT SOURCE IMAGE
/ CALLING SEQUENCE...
/      JMS    FETCHR
/
FETCHR CAL    0
       LAC    UNFNBC	     /A NEW CHARACTER WILL NOT BE FETCHED IF
       SZA		     /THE LAST CHARACTER FETCHED WAS NOT USED.
       JMP    FTC06
       LAC    LSTCHR
       JMP    FTC07	     /WHEN THE NEXT CHARACTER TO FETCH IS TO BE
FTC06  LAC    ERFLG1	     /FOUND IN COLUMN 73, THE CURRENT IMAGE IS
	.IFUND	ERMSG
	DAC	MESSY6+1
	.ENDC
	.IFDEF	ERMSG
	DAC	MESSY6+2
	.ENDC
	LAC	COL
       SAD    C00073	     /EXHAUSTED AND A NEW IMAGE MUST BE INPUT.
JMPFT2	JMP FTC02
       JMP    FTC01
FTC02  LAC    CTRLSW	     /IMAGE CONTINUATION IS NOT ALLOWED DURING
       SNA		     /STATEMENT RECOGNITION.
       JMP    FTC05	     /THEREFORE, A SPECIAL EXIT IS TAKEN WHEN
       ISZ    FETCHR	     /THE IMAGE IS EXHAUSTED.
       JMP*   FETCHR
FTC05  JMS    SINPUT	     /A NEW IMAGE IS INPUT AND EXAMINED TO SEE
       JMS    FTC500	     /IF IT IS A CONTINUATION OF THE LAST ONE.
       JMP    FTC04	     /THE PRESENT STATEMENT IS TERMINATED IF
	LAC	ERFLG2
	XCT	PASS
	XCT	SLIST
	.IFUND	ERMSG
	DAC	MESSY6+1
	.ENDC
	.IFDEF	ERMSG
	DAC	MESSY6+2
	.ENDC
	LAC	CHARCR	/THE NEW IMAGE IS NOT A CONTINUATION
       JMP    FTC07
FTC04  JMS    SOUTPT	     /IF THE NEW IMAGE IS A CONTINUATION OF THE
/			     /LAST ONE (COLUMN SIX CONTAINS A CHARACTER
FTC01  JMS    SIN500	     /OTHER THAN SPACE OR ZERO), THE COLUMN
       SAD    CHARCR	     /COUNT IS SET TO THE BEGINING OF THE
FT2CNG	JMP FTC02	/STATEMENT FIELD
       ISZ    COL
FTC07  DAC    LSTCHR
       DAC    UNFNBC	     /RESET NO FETCH INDICATOR.
       AND    S00077	     /THE INTERNAL REPRESENTATION OF THE
       DAC    CHAR	     /CHARACTER IS SENT BACK TO THE CALLER,
	 LAW    -13	     /ALONG WITH THE EXTERNAL REPRESENTATION
       JMS    SHIFT	     /OF THE CHARACTER (FOR HOLLERITH DATUM
       LAC    LSTCHR	     /AND FORMAT STATEMENT PACKING), AND
       DAC    XCHAR
       LAW    -6
       JMS    SHIFT
       LAC    LSTCHR	     /ALONG WITH A CODE IDENTIFYING WHAT TYPE
       AND    C00015	     /OF CHARACTER IT IS (NUMERIC,ALPHABETIC,
       DAC    CHRTYP	     /OPERATOR, DELIMITER, ETC.)
       SAD    C00005
       LAC    S00600	     /A PLUS-MINUS OPERATOR IS RANKED AS 6.
       SAD    C00006
       LAC    S00700	     /A MULTIPLICATION-DIVISION OPERATOR IS
       AND    S07700	     /RANKED AS 7.
       DAC    LEVEL	     /A NON-OPERATOR/DELIMETER IS RANKED AS 0.
       LAC    CHRTYP
       JMP*   FETCHR
       .EJECT
/ SUBROUTINE TO FETCH THE NEXT NON-BLANK CHARACTER FROM THE SOURCE IMAGE
/ CALLING SEQUENCE...
/      JMS    FNBCHR
/
FNBCHR CAL    0
       DZM    CTRLSW	     /(ALLOW IMAGE CONTINUATION)
       JMS    FETCHR	     /CHARACTERS ARE FETCHED UNTIL A NON-BLANK
       SAD    C00011	     /CHARACTER IS FOUND.
	JMP .-2		/BLANK AND SPACE ARE SYNONYMOUS
       LAC    XCHAR	     /RETURN CHARACTER TO CALLER
       JMP*   FNBCHR
       .EJECT
/ SUBROUTINE TO TEST CURRENT SOURCE IMAGE FOR CONTINUATION
/ CALLING SEQUENCE...
/      JMS    FTC500
/      JMP    YES
/      XXX    NO
/
FTC500 CAL    0
       LAC    COL06	     /A CONTINUATION IMAGE CONTAINS A NON-ZERO
       SAD    CHARSP	     /DIGIT IN COLUMN SIX.
       JMP    FTC501
       SAD    CHAR0	     /SOURCE INPUT HAS ALREADY SET COLUMN SIX
/			     /TO EITHER A NUMBER OR A SPACE
/			     /CONTINUATION IMAGE.
FTC501 ISZ    FTC500
       JMP*   FTC500	     /NORMAL IMAGE
       .EJECT
/ SUBROUTINE TO PERFORM SINGLE PRECESION,POSITIVE INTEGER MULTIPLICATION
/ CALLING SEQUENCE...
/      LAC    MULTIPLICAND
/      JMS    MULT
/      TAD    MULTIPLIER
/
MULT   CAL    0
       DAC    LS	     /MULTIPLICAND
	 LAW    -22
       DAC    S 	     /17 TO SHIFT REGISTER
       DZM    MS	     /ZERO TO MOST SIGNIFICANT
       LAC    LS
MULT01 RAR		     /MQ17 TO LINK
       LAC    MS
       SZL
       XCT*   MULT	     /MS + MULTIPLIER TO MS
       DAC    MS
       JMS    DRSHFT	     /(MS,LS).RSHFT.(1) TO (MS,LS)
       ISZ    S 	     /SC + 1  TO  SC
       JMP    MULT01
       JMS    FAO560	     /TEST RESULT .GT.(2**17)-1
       ISZ    MULT
       JMP*   MULT
       .EJECT
/ SUBROUTINE TO TWOS COMPLEMENT THE ACCUMULATOR
/ CALLING SEQUENCE...
/      JMS    TWOCMA
/
TWOCMA CAL    0
       CLL!CMA		     /A TWOS COMPLEMENT IS A ONES COMPLEMENT
       TAD    C00001	     /PLUS ONE
       JMP*   TWOCMA
       .EJECT
/ SUBROUTINE TO SHIFT ARGUMENT RIGHT OR LEFT N PLACES AND LEAVE IN ACC
/ CALLING SEQUENCE...
/      LAC    COUNT	     /COUNT IS NEG FOR RIGHT, POS FOR LEFT
/      JMS    SHIFT	     / AND ZERO FOR NO SHIFT
/      LAC    ARG	     /MAY BE  LAC*
/
SHIFT  CAL    0
       SNA		     /IF COUNT IS ZERO, EXIT IS SUCH THAT THE
       JMP*   SHIFT	     /ARG IS ACCESSED UPON RETURN
       SMA
       JMP    SHFT01
       DAC    SHFCTR
       LAC    SHFT10	      /A NEGATIVE COUNT IMPLIES A RIGHT SHIFT
       JMP    SHFT02
SHFT01 JMS    TWOCMA
       DAC    SHFCTR
       LAC    SHFT11	     /A POSITIVE COUNT IMPLIES A LEFT SHIFT
SHFT02 DAC    SHFT03
       XCT*   SHIFT	     /FETCH ARGUMENT
SHFT03 NOP		     /EITHER A RCR OR A RCL
       ISZ    SHFCTR	     /COUNT-1
       JMP    SHFT03
       ISZ    SHIFT	     /SKIP PARAMETER UPON EXIT
       JMP*   SHIFT
/HFT10 RCR
/HFT11 RCL
       .EJECT
/ SUBROUTINE TO MULTIPLY DOUBLE PRECESION ACCUMULATOR BY 10
/ CALLING SEQUENCE...
/      JMS    MULTEN
/
MULTEN CAL    0
       JMS    MOVE	     /(MS,LS)  TO  (TMS,TLS)
       JMS    MULTWO	     /(ACC)* 2
       JMS    MULTWO	     /(ACC*2)*2
       LAC    TLS
       JMS    DADD	     /(ACC*4)+(ACC*1)
/       SPA
/       JMP    MTWO01	     /NUMBER IS TOO LARGE
ER09M	ERN	<'  09M'>,SPA,EM
       JMS    MULTWO	     /(ACC*5)*2
       JMP*   MULTEN
       .EJECT
/ SUBROUTINE TO MULTIPLY DOUBLE PRECESION ACCUMULATOR BY TWO AND CHECK
/ FOR CARRY AND OVERFLOW
/ CALLING SEQUENCE...
/      JMS    MULTWO
/
MULTWO CAL    0
       JMS    DLSHFT	     /(ACC)*2
/       SMA!SNL
/       JMP*   MULTWO
/MTWO01	JMP EM		/ERROR: NO. TOO LARGE IF CARRY/OVERFLOW.
ER10M	ERN	<'  10M'>,SPA!SZL,EM
	JMP*	MULTWO
	    			  /OCCUR.
       .EJECT
/ SUBROUTINE TO MULTIPLY DOUBLE PRECESION ACCUMULATOR BY 10 AND NORMALIZ
/ CALLING SEQUENCE...
/      JMS    NRMULT
/
NRMULT CAL    0
       JMS    MOVE	     /MOVE (MS,LS) TO (TMS,TLS)
       JMS    DRSHFT	     /BOTH THE ORIGINAL ACCUMULATOR AND THE
       JMS    DRSHFT	     /MULTIPLIER (10) ARE NORMALIZED PRIOR TO
       LAC    TLS	     /THE MULTIPLICATION (SHIFT AND ADD)
       JMS    DADD	     /THE RIGHT INSTEAD OF LEFT SHIFT KEEPS THE
       LAC    S 	     /RESULT NORMALIZED WITHIN ONE BINARY PLACE.
       TAD    C00003	     /THE ORIGINAL SCALE IS ADJUSTED TO ACCOUNT
       DAC    S 	     /FOR THE NORMALIZED 10.
       JMS    DNORM	     /THE NUMBER IS MULTIPLIED AS A FRACTION
       JMP*   NRMULT	     /INSTEAD OF AN INTEGER.
       .EJECT
/ SUBROUTINE TO NORMALIZE DOUBLE PRECESION ACCUMULATOR
/ CALLING SEQUENCE...
/      JMS    DNORM
/
DNORM  CAL    0 	     /A NUMBER IS SAID TO BE NORMALIZED WHEN
DNRM02 LAC    MS	     /THE MOST SIGNIFICANT NON-ZERO BIT OF THE
       SMA		     /NUMBER OCCUPIES THE MOST SIGNIFICANT BIT
       JMP    DNRM01	     /OF THE WORD FIELD ASSIGNED TO THE NUMBER.
       JMS    DRSHFT	     /THESE HUMBERS ARE NORMALIZED TO BIT 1 OF
       ISZ    S 	     /THE MOST SIGNIFICANT HALF OF THE DOUBLE
       OPR		     /PRECESION NUMBER.
       JMP*   DNORM	     /THE ASSOCIATED SCALE FACTOR REPRESENTS THE
DNRM01 AND    U00000	     /POSITION OF THE LEAST SIGNIFICANT BIT OF
       SZA		     /THE NUMBER (ASSUMING AN INTEGER NUMBER
       JMP*   DNORM	     /AND A POSITIVE SCALE FACTOR). A NEGATIVE
       JMS    DLSHFT         /SCALE FACTOR INDICATES A FRACTIONAL
       LAW    -1             /NUMBER AND ITS MAGNITUDE THE NUMBER OF
       TAD    S              /ZERO BITS BETWEEN THE BINARY POINT AND
       DAC    S              /THE FIRST NON-ZERO BIT OF THE
       JMP    DNRM02         /FRACTION.
       .EJECT
/ SUBROUTINE TO ADD THE TWO DOUBLE PRECISION ACCUMULATORS
/ CALLING SEQUENCE...
/      LAC    TLS            /OR ANYTHING ELSE (CHAR)
/      JMS    DADD
/							
DADD	CAL 0
       CLL                   /CARRY INDICATOR RESET
       TAD    LS
       DAC    LS             /ACC + LS  TO  LS
       GLK                   /IF CARRY FROM LS ADDITION,
       TAD    TMS            /ADD ONE TO MS
       TAD    MS
       DAC    MS             /A NEGATIVE ACCUMULATOR INDICATES OVERFLOW
       JMP*   DADD           / TO THE CALLING PROGRAM
       .EJECT
/ SUBROUTINE TO RIGHT SHIFT THE DOUBLE PRECESION ACCUMULATOR ONE PLACE
/ CALLING SEQUENCE...
/      JMS    DRSHFT
/							
DRSHFT CAL    0
       LAC    MS
SHFT10 RCR                   /MS.RSHFT.(1)
       DAC    MS             /MS17  TO  LINK
       LAC    LS             /LINK  TO  LS0
       RAR                   /LS.RSHFT.(1)
       DAC    LS
       JMP*   DRSHFT
       .EJECT
/ SUBROUTINE TO LEFT SHIFT THE DOUBLE PRECESION ACCUMULATOR ONE PLACE
/ CALLING SEQUENCE...
/      JMS    DLSHFT
/							
DLSHFT	CAL 0
       LAC    LS
SHFT11 RCL                   /LS.LSHFT.(1)
       DAC    LS             /LS0  TO  LINK
       LAC    MS             /LINK TO  MS17
       RAL                   /MS.LSHFT.(1)
       DAC    MS             /A NON-ZERO LINK OR NEGATIVE ACCUMULATOR
       JMP*   DLSHFT         / INDICATES OVERFLOW TO THE CALLING PROGRAM
       .EJECT
/ SUBROUTINE TO MOVE DOUBLE PRECESION ACCUMULATOR TO TEMPORARY STORAGE
/ CALLING SEQUENCE...
/      JMS    MOVE
/							
MOVE   CAL    0
       LAC    MS
       DAC    TMS            /MS TO TMS
       LAC    LS
       DAC    TLS            /LS TO TLS
       JMP*   MOVE
       .EJECT
/ SUBROUTINE TO SET ADDRESSES OF THE WORDS FORMING THE CURRENT ENTRY IN
/ THE SYMBOL TABLE
/ CALLING SEQUENCE...
/      JMS    SETADR
/							
SETADR CAL    0
       LAC    SYMTBC         /THE ADDRESS OF THE WORDS IN THE CURRENT
	TAD C00001	/ENTRY ARE SET UP TO MAKE ACCESSING THEM
       DAC    SYMTW2         /EASY.
       TAD    C00001         /THE SECOND NAME WORD ADDRESS IS SET UP AS
       DAC    SYMT2A         /THE THIRD WORD ADDRESS WHEN THE SECOND
       DAC    SYMTW3         /NAME WORD DOES NOT EXIST.
       LAC*   SYMTW2
       SPA
       ISZ    SYMTW3         /RELATIVE ADDRESS IN EQUIVALENCE CLASS OR
       LAC    SYMTW3         /COMMON BLOCK (BECOMES ASSIGNED ADDRESS)
       TAD    C00001
       DAC    SYMTW4         /EQUIVALENCE (COMMON) CLASS LINKAGE
       TAD    C00001         /ADDRESS (BECOMES ARRAY SIZE)
       DAC    SYMTW5         /FIRST ARRAY DIMENSION WORD (N*IMAX)
       TAD    C00001
       DAC    SYMTW6         /SECOND ARRAY DIMENSION WORD (N*IMAX*JMAX)
       JMP*   SETADR
       .EJECT
/ SUBROUTINE TO TEMPORARILY SAVE SYMBOL TABLE ENTRY ADDRESSES
/ CALLING SEQUENCE...
/      JMS    TSETAD
/							
TSETAD CAL    0
       LAC    CHRCTR
       DAC    TRELAD
       LAC    SYMTBC         /THE ADDRESSES OF
       DAC    TSMTBC         /  THE FIRST WORD (DESCRIPTION),
       LAC    SYMTW4
       DAC    TSMTW4         /  THE FOURTH WORD (LINKAGE ADDRESS), AND
       LAC    SYMTW3
       DAC    TSMTW3         /  THE THIRD WORD (RELATIVE POSITION)
       JMP*   TSETAD         /ARE SAVED TEMPORARILY.
       .EJECT
/ SUBROUTINE TO INPUT A SOURCE IMAGE
/ CALLING SEQUENCE...
/      JMS    SINPUT
/							
SINPUT CAL    0
	.IFUND	IMBED
/      .READ  -11,2,SINBFH,32  /READ IN A SOURCE IMAGE
       CAL    02767          /  DEVICE 3 .. IOPS ALPHA
       .DSA   000010         /  READ CODE
       .DSA   SINBFH	     /	INPUT BUFFER ADDRESS (INCLUDES HEADERS)
	-44		/BUFFER SIZE IS 36 WORDS
/      .WAIT  -11 	     /WAIT UNTIL THE BUFFER HAS BEEN TRANSFERED
       CAL    00767	     /	DEVICE 3
       .DSA   000012	     /	WAIT CODE
	.ENDC
	.IFDEF	IMBED
	JMS	DREAD
	.ENDC
	LAC SINBFH
	AND C00015
	SAD C00005
	JMP ENDGEN
	SAD C00006
	JMP ENDGEN
SINPUX	JMS SINP00	/INITIALIZE BUFFER AND FETCH CONTINUATION
       LAC    TCHAR
       SAD    CHARCR
       JMP    SINPUT+1
       XOR    CHARC
       AND    Z74000	     /COMMENTS ARE INDICATED BY THE CHARACTER C
       SZA		     /IN THE FIRST CHARACTER POSITION.
       JMP*   SINPUT
       JMS    SOUTPT	     /COMMENTS ARE LISTED, BUT NOT PROCESSED.
       JMP    SINPUT+1
ENDGEN	LAC ENDBFR
	DAC SINBFH+2
	LAC ENDBFR+1
	DAC SINBFH+3
	JMP SINPUX
ENDBFR	.ASCII <11>/END/<15>
       .EJECT
/ SUBROUTINE TO FETCH CONTINUATION FIELD AND POSITION COUNTERS TO THE
/ STATEMENT FIELD
/ CALLING SEQUENCE...
/      JMS    SINP00
/
SINP00 CAL    0
       JMS    SIN520
	LAC	C00007
	DAC	COL
	LAW	-6
       DAC    LEVEL
       JMS    SIN500
       DAC    TCHAR	     /SAVE COLUMN 1 FOR COMMENT TEST
/			     /THE STATEMENT NUMBER AND CONTINUATION
/		         /FIELDS ARE EXAMINED TO DETERMINE THE
       JMP    SINP03
SINP02 JMS    SIN500	     /CONTENTS OF THE CONTINUATION FIELD AND
SINP03 SAD    TABCHR	     /ALSO THE WORD AND CHARACTER COUNTER
       JMP    SINP01	     /VALUES FOR THE BEGINING OF THE STATEMENT
       ISZ    LEVEL	     /FIELD (NECESSARY BECAUSE OF VARYING INPUT
       JMP    SINP02	     /FORMATS).
       JMS    SIN530
       JMP    SINP04
SINP01 JMS    SIN530	     /A TAB CHARACTER INDICATES A SKIP OF THE
       JMS    SIN500	     /REMAINDER OF THE STATEMENT NUMBER FIELD.
	DAC	LSTCHR
       AND    S01700
       SAD    S00100	     /THE CONTINUATION FIELD IS ALSO SKIPPED
       JMP    SINP04	     /IF THE CHARACTER FOLLOWING THE TAB IS NOT
	DZM	UNFNBC		/A NUMBER.
	ISZ	COL
	JMP*	SINP00
SINP04 LAC*   CHAR
       DAC    COL06	     /THE CONTINUATION FIELD (COLUMN SIX) WILL
       JMP*   SINP00	     /POINTERS ARE SET TO THE STATEMENT FIELD.
       .EJECT
/ SUBROUTINE TO LIST SOURCE IMAGE
/ CALLING SEQUENCE...
/      JMS    SPRINT
/
SPRINT CAL    0
	.IFUND	IMBED
	LAC S02766	/USE .DAT -12
	XCT LIST
	LAC S02775	/USE .DAT -3
	DAC .+3
	AND S00777
	DAC .+5
/      .WRITE -12,2,SINBFH,32  /PRINT SOURCE IMAGE ON LISTING DEVICE
       CAL    02766	     /	DEVICE 4 .. IOPS ASCII
       .DSA   000011	     /	WRITE CODE
       .DSA   SINBFH	     /	OUTPUT BUFFER ADDRESS (INCLUDES HEADERS)
X17777 .DSA   517777	     /	BUFFER SIZE IS 32 WORDS
/      .WAIT  -12 	     /WAIT UNTIL THE BUFFER HAS BEEN TRANSFERED
       CAL    00766	     /	DEVICE 4
       .DSA   000012	     /	WAIT CODE
	.ENDC
	.IFDEF	IMBED
	LAC	LISTI
	XCT	LIST
	LAC	LISTT
	DAC	LISTI1
LISTI1	XX
	SINBFH
	.ENDC
       JMP*   SPRINT
       .EJECT
/ SUBROUTINE TO FETCH AND TRANSLATE A SOURCE CHARACTER
/ CALLING SEQUENCE...
/      JMS    SIN500
/
SIN500 CAL    0
       LAC    CHRCNT	     /TWO WORDS AT A TIME (5 CHARACTERS) ARE
SIN507       SZA		     /MOVED FROM THE INPUT IMAGE TO A WORKING
       JMP    SIN501	     /CHARACTER BUFFER.
       LAC*   SINBUF
       DAC    CHRBUF	     /THE INDIVIDUAL CHARACTERS ARE EXTRACTED
       ISZ    SINBUF	     /FROM THIS CHARACTER FUGGER.
       LAC*   SINBUF
       DAC    CHRBF1
SIN506       ISZ    SINBUF
       LAW    -4	     /THE FIRST CHARACTER OF THE BUFFER IS
       DAC    CHRCNT	     /ALREADY IN POSITION FOR TRANSLATION.
       JMP    SIN502
SIN501 TAD    C00001
       DAC    CHRCNT	     /EACH TIME A CHARACTER IS REQUIRED (EXCEPT
       JMS    SIN510	     /THE FIRST OF THE FIVE) THE CHARACTER
SIN502 LAC    CHRTAB	     /BUFFER IS SHIFTED LEFT SEVEN BITS (ONE
SIN504 DAC    CHAR	     /CHARACTERS WORTH). THE REQUESTED CHARACTER
       SAD    CHRTBX	     /IS THEN POSITIONED IN THE MOST SIGNIFICANT
       JMP    SIN500+1      /SEVEN BITS OF THE CHARACTER BUFFER.
       LAC*   CHAR
       XOR    CHRBUF	     /THE ASCII CHARACTER IS TRANSLATED TO ITS
       AND    Z74000	     /COMPILER COUNTER-PART BEGORE IT IS
       SNA		     /RETURNED TO THE CALLING PROGRAM.
       JMP    SIN503
       LAC    CHAR
       TAD    C00001
       JMP    SIN504
SIN503 LAC*   CHAR
       SAD    CHARLF	     /LINE FEEDS ARE IGNORED
       JMP    SIN500+1
       JMP*   SIN500
	.IFDEF	IMBED
SIN505	LAC*	SINBUF
	RTR
	RTR
	RTR
	RTR
	DAC	CHRBUF
	JMP	SIN506
SIN512	JMP	SIN505
	.ENDC
       .EJECT
/ SUBROUTINE TO SHIFT CHARACTER BUFFER LEFT SEVEN PLACES
/ CALLING SEQUENCE...
/      JMS    SIN510
/
SIN510 CAL    0
	 LAW    -7
       DAC    BITCTR
SIN511 LAC    CHRBF1	     /THE TWO WORD CHARACTER BUFFER IS DOUBLE
       RCL		     /LEFT SHIFTED (OPEN) 7 PLACES.
       DAC    CHRBF1
       LAC    CHRBUF	     /THIS ROUTINE IS USED TO UNPACK INPUT
       RAL		     /BUFFERS AND PACK OUTPUT BUFFERS.
       DAC    CHRBUF
       ISZ    BITCTR
       JMP    SIN511
       JMP*   SIN510
       .EJECT
/ SUBROUTINE TO INITIALIZE SOURCE IMAGE WORD AND CHARACTER COUNTERS
/ CALLING SEQUENCE...
/      JMS    SIN520
/
SIN520 CAL    0
       LAC    SINBF0	     /INITIALIZE...
       DAC    SINBUF	     /	WORD COUNT TO FIRST BUFFER WORD.
       DZM    CHRCNT	     /	CHARACTER COUNT TO BEGIN WITH A NEW
       LAC    CHARSP	     /	SET OF WORDS.
       DAC    COL06	     /	SPACE CHARACTER TO COLUMN SIX.
       DZM    COL	     /	COLUMN NUMBER
       JMP*   SIN520
       .EJECT
/ SUBROUTINE TO SAVE SOURCE IMAGE WORD AND CHARACTER COUNTERS
/ CALLING SEQUENCE...
/      JMS    SIN530
/
SIN530 CAL    0
       LAC    SINBUF	     /SAVE...
       DAC    TSINBF	     /	BUFFER WORD ADDRESS
       LAC    CHRCNT
       DAC    TCHCNT	     /	CHARACTER COUNTER
       LAC    CHRBUF
       DAC    TCHBUF	     /	CHARACTER BUFFER
       LAC    CHRBF1
       DAC    TCHBF1	     /	CHARACTER BUFFER
       LAC    COL
       DAC    KOL	     /	COLUMN NUMBER
       JMP*   SIN530
       .EJECT
/ SUBROUTINE TO RESTORE SAVED SOURCE IMAGE WORD AND CHARACTER COUNTERS
/ CALLING SEQUENCE...
/      JMS    SIN540
/
SIN540 CAL    0
       LAC    TSINBF	     /RESTORE...
       DAC    SINBUF	     /	BUFFER WORD ADDRESS
       LAC    TCHCNT
       DAC    CHRCNT	     /	CHARACTER COUNTER
       LAC    TCHBUF
       DAC    CHRBUF	    /  CHARACTER BUFFER
       LAC    TCHBF1
       DAC    CHRBF1	     /	CHARACTER BUFFER
       LAC    KOL
       DAC    COL	     /	COLUMN NUMBER
       JMP*   SIN540
       .EJECT
/ SUBROUTINE TO OUTPUT SOURCE IMAGE
/ CALLING SEQUENCE...
/      JMS    SOUTPT
/      JMS    SOUTPT
/
SOUTPT CAL    0
SLIST  SKP		     /THE SOURCE IMAGE IS LISTED UNLESS NO LIST
       JMP*   SOUTPT	     /IS SPECIFICALLY REQUESTED BY THE USER.
       XCT    PASS
       JMS    SPRINT	     /THE SOURCE LISTING IS PRODUCED DURING
       JMP*   SOUTPT	     /PASS 2 ONLY.
	.EJECT
/ERROR ENTRIES
	.IFUND	ERMSG
EX	LAW 16600
	SKP
EV	LAW 16540
	SKP
EN	LAW 16340
	SKP
ES	LAW 16460
	SKP
EF	LAW 16140
	SKP
EI	LAW 16220
	SKP
ED	LAW 16100
	SKP
ET	LAW 16500
	SKP
EL	LAW 16300
	SKP
EM	LAW 16320
	SKP
EC	LAW 16060
	SKP
EE	LAW 16120
	SKP
EH	LAW 16200
       JMS    ERROR1	     /ANNOUNCEMENT IS MADE.
	.ENDC
	.IFDEF	ERMSG
ERRORN	0		/GIVE ERROR IF TEST DOES NOT SKIP
	DAC	ERRAC	/SAVE AC
	LAC	ERRORN	/SAVE EXIT AND ARG. POINTER
	DAC	ERRORS
	LAC*	ERRORN	/FETCH TEST INSTRUCTION TO AVOID DOUBLE EXCT.
	DAC	.+2
	LAC	ERRAC	/RESTORE AC
	XX		/TEST INSTRUCTION
	JMP	EROR1
EROR2	ISZ	ERRORS	/NO ERROR
	ISZ	ERRORS
	JMP*	ERRORS
ERRORS	0
	DAC	ERRAC
	LAC*	ERRORS
	DAC	.+2
	LAC	ERRAC
	XX		/TEST INSTRUCTION
	JMP	EROR2
EROR1	ISZ	ERRORS	/ERROR
	LAC*	ERRORS
	DAC	ERRAC
	JMS	ERROR1
ERRAC	XX		/ERROR MESSAGE AND AC STORE
	.ENDC
	LAC	PROCAD
       SAD    K00001         /IF THIS IS THE END STATEMENT, EXIT TO
       JMP    PASS           /TERMINATE THE PASS, OTHERWISE EXIT TO
       JMP    EREXIT         /FETCH THE NEXT SOURCE IMAGE.
       .EJECT
/ SUBROUTINE TO ANNOUNCE AN ERROR
/
ERROR1 CAL    0
	.IFUND	ERMSG
	XOR W04007
	DAC MESSY6		/SAVE ERROR CODE
	.ENDC
	.IFDEF	ERMSG
	LAC*	ERROR1
	DAC	MESSY6+1
	ISZ	ERROR1
	.ENDC
	ISZ	FILFLG
	SKP
	JMP	RSTRT		/CAN NOT OUTPUT ERROR MESSAGE
	LAC	PASS2		/BINARY OUTPUT IS TERMINATED
	DAC	OBINRY
	XCT PASS		/ALWAYS LIST IN PASS 1
	XCT SLIST		/LIST IN PASS 2 IF NO SOURCE LIST
	JMS SPRINT
	.IFUND	IMBED
	LAC S02766	/USE .DAT -12
	XCT LIST
	LAC S02775	/USE .DAT -3
	DAC S990CL
	AND S00777
	DAC ERWAIT
	.ENDC
	.IFDEF	IMBED
	LAC	LISTI
	XCT	LIST
	LAC	LISTT
	DAC	S990CL
	.ENDC
	JMS SUB990		/PRINT ERROR MSG
ER1MSY	MESSY6-2
	.IFUND	IMBED
ERWAIT	CAL
	12
	.ENDC
	JMP* ERROR1
       .EJECT
/ SUBROUTINE TO OUTPUT BINARY OBJECT CODE
/ CALLING SEQUENCE...
/      LAC    DATA WORD
/      JMS    BINOUT
/      XOR    LOADER CODE
/
BINOUT CAL    0
BINO05 ISZ    BINBUF	     /THE DATA STORE ADDRESS IS UPDATED AND THE
       DAC*   BINBUF	     /DATA WORD IS STORED IN THE OUTPUT BUFFER
       LAC    C00006	     /(3 DATA WORDS FOR EVERY CODE WORD)
       JMS    SHIFT
       LAC*   CODEWD	     /THE LOADER CODE WORD IS MERGED INTO THE
       XCT*   BINOUT	     /OUTPUT BUFFER (3 LOADER CODES PER WORD).
       DAC*   CODEWD
       AND    S00077	     /THE LODER CODE IS EXAMINED TO DETERMINE
	.IFUND	%F2
       TAD    LDRTAB	     /IF THE CORRESPONDING DATA SHOULD BE LISTED
       DAC    .+3
BINO06 JMS    OBJ500	     /INITIALIZE LISTING BUFFER
       LAC*   BINBUF
	JMP*	0
	.ENDC
	.IFDEF	%F2
	SAD	C00003		/PROCESS THOSE CODES WHICH INCREMENT PC
	JMP	OBJ036
	SAD	C00004
	JMP	OBJ036+2
	SAD	C00005
	JMP	OBJ036+2
	SAD	C00006
	SKP
	JMP	BINO01
	JMS	INCRPC
	TAD*	BINBUF
	JMP	BINO01
OBJ036	LAC* BINBUF
	DAC LSTCMD
	JMS INCRPC
	TAD C00001
	.ENDC
       .EJECT
	.IFUND	%F2
/ TABLE OF ADDRESSES OF OBJECT CODE LISTING ROUTINES
/
LDRTAB JMP   LDRTAB	     /CODE  TYPE
       JMP   BINO01	     / 01   PROGRAM SIZE
       JMP   BINO01	     / 02   LOAD ADDRESS
       JMP   OBJ030	     / 03   RELOCATABLE INSTRUCTION
       JMP   OBJ040	     / 04   ABSOLUTE INSTRUCTION, CONSTANT
       JMP   OBJ050	     / 05   RELOCATABLE VECTOR
       JMP   OBJ060	     / 06   DATA STORAGE BLOCK
       JMP   BINO01	     / 07   SYMBOL - FIRST WORD
       JMP   BINO01	     / 08   SYMBOL - SECOND WORD
       JMP   BINO01	     / 09   VIRTUAL GLOBAL SYMBOL DEFINITION
       JMP   BINO01	     / 10   INTERNAL GLOBAL SYMBOL DEFINITION
       JMP   BINO01	     / 11   BLOCK DATA DECLARATION
       JMP   BINO01	     / 12   COMMON BLOCK DEFINITION
       JMP   BINO01	     / 13   COMMON SYMBOL DEFINITION
       JMP   BINO01	     / 14   COMMON SYMBOL REFERENCE DEFINITION
       JMP   OBJ150	     / 15   DATA INITIALIZATION CONSTANT-WORD 1
       JMP   OBJ171	     / 16   DATA INITIALIZATION CONSTANT-WORD 2
       JMP   OBJ171	     / 17   DATA INITIALIZATION CONSTANT-WORD 3
       JMP   OBJ180	     / 18   DATA INITIALIZATION CONSTANT-DEFINIT
       JMP   BINO01	     / 19   INTERNAL SYMBOL DEFINITION
       JMP   OBJ200	     / 20   STRING CODE - REFERENCE ADDRESS
       JMP   OBJ210	     / 21   STRING CODE - DEFINITION
       JMP   BINO01	     / 22   INPUT/OUTPUT DEVICE ROUTINE REQUEST
       JMP   BINO01	     / 23   END
       .EJECT
/ ROUTINE TO LIST RELOCATABLE INSTRUCTIONS
/
OBJ030 DAC    LSTCMD	     /SET LAST COMMAND FOR END PROCESSING.
       JMS    OBJ530	     /OUTPUT PROGRAM COUNTER.
       LAC    OBJ400
       DAC    OBJB01
	LAC LSTCMD		/TRANSLATE OCTAL OPCODE TO ITS
       AND    Z40000	     /MNEMONIC COUNTERPART
OBJ031 SAD*   OBJB01
       JMP    OBJ032
       ISZ    OBJB01
       ISZ    OBJB01
       JMP    OBJ031
OBJ032 ISZ    OBJB01
       LAC*   OBJB01
       JMS    OBJ580	     /PACK MNEMONIC INTO THE OUTPUT BUFFER.
       LAC    LSTCMD
       AND    S20000
       SZA		     /AN ASTERISK WILL FOLLOW THE MNEMONIC IF
       LAC    C00010	     /THE MEMORY REFERENCE IS INDIRECT,
       TAD    S00040	     /THERWISE A SPACE WILL FOLLOW.
       JMS    OBJ510
       JMS    OBJ630	     /FORMAT A SPACE BEFORE THE ADDRESS FIELD.
	LAC LSTCMD
	JMS FAKE
       XOR*   SYMTBC
       AND    S17777	     /THE ADDRESS FIELD IS PRINTED AS EITHER
       SNA		     /A SYMBOLIC REFERENCE, A PROGRAM ADDRESS,
       JMP    OBJ033	     /OR AS AN UNDEFINED STRING ADDRESS.
       LAC    LSTCMD
       AND    S17777
       SAD    PC
       SKP
       JMP    OBJ035
OBJ034 LAC    C00036	     /A STRING ADDRESS IS OUTPUT AS $NNNNN
       JMS    OBJ510	     /WHERE NNNNN IS THE PROGRAM COUNTER
       LAC    PC
OBJ035 JMS    OBJ640	     /A PROGRAM ADDRESS IS OUTPUT AS NNNNN
       JMP    OBJ036
OBJ033 LAC    SYMTBC
       AND    S77777
       JMS    TWOCMA
       TAD    SYMTBN
       SMA
       JMP    OBJ036-1
OBJ038	JMS FAKE
	LAC* SYMTBC
       JMS    SETN
       JMS    TWOCMA
	DAC NAME0
       LAC    S00050
       JMS    OBJ510
OBJ039 LAC    SYMTBC
       TAD    K00001
       DAC    SYMTBC
	JMS FAKE
       LAC*   SYMTBC
	JMS OBJ650	/OUTPUT LITERAL
	ISZ NAME0
       JMP    OBJ039
       SKP
       JMS    OBJ550	     /OUTPUT SYMBOL NAME
OBJ036 JMS    INCRPC
       TAD    C00001	     /INCREMENT PROGRAM COUNTER BY ONE.
OBJ037 XCT    PASS
OLIST  SKP		     /OBJECT CODE IS PRINTED WHEN REQUESTED AND
	JMP BINO01	/DURING PASS 2 ONLY.
       JMS    OBJ520
	.ENDC
       .EJECT
/ BINARY BUFFER POINTER UPDATE
/
	.IFUND	%F2
BINO01 JMS    SIN540
       ISZ    WRDCTR
	.ENDC
	.IFDEF	%F2
BINO01	ISZ	WRDCTR
	.ENDC
       JMP    BINO02
       XCT    PASS	     /BINARY CODE IS NOT OUTPUT IF AN ERROR HAS
OBINRY SKP		     /OCCURED OR IF THE USER REQUESTED NONE, OR
       JMP    BINO03	     /IF IT IS PASS 1.
	.IFUND	IMBED
/      .WRITE 0,-13,BINBFH,50  /WRITE THE BINARY CODE TO THE OUTPUT DEVICE
       CAL    765   	     /	DEVICE 5 .. IOPS BINARY
       .DSA   000011	     /	WRITE CODE
       .DSA   BINBFH	     /	BINARY CODE BUFFER ADDRESS
Z77577 .DSA   777577 	     /	50 WORDS OF OUTPUT
/      .WAIT  -13 	     /WAIT UNTIL BUFFER HAS BEEN TRANSFERRED
       CAL    00765	     /	DEVICE 5
       .DSA   000012	     /	WAIT CODE
	.ENDC
	.IFDEF	IMBED
	JMS	DWRITE
	BINBFH
	.ENDC
BINO03 JMS    BIN500	     /INITIALIZE BINARY BUFFER AND COUNTERS.
       JMP*   BINOUT
BINO02 ISZ    CODCTR
       SKP
       JMS    BIN510	     /INITIALIZE FOR NEXT LOADER CODE GROUP.
       LAC    C00023
       XCT*   BINOUT
       SZA		     /THE BUFFER IS FILLED AND WRITTEN WHEN
       JMP*   BINOUT	     /THE END CODE IS ENCOUNTERED.
       JMP    BINO05
       .EJECT
	.IFUND	%F2
/ ROUTINE TO LIST ABSOLUTE INSTRUCTIONS AND CONSTANTS
/
OBJ040 JMS    OBJ530	     /FORMAT PROGRAM COUNTER
       LAC    PROCAD
       SAD    K00001	     /CONSTANTS ARE OUTPUT DURING THE PROCESSING
       JMP    OBJ041	     /OF THE END STATEMENT AND THE FORMAT
       SAD    FMTADR	     /STATEMENT.
       JMP    OBJ041
       SAD    GOTOAD
       JMP    OBJ041
       LAC*   BINBUF
       DAC    LSTCMD
       JMS    OBJ610
       SAD    LSTCMD
       SKP		     /WHEN THE COMMAND HAS BEEN FORMATTED FOR
       JMP    OBJ036	     /OUTPUT, THE PROGRAM COUNTER IS UPDATED.
       AND    Z67777
OBJ044 DAC    OBJB03	     /ABSOLUTE COMMANDS MAY BE MICRO-CODED.
       JMS    OBJ610
       SAD    OBJB03	     /THE COMPILER GENERATES COMBINATIONS OF...
       JMP    OBJ043	     /	    SPA OR SMA
       LAC    S00041	     /	    QNA OR SZA
       JMS    OBJ510	     /	    CLA
       LAC    CLAMNE
       JMS    OBJ580
       JMP    OBJ036
OBJ043 AND    Z77577
       JMS    OBJ610
       LAC    S00041
       JMS    OBJ510	     /OUTPUT ! CHARACTER.
       LAC    OBJB03
       AND    Z77677
       JMP    OBJ044
OBJ041 JMS    OBJ620	     /OUTPUT .DSA
       LAC    DSAMNE
	 LAC*   BINBUF
OBJ046 JMS    OBJ650	     /OUTPUT CONSTANT
       JMP    OBJ036	     /INCREMENT PC AND OUTPUT BUFFER
       .EJECT
/ ROUTINE TO LIST RELOCATABLE VECTORS
/
OBJ050 JMS    OBJ530	     /FORMAT PROGRAM COUNTER
       JMS    OBJ620	     /FORMAT .DSA
       LAC    DSAMNE
       LAC    OBJB04
       SNA		     /VECTORS ARE EITHER FUNCTION PARAMETER
       JMP    OBJ033	     /ADDRESSES OR TRANSFER VECTORS FOR
       DAC    SYMTBC
       AND    Z00000	     /EXTERNAL VARIABLES
       SAD    U00000	     /THE ADDRESS OF A CONSTANT PARAMETER IS
       JMP    OBJ038	     /OUTPUT.
       SAD    W00000
       JMP    OBJ034	     /FORMAT STRING ADDRESS
       JMS    SETADR
       LAC*   BINBUF	     /SYMBOLIC VECTORS MAY REPRESENT
	SMA		/DIRECT OR INDIRECT PARAMETER ADDRESSES.
       JMP    OBJ033
       JMS    OBJ550	     /OUTPUT...
       LAC    S00053	     /	SYMBOL
       JMS    OBJ510	     /	+
       LAC    W00000
       JMP    OBJ046	     /OUTPUT CONST. AND UPDATE PROGRAM COUNTER.
       .EJECT
/ ROUTINE TO LIST BLOCK STORAGE
/
OBJ060 JMS    OBJ530	     /FORMAT-PROGRAM COUNTER
       JMS    OBJ620
       LAC    BLKMNE	     /FORMAT .BLK
       LAC*   BINBUF
       JMS    OBJ650	     /FORMAT DATA WORD
       JMS    INCRPC
       TAD*   BINBUF	     /UPDATE PC BY DATA WORD
       JMP    OBJ037
       .EJECT
/ ROUTINE TO LIST DATA INITIALIZATION CONSTANTS
/
OBJ150	  DZM	     ARG
OBJ171	  LAC	     ARG
       TAD    K00001
	DAC ARG		/COUNT CONSTANTS
       JMP    BINO01
OBJ180 JMS    OBJ640	     /FORMAT CONSTANT ADDRESS
       LAC    S
       JMS    OBJ650         /FORMAT FIRST CONSTANT
	ISZ	 ARG
       SKP
       JMP    OBJ037         /OUPUT OBJECT IMAGE
       LAC    NAME1
       JMS    OBJ650         /FORMAT SECOND CONSTANT
	ISZ	 ARG
       SKP
       JMP    OBJ037         /OUTPUT OBJECT IMAGE
       LAC    NAME2
       JMS    OBJ650         /FORMAT THIRD CONSTANT, AND
       JMP    OBJ037         /OUTPUT OBJECT IMAGE
       .EJECT
/ ROUTINE TO LIST STRING DEFINITIONS
/							
OBJ200 DAC    OBJB01         /SAVE REFERENCE ADDRESS
       JMP    BINO01
OBJ210 LAC    C00036
       JMS    OBJ510         /OUTPUT PERIOD
       LAC    OBJB01
       JMS    OBJ640         /OUTPUT REFERENCE ADDRESS
       LAC    S00075
       JMS    OBJ510         /OUTPUT  =
       JMS    OBJ630         /OUTPUT  SPACE
       LAC*   BINBUF         /OUTPUT DEFINITION ADDRESS
	JMS OBJ640	/...I.E...
       JMP    OBJ037         /         .REFAD = DEFAD
	.ENDC
       .EJECT
/ SUBROUTINE TO INITIALIZE BINARY OUTPUT BUFFER
/ CALLING SEQUENCE...
/      JMS    BIN500
/							
BIN500 CAL    0              /INITIALIZE...
       LAW    -22
       DAC    WRDCTR         /  WORD COUNTER
       LAC    BINBF0
       DAC    BINBUF         /  BUFFER STARTING ADDRESS
       JMS    BIN510         /  BUFFER COUNTERS
       JMP*   BIN500
/
/ SUBROUTINE TO UPDATE BINARY BUFFER COUNTERS
/ CALLING SEQUENCE...
/      JMS    BIN510
/							
BIN510 CAL    0              /INITIALIZE...
       ISZ    BINBUF         /  DATA WORD STORAGE ADDRESS
       LAC    BINBUF
       DAC    CODEWD         /  LOADER CODE WORD STORAGE ADDRESS
       LAW    -3
       DAC    CODCTR         /  LOADER CODE GROUPING COUNTER
       JMP*   BIN510
/
/ SUBROUTINE TO OUTPUT SYMBOL NAME
/ CALLING SEQUENCE...
/      JMS    OSYMBL
/							
OSYMBL CAL    0
       LAC*   SYMTW2         /THE FIRST WORD OF THE NAME (CHARACTERS
      JMS    BINOUT         /01 THROUGH 03) ARE OUTPUT AS LOADER CODE
       XOR    C00007         /07.
	LAC*	SYMTW2
	SMA
	JMP*	OSYMBL
       LAC*   SYMT2A         /THE SECOND WORD OF THE NAME (CHARACTERS
       JMS    BINOUT         /04 THROUGH 06) ARE OUTPUT AS LOADER CODE
       XOR    C00008         /08.
       JMP*   OSYMBL
       .EJECT
	.IFUND	%F2
/ SUBROUTINE TO INITIALIZE OBJECT CODE LISTING OUTPUT BUFFER
/ CALLING SEQUENCE...
/      JMS    OBJ500
/							
OBJ500 CAL    0              /INITIALIZE...
       JMS    SIN530         /SAVE CHARACTER BUFFERS AND POINTERS
       LAC    S01502
       DAC    OBJBFH         /  OUTPUT BUFFER SIZE
       LAC    OBJBF0
       DAC    SINBUF         /  OUTPUT BUFFER STARTING ADDRESS
       LAW    -4
       DAC    CHRCNT         /  CHARACTER COUNT
	LAC	S00040
       DAC    CHRBF1         /  CONTROL CHARACTER AND SPACE CHARACTER
       JMP*   OBJ500         /  TO THE OUTPUT BUFFER.
       .EJECT
/ SUBROUTINE TO PACK CHARACTER INTO THE OBJECT LISTING OUTPUT BUFFER
/ CALLING SEQUENCE...
/      LAC    CHARACTER      /ASCIT CODE
/     JMS     OBJ510
/							
OBJ510 CAL    0
       DAC    TCHAR
       JMS    SIN510         /THE CHARACTER BUFFER IS SHIFTED LEFT
       LAC    CHRBF1         /SEVEN PLACES AND THE CHARACTER IS MERGED
       XOR    TCHAR          /INTO THE BUFFER.
       DAC    CHRBF1
       ISZ    CHRCNT
       JMP*   OBJ510
       LAC    CHRBF1         /WHEN THE CHARACTER BUFFER IS FULL
       RCL                   /(FIVE CHARACTERS), IT IS LEFT JUSTIFIED
       LAC    CHRBUF         /AND ENTERED INTO THE OUTPUT BUFFER.
       RAL
       DAC*   SINBUF
       ISZ    SINBUF
       LAC    CHRBF1
       RCL
       DAC*   SINBUF
       ISZ    SINBUF         /THE OUTPUF BUFFER ADDRESS AND CHARACTER
       LAW    -5             /COUNTS ARE UPDATED FOR THE NEXT SET OF
       DAC    CHRCNT         /CHARACTERS.
       LAC    S01000
       TAD    OBJBFH         /THE OUTPUT BUFFER SIZE IS UPDATED
       DAC    OBJBFH         /ACCORDINGLY.
       JMP*   OBJ510
       .EJECT
/ SUBROUTINE TO OUTPUT OBJECT LISTING OUTPUT BUFFER
/ CALLING SEQUENCE...
/      JMS    OBJ520
/							
OBJ520 CAL    0
OBJ522 LAW    -1
       SAD    CHRCNT         /SPACES ARE USED TO PAD OUT THE CURRENT
       JMP    OBJ521         /CHARACTER BUFFER AND FORCE ITS ENTRY
       LAC    S00040         /INTO THE OUTPUT BUFFER.
       JMS    OBJ510
       JMP    OBJ522
OBJ521 LAC    C00013         /A CARRIAGE RETURN IS THE LAST CHARACTER
       JMS    OBJ510         /PACKED INTO THE OUTPUT BUFFER.
	.IFUND	IMBED
/      .WRITE 2,-12,OBJBFH,32  /WRITE OUTPUT BUFFER TO LISTING DEVICE
       CAL    02766          /  DEVICE 4 .. IOPS ALFA (517 ASCIT)
       .DSA   000011         /  WRITE CODE
       .DSA   OBJBFH         /  BUFFER ADDRESS
	.ENDC
	.ENDC
	.IFUND	IMBED
Z67777 .DSA   767777         /  BUFFER LENGTH
	.ENDC
	.IFUND	%F2
	.IFUND	IMBED
/      .WAIT  -12              /WAIT UNTIL THE BUFFER HAS BEEN TRANSFERRED
       CAL    00766          /  DEVICE 4
       .DSA   000012         /  WAIT CODE
	.ENDC
	.IFDEF	IMBED
LISTI	XX
	OBJBFH
	.ENDC
       JMS    SIN540         /RESTORE CHARACTER BUFFER AND POINTERS
       JMP*   OBJ520
       .EJECT
/ SUBROUTINE TO PACK PROGRAM COUNTER FOR OBJECT CODE LISTING
/ CALLING SEQUENCE...
/      JMS    OBJ530
/							
OBJ530 CAL    0
	 LAC    PC             /THE PROGRAM COUNTER IS LISTED FOR ALL
       JMS    OBJ640         /INTERMEDIATE INSTRUCTIONS AND NON-LABELED
	 JMS    OBJ630         /PACK AN EXTRA SPACE.
       JMP*   OBJ530
       .EJECT
/ SUBROUTINE TO PACK N OCTAL DIGITS FOR OBJECT CODE LISTING
/ CALLING SEQUENCE...
/      LAC    OCTAL WORD
/      JMS    OBJ540
/      LAC    -N
/
OBJ540 CAL    0
       DAC    OBJB01	     /SAVE OCTAL WORD
       XCT*   OBJ540
       TAD    OBJ545
OBJ541 DAC    OBJB02	     /SET ADDRESS OF SHIFT VALUE
       LAC*   OBJB02
       JMS    SHIFT
       LAC    OBJB01	     /SHIFT DIGIT TO LEAST SIGNIFICANT POSITION
       AND    C00007	     /AND CONVERT IT TO ASCIT CODE.
       TAD    S00060
       JMS    OBJ510	     /PACK CHARACTER IN OUTPUT BUFFER.
       LAC    OBJB02
       TAD    C00001
       SAD    OBJ545
       JMP*   OBJ540
       JMP    OBJ541
/
/ TABLE OF RIGHT SHIFT VALUES FOR OCTAL SHIFTING
/
	 .DSA   -000017	     /15   6 DIGITS
	.ENDC
K00012 .DSA   -000014	     /12   5 DIGITS
K00009 .DSA   -000011	     /09   4 DIGITS
K00006 .DSA   -000006	     /06   3 DIGITS
	.IFUND	%F2
       .DSA   -000003	     /03   2 DIGITS
	.ENDC
C00000 .DSA   0000000	     /00   1 DIGIT
	.IFUND	%F2
OBJ545 .DSA   OBJ545
       .EJECT
/ SUBROUTINE TO PACK SYMBOL FOR OBJECT CODE LISTING
/ CALLING SEQUENCE...
/      JMS    OBJ550
/
OBJ550 CAL    0
       JMS    SETADR
	LAC* SYMTW2	/CHARACTERS 1,2 AND 3 ARE OUTPUT FIRST.
OBJ551 DAC    OBJB03
       JMS    OBJ560	     /THE MOST SIGNIFICANT CHARACTER IS
       TAD    K01600	     /TRANSLATED FROM RADIX 50 TO ASCIT AND
       JMS    OBJ570	     /OUTPUT.
       LAC    OBJB02
       JMS    OBJ560	     /THE SECOND MOST SIGNIFICANT CHARACTER IS
       TAD    K00040	     /TRANSLATED FROM RADIX 50 TO ASCIT AND
       JMS    OBJ570	     /OUTPUT
       LAC    OBJB02
       DAC    OBJB01	     /THE LEAST SIGNIFICANT CHARACTER IS
       JMS    OBJ570	     /TRANSLATED TO ASCIT AND OUTPUT.
       LAC    OBJB03
	 SMA
       JMP*   OBJ550	     /CHARACTERS 4,5,AND 6 ARE OUTPUT IF THIS
       LAC*   SYMT2A	     /IS A 2 WORD NAME.
       JMP    OBJ551
       .EJECT
/ SUBROUTINE TO ISOLATE A CHARACTER IN RADIX 50 MODE
/ CALLING SEQUENCE...
/      LAC    RADIX 50 WORD
/      JMS    OBJ560
/      TAD    -N	     /CHARACTER POSITION..1)1600, 2)40
/
OBJ560 CAL    0
       AND    T77777
       DZM    OBJB01
       DZM    OBJB02
OBJ561 XCT*   OBJ560	     /THE CHARACTER IS ISOLATED BY DIVISION
	 SPA			  /(REPETITIVE SUBTRACTION).
       JMP*   OBJ560
       DAC    OBJB02
       ISZ    OBJB01
       JMP    OBJ561
       .EJECT
/ SUBROUTINE TO CONVERT A RADIX 50 CHARACTER TO ASCIT AND PACK IT
/ CALLING SEQUENCE...
/      JMS    OBJ570
/
OBJ570 CAL    0
       LAC    OBJB01	     /A SPACE WHICH IS.
	 SZA			  /ZERO (RADIX 50) TRANSLATES TO 40 (ASCIT)
       JMP    OBJ571
       LAC    S00040
       JMP    OBJ572
OBJ571 TAD    Z77744
	SNA!CMA
	LAW		/.=56
	SNA!CMA
	LAW	111	/%=45
	SMA
	TAD	K00045	/NUMBERS AND .
	TAD	S00134
	AND	S00177
OBJ572 JMS    OBJ510	     /35-46 (RADIX 50) TRANSLATE TO 60-71 (ASCIT
       JMP*   OBJ570
K00045	777723
       .EJECT
/ SUBROUTINE TO PACK MNEMONIC OPCODE FOR OBJECT CODE LISTING
/ CALLING SEQUENCE...
/      LAC    MNEMONIC CODE
/      JMS    OBJ580
/
OBJ580 CAL    0
       TAD    U02020	     /THE MNEMONIC IS PARTIALLY CONVERTED TO
       DAC    OBJB02	     /ASCIT BEFORE IT IS PACKED FOR OUTPUT.
       JMS    OBJ590
       JMP*   OBJ580
       .EJECT
/ SUBROUTINE TO TRANSLATE MODIFIED SIXBT TO ASCII AND PACK IT
/ CALLING SEQUENCE...
/      LAC    SIXBT
/      JMS    OBJ590
/
OBJ590 CAL    0
       LAC    K00012
       JMS    OBJ600	     /PACK FIRST CHARACTER
       LAC    K00006
       JMS    OBJ600	     /PACK SECOND CHARACTER
       LAC    C00000
       JMS    OBJ600	     /PACK THIRD CHARACTER
       JMP*   OBJ590
       .EJECT
/ SUBROUTINE TO POSITION, TRANSLATE, AND PACK 6-BIT CHARACTER
/ CALLING SEQUENCE...
/      LAC    SHIFT VALUE
/      JMS    OBJ600
/
OBJ600 CAL    0
       JMS    SHIFT
       LAC    OBJB02
       AND    S00077	     /POSITION CHARACTER
       TAD    S00060	     /TRANSLATE TO ASCIT
       JMS    OBJ510	     /PACK IN OUTPUT BUFFER
       JMP*   OBJ600
       .EJECT
/ SUBROUTINE TO TRANSLATE AND OUTPUT AN ABSOUTE COMMAND
/ CALLING SEQUENCE...
/      LAC    COMMAND
/      JMS    OBJ610
/
OBJ610 CAL    0
       SAD    SNACMD
       LAC    SNAMNE
       SAD    SPACMD
       LAC    SPAMNE
       SAD    SZACMD
       LAC    SZAMNE
       SAD    CMACMD
       LAC    CMAMNE
       SAD    CLCCMD
       LAC    CLCMNE
       SAD    SMACMD
       LAC    SMAMNE
       SMA		     /IF RECOGNIZABLE, PRINT IT AND EXIT WITH
       JMS    OBJ580	     /SOMETHING OTHER THAN THE INSTRUCTION IN
       JMP*   OBJ610	     /THE ACCUMULATOR.
       .EJECT
/ SUBROUTINE TO OUTPUT A PSEUDO OP
/ CALLING SEQUENCE...
/     JMS    OBJ620
/      LAC    MNEMONIC
/
OBJ620 CAL    0
       LAC    S00056
       JMS    OBJ510	     /FORMAT PERIOD
       XCT*   OBJ620
       JMS    OBJ580	     /FORMAT OPCODE
       JMS    OBJ630	     /FORMAT 3 SPACES
       JMP*   OBJ620
       .EJECT
/ SUBROUTINE TO PACK A SPACE INTO THE OUTPUT BUFFER
/ CALLING SEQUENCE...
/      JMS    OBJ630
/
OBJ630 CAL    0
       LAC    S00040
       JMS    OBJ510	     /PACK A SPACE,
       JMP*   OBJ630
       .EJECT
/ SUBROUTINE TO FORMAT 13-BIT ADDRESS AND A SPACE
/ CALLING SEQUENCE...
/      LAC    ADDRESS
/      JMS    OBJ640
/
OBJ640 CAL    0
       AND    S17777
       JMS    OBJ540	     /FORMAT THE ADDRESS
       LAC    K00005
       JMS    OBJ630	     /FORMAT A SPACE
       JMP*   OBJ640
       .EJECT
/ SUBROUTINE TO FORMAT FULL CONSTANT AND A SPACE
/ CALLING SEQUENCE...
/      LAC    CONSTANT
/      JMS    OBJ650
/
OBJ650 CAL    0
       JMS    OBJ540	     /FORMAT CONSTANT
       LAC    K00006
       JMS    OBJ630	     /FORMAT SPACE
       JMP*   OBJ650
	.ENDC
       .EJECT
	.IFUND	%F2
/ TABLE OF MEMORY REFERENCING INSTRUCTIONS GENERATED BY THE COMPILER
/
OBJ400 .DSA   DACCMD
	.ENDC
DACCMD DAC    0
	.IFUND	%F2
       .DSA   040103         /.SIXBT /DAC/
	.ENDC
LACCMD LAC    0
	.IFUND	%F2
       .DSA   140103         /.SIXBT /LAC/
	.ENDC
TADCMD TAD    0
	.IFUND	%F2
       .DSA   240104         /.SIXBT /TAD/
	.ENDC
ANDCMD AND    0
	.IFUND	%F2
       .DSA   011604         /.SIXBT /AND/
	.ENDC
JMPCMD JMP    0
	.IFUND	%F2
       .DSA   121520         /.SIXBT /JMP/
	.ENDC
JMSCMD JMS    0
	.IFUND	%F2
       .DSA   121523         /.SIXBT /JMS/
	.ENDC
JMPICM JMP*   0
	.IFUND	%F2
/
/ TABLE OF OTHER MNEMONICS
/
DSAMNE .DSA   042301         /.SIXBT /DSA/
BLKMNE .DSA   021413         /.SIXBT /BLK/
CMAMNE .DSA   031501         /.SIXBT /CMA/
CLCMNE .DSA   031403         /.SIXBT /CLC/
SNAMNE .DSA   231601         /.SIXBT /SNA/
SMAMNE .DSA   231501         /.SIXBT /SMA/
SPAMNE .DSA   232001         /.SIXBT /SPA/
SZAMNE .DSA   233201         /.SIXBT /SZA/
CLAMNE .DSA   031401         /.SIXBT /CLA/
	.ENDC
       .EJECT
/ OPCODE TRANSLATION TABLE
/ INDEXED BY OPERATOR NUMBER
/ INSTRUCTION(S) GENENERATED IS EITHER A MACHINE-LEVEL INSTRUCTION OR
/ A CALL TO AN INSTRUCTIONAL SUBROUTINE.
/ A SUBROUTINE CALL IS GENERATED IF BITS 5-17 .NE. ZERO.
/      B5-17 CONTAIN THE CONCATENATED FORM OF THE SUBROUTINE NAME
/	      (LESS THE FIRST CHARACTER WHICH IS A PERIOD)
/      B0 INDICATES WHETHER THE ARGUMENT IS AN ADDRESS OR A LAC ADDRESS
/	      (B0 .EQ. ONE CAUSES THE LAC TO BE GENERATED)
/ THE SUBROUTINE CALLING SEQUENCE IS...
/      JMS*   NAME
/      .DSA   ARGUMENT ADDR  (+400000 IF INDIRECT)
/ OR   JMS*   NAME
/      LAC    ARGUMENT ADDR  (LAC*  IF INDIRECT)
/ A MACHINE-LEVEL INSTRUCTION IS GENERATED IF BITS 5-17 .EQ. ZERO.
/      B0-4 CONTAINS THE OPERATION CODE
/ A MACHINE-LEVEL INSTRUCTION IS....
/      XXX    ARGUMENT ADDR  (XXX*  IF INDIRECT)
/
OPTRAN .DSA   .+1
       .DSA   000402	     /BCD READ	  -- .FR
	.DSA 000407	/BCD WRITE -- .FW
       LAC    0 	     /.OR.
       AND    0 	     /.AND.
       LAC    0 	     /.LOAD. I
C00047 .DSA   000057	     /.LOAD. R	  -- .AG
       .DSA   000067	     /.LOAD. D	  -- .AO
       LAC    0 	     /.LOAD. L
       DAC    0 	     /.STORE. I
C00048 .DSA   000060	     /.STORE. R   -- .AH
       .DSA   000070	     /.STORE. D   -- .AP
       DAC    0 	     /.STORE. L
       .DSA   400101	     / I - I	  -- .AY
       .DSA   000062	     / R - R	  -- .AJ
       .DSA   000072	     / D - D	  -- .AR
       TAD    0 	     / I + I
C00049 .DSA   000061	     / R + R	  -- .AI
       .DSA   000071	     / D + D	  -- .AQ
       .DSA   400055	     / I / I	  -- .AE
       .DSA   000064	     / R / R	  -- .AL
	.DSA 000074	/ D / D -- .AT
       .DSA   400054	     / I * I	  -- .AD
       .DSA   000063	     / R * R	  -- .AK
       .DSA   000073	     / D * D	  -- .AS
CMACMD CMA		     /	 - I
OPTR25 .DSA   127521	     /	 - R	  -- .BA
       .DSA   400122	     / I ** I	  -- .BB
	.DSA 400123		/ R ** I          -- .BC
       .DSA   000125	     / R ** R	  -- .BE
       .DSA   000126	     / R ** D	  -- .BF
       .DSA   400124	     / D ** I	  -- .BD
       .DSA   000127	     / D ** R	  -- .BG
S00130 .DSA   000130	     / D ** D	  -- .BH
       .DSA   000403         /BINARY READ	.FS
       .DSA   000410	     /BINARY WRITE-- .FX
       .DSA   000404	     /BACKSPACE   -- .FT
       .DSA   000405	     /REWIND	  -- .FU
       .DSA   000406	     /END FILE	  -- .FV
SSCALC .DSA   131013	     /SUBSCRIPT CALCULATION ROUTINE  -- .SS
       .DSA   400056	     /9EVERSE DIVIDE	I-I .AF
       .DSA   000066	     /REVERSE DIVIDE	R/R .AN
       .DSA   000076	     /REVERSE DIVIDE	D/D .AV
       .DSA   400102	     /REVERSE SUBTRACT	I-I .AZ
       .DSA   000065	     /REVERSE SUBTRACT	R-R .AM
S00075 .DSA   000075	     /REVERSE SUBTRACT	D-D .AU
       .DSA   000361	     /BCD ARRAY I/O	 -- .FA
       .DSA   000365	     /BCD ELEMENT I/O	 -- .FE
OPTR47 .DSA   127766	     /BCD I/O CLEANUP	 -- .FF
       .DSA   000362	     /BINARY ARRAY I/O	 -- .FB
       .DSA   000371	     /BINARY ELEMENT I/O -- .FI  I
       .DSA   000372	     /BINARY ELEMENT I/O -- .FJ  R
       .DSA   000373	     /BINARY ELEMENT I/O -- .FK  D
       .DSA   000374	     /BINARY ELEMENT I/O -- .FL  L
OPTR53 .DSA   127767	     /BINARY I/O CLEANUP -- .FG
PAMNE  .DSA   130601	     /.PA  PAUSE ROUTINE
STMNE  .DSA   131014	     /.ST  STOP ROUTINE
CGOMNE .DSA   130047	     /.GO COMPUTED GOTO OBJECT TIME SUBROUTINE
BLANKC .DSA   131330	     /.XX BLANK COMMON LABEL
TSIMNE .DSA   125050         /%I  INTEGER TEMP STORE MNEMONIC
TSRMNE .DSA   125620	     /%R  REAL    TEMP STORE MNEMONIC
TSDMNE .DSA   124540	     /%D  DOUBLE  TEMP STORE MNEMONIC
ACCMNE .DSA   127452	     /.AB  SECOND WORD FLOATING AC MNEMONIC
FIXMNE .DSA   127500	     /.AX  FLOAT TO FIX SUBROUTINE
FLTMNE .DSA   127477	     /.AW  FIX TO FLOAT SUBROUTINE
GETARG .DSA   127641	     /.DA ..FETCH ARGUMENT ADDR EXTERNAL SUBR
FNCMNE .DSA   527740	     /.EX ..FUNCTION RETURN PSEUDO STATE. NO.
	.DSA 130000	/.FP OTS I/0 INITIALIZE SUBR
       .EJECT
/ TRANSLATION TABLE FOR RELATIONAL OPERATORS
/ THE TABLE IS STRUCTURED SO THAT THE REVERSE OPERATION CAN BE
/ OBTAINED BY ADDING SIX TO THE ADDRESS OF THE NORMAL OPERATION
/
RELOPC .DSA   .-4	     /BASE CODE VALUE IS 5
       SPA!CLA		     /.LT.
       SPA!SNA!CLA	     /.LE.
       SNA!CLA		     /.EQ.
       SMA!CLA	     /.GE.
	SMA!SZA!CLA	/.GT.
       SZA!CLA		     /.NE.
/
/ RECOGNITION TABLE FOR LOCICAL AND RELATIONAL OPERATORS (ARGUMENTS)
/
LOCTAB .DSA   .+1	     /OP-ARG   OPVALU  LEVEL
       .DSA   723775	     /.FALSE.  1       (ARGUMENT)
       .DSA   775715	     /.TRUE.   0       (ARGUMENT)
       .DSA   001152	     /.OR.     2       2
       .DSA   004164	     /.AND.    3       3
       .DSA   054754	     /.NOT.    4       4
       .DSA   000764	     /.LT.     5       5
       .DSA   000745	     /.LE.     6       5
       .DSA   000331	     /.EQ.     7       5
       .DSA   000435	     /.GE.     8       5
       .DSA   000454	     /.GT.
       .DSA   001065	     /.NE.    10       5
LOCTBM .DSA   LOCTBM
       .EJECT
/ CHARACTER TRANSLATION TABLE
/
/ EACH ENTRY IN THIS TABLE CONTAINS THREE FIELDS OF INFORMATION
/      1) BITS 00-06  ASCIT CHARACTER CODE
/      2) BITS 07-11  CHARACTER TYPE CODE
/      3) BITS 12-17  INTERNAL CHARACTER CODE
/
CHRTAB .DSA   CHAR0	     /CHAR  ASCII  TYPE  INTERNAL
CHAR0  .DSA   300135	     / 0    060    01	 35
       .DSA   304136	     / 1    061    01	 36
       .DSA   310137	     / 2    062    01	 37
       .DSA   314140	     / 3    063    01	 40
       .DSA   320141	     / 4    064    01	 41
       .DSA   324142	     / 5    065    01	 42
       .DSA   330143	     / 6    066    01	 43
       .DSA   334144	     / 7    067    01	 44
       .DSA   340145	     / 8    070    01	 45
       .DSA   344146	     / 9    071    01	 46
       .DSA   404201	     / A    101    02	 01
CHARB  .DSA   410202	     / B    102    02	 02
CHARC  .DSA   414203	     / C    103    02	 03
CHARD       .DSA   420304	     / D    104    03	 04
       .DSA   424305	     / E    105    03	 05
       .DSA   430406	     / F    106    04	 06
       .DSA   434407	     / G    107    04	 07
       .DSA   440410	     / H    110    04	 10
       .DSA   444411	     / I    111    04	 11
       .DSA   450212	     / J    112    02	 12
       .DSA   454213	     / K    113    02	 13
CHARL  .DSA   460414	     / L    114    04	 14
       .DSA   464215	     / M    115    02	 15
	  .DSA	470216		  / N    116    02	 16
CHARO  .DSA   474217	     / O    117    02	 17
       .DSA   500420	     / P    120    04	 20
       .DSA   504221	     / Q    121    02	 21
       .DSA   510222	     / R    122    02	 22
CHARS  .DSA   514223	     / S    123    02	 23
       .DSA   520224	     / T    124    02	 24
CHARU       .DSA   524225	     / U    125    02	 25
       .DSA   530226	     / V    126    02	 26
       .DSA   534227	     / W    127    02	 27
       .DSA   540430	     / X    130    04	 30
       .DSA   544231	     / Y    131    02	 31
       .DSA   550232	     / Z    132    02	 32
       .DSA   241042	     / (    050    10	 42
       .DSA   245137         / )    051    11    37
	  .DSA	261236		  / ,    054    12	 36
       .DSA   270734	     / .    056    07	 34
       .DSA   254517	     / +    053    05	 17
       .DSA   264514	     / -    055    05	 14
       .DSA   250625	     / *    052    06	 25
       .DSA   274622	     / /    057    06	 22
       .DSA   365201	     / =    075    12	 01
CHARCR .DSA   065200	     / C/R  015    12	 00
CHARSP .DSA   201300	     / SP   040    13	 00
       .DSA   220050	     / $    044    00	 50
CHARLF .DSA   050000	     / LF   012    00	 00
TABCHR .DSA   044000	     / TAB  011    00	 00
	.DSA 224033	/ %    045    00    33
ARROW  .DSA   574000         / _    137    00    00
CHARLT	.DSA 765200	/ALT   175    12    00
       .DSA   214047         / #    043    00    47
	.IFDEF	ASCI
	204000		/!   041   00   00
	210000		/"   042   00   00
	230000		/&   046   00   00
	234000		/'   047   00   00
	350000		/:   072   00   00
	354000		/;   073   00   00
	360000		/<   074   00   00
	370000		/>   076   00   00
	374000		/?   077   00   00
	400000		/@   100   00   00
	554000		/[   133  00   00
	560000		/\   134   00   00
	564000		/]   135   00   00
	570000		/^   136   00   00
	.ENDC
CHRTBX .DSA   .
CHR1	.DSA 065236
CHR2	.DSA 765236
CHR3	.DSA 065200
CHR4	.DSA 765200
       .EJECT
/ TABLE OF CONSTANTS
/ POSITIVE DECIMAL INTEGERS WHOSE VALUE IS LESS THAN 100000 ARE
/ IDENTIFIED BY THE LABEL CXXXXX WHERE XXXXX IS THE MAGNITUDE OF THE
/ CONSTANT. NEGATIVE INTEGERS WHOSE VALUE IS LESS THAN 100000 ARE
/ IDENTIFIED BY THE LABEL KXXXXX WHERE XXXXX IS THE MAGNITUDE.
/
       .DEC
/00000 .DSA   000000
/00001 .DSA   000001
C00002 .DSA   000002
C00003 .DSA   000003
C00004 .DSA   000004
/00005 .DSA   000005
C00006 .DSA   000006
C00007 .DSA   000007
/00008 .DSA   000008
C00009 .DSA   000009
/00010 .DSA   000010
C00011 .DSA   000011
/00012 .DSA   000012
/00013 .DSA   000013
C00014 .DSA   000014
/00015 .DSA   000015
/00016 .DSA   000016
C00017 .DSA   000017
/00018 .DSA   000018
C00019 .DSA   000019
C00020 .DSA   000020
C00021 .DSA   000021
C00022 .DSA   000022
C00023 .DSA   000023
C00024 .DSA   000024
C00026 .DSA   000026
C00027 .DSA   000027
C00028 .DSA   000028
C00029 .DSA   000029
C00030 .DSA   000030
C00031 .DSA   000031
C00032 .DSA   000032
C00033 .DSA   000033
C00034 .DSA   000034
C00035 .DSA   000035
C00036 .DSA   000036
C00039 .DSA   000039	     /REVERSE DIVIDE OPERATOR
C00040 .DSA   000040
C00042 .DSA   000042	     /REVERSE SUBTRACT OPERATOR
C00045 .DSA   000045
C00046 .DSA   000046
/00047 .DSA   000047
/00048 .DSA   000048
/00049 .DSA   000049
DECPNT .DSA   044800	     /CONCATENATION OF . SP SP
/00001 .DSA   -000001
/00002 .DSA   -000002
/00003 .DSA   -000003
/00004 .DSA   -000004
/00005 .DSA   -000005
/00006 .DSA   -000006
/00009 .DSA   -000009
	.IFDEF	DUMY
K00010	-10
	.ENDC
/00012 .DSA   -000012
/00013 .DSA   -000013
/00015 .DSA   -000015
/00017 .DSA   -000017
/00029 .DSA   -000029
/00036 .DSA   -000036
K00040 .DSA   -000040
K00077 .DSA   -000077
K01600 .DSA   -001600
K08177	-8177
K08192 .DSA   -008192
K08191 .DSA   -008191
	.IFDEF	PDP15
K04081	-4081
	.ENDC
       .EJECT
/ LOGICAL CONSTANTS ARE IDENTIFIED BY THE LABEL LXXXXX WHERE L IS S,T,U,
/ V,W,X,Y,Z REPRESENTING 0,1,2,3,4,5,6,7 RESPECTIVELY AND THE MOST
/ SIGNIFICANT OCTAL DIGIT AND XXXXX IS THE REMAINING FIVE DIGITS.
       .OCT
	.IFUND ERMSG
W04007	.DSA 404007
	.ENDC
W00000 .DSA   400000
X00000	.DSA	500000
T00000=JMSCMD
Z00000 .DSA   700000
S01200 .DSA   001200
Z77700 .DSA    777700
Z76600 .DSA   776600
V00000 .DSA   300000
U00000=LACCMD
Y00000=JMPCMD
W00004 .DSA   400004
Z60001=K08191
S20377 .DSA   020377
S00777 .DSA   000777
Z77776=K00002
W00030 .DSA   400030
S20000 .DSA   020000
S17777 .DSA   017777
W60000 .DSA   460000
S00077 .DSA   000077
T77700 .DSA   177700
S60000 .DSA   060000
S40000=DACCMD
T77777 .DSA   177777
Y77777	.DSA	677777
S00611	.DSA 0000611
V60000 .DSA   360000
V40000=TADCMD
X40000 .DSA   540000
S10402	.DSA 010402
S10403	.DSA 010403
S00040=C00032
S00050=C00040
S00051 .DSA   000051
S00054 .DSA   000054
S00055=C00045
S00056=C00046
S00057=C00047
S00060=C00048
S00114 .DSA   000114
S00117 .DSA   000117
S00120 .DSA   000120
S00124 .DSA   000124
S00175	.DSA 000175
S02766	.DSA 002766
S02775	.DSA 002775
S00177	.DSA 000177
S00101 .DSA   000101
S00707 .DSA   000707	     
W17777 .DSA   417777
V77777 .DSA   377777
S00700	000700
S00600	000600
S01000	001000
S01100	001100
S00100	000100
S00500	000500
S00105	000105
S00106	000106
S00104	000104
S00107	000107
S00110	000110
S00300	000300
S00400	000400
C00073=.
S00111	000111
Z60000=K08192
Z77770 .DSA   777770
S00121 .DSA   000121
S07700 .DSA   007700
S17776 .DSA   017776
Z74000 .DSA   774000
Z77706 .DSA   777706
S00041=C00033
S00052=C00042
S00053 .DSA   000053
S00134 .DSA   000134
U02020 .DSA   202020
U40000	.DSA	240000
	.IFUND	ERMSG
ERFLG1	406400
ERFLG2	457032
	.ENDC
	.IFDEF	ERMSG
ERFLG1	.ASCII	<74>' '<15>
	.LOC	.-1
ERFLG2	.ASCII	<74>'^'<15>
	.LOC	.-1
	.ENDC
W06400	.DSA	406400
W57032	.DSA	457032
Z40000=PASS2
S01700 .DSA   001700
S01502 .DSA   001502
S77777 .DSA   077777
S00377 .DSA   000377
W77777 .DSA   477777
	.IFDEF	IMBED
Z77677	777677
C00008	10
Z77744	777744
C00010	12
Z67777	767777
X17777	517777
Z77577	777577
LISTT	JMS	TTYOUT
LISTD	JMS	DWRITE
	.IFDEF	%F2
LISTI	XX
	.ENDC
C00013	15
Z77000	777000
	.ENDC
BNKBTS .DSA	0
	.IFDEF	X4K
MASK	60000
	.ENDC
	.IFDEF	PTP
	.END	BANK*20000+17720
	.ENDC
	.IFDEF	IMBED
	.EOT
	.ENDC
	.IFUND	PTP
	.END
