<div id='wikitext'>
<pre><b> File: F4.PA of Tape: Original/Originals/AL-4547D-SA</b></pre>
<pre><b>(Source file text) </b></pre>
<hr />
<pre>
/4 OS/8 FORTRAN  (PASS ONE)
/
/ VERSION 4A  PT  16-MAY-77
/
/	OS/8 FORTRAN COMPILER - PASS 1
/
/	BY:  HANK MAURER
/	UPDATED BY: R.LARY + M. HURLEY
/
/
/COPYRIGHT  (C)  1974,1975 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL&#039;S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
VERSON=4
/CHANGES FOR MAINTENANCE RELEASE (S.R.):

/1.	BUMPED VERSION NUMBER TO 304
/2.	INCLUDED PATCH SEQ #4 (OCT DSN) FOR SF ERROR FIX
/3.	INCLUDED PATCH SEQ #6 (TEMP VARS IN ASF)
/4.	FIXED PROBLEM IN DATA STATEMENT
/5.	STOPPED HALT AFTER OT ERROR BY CONVERTING LOGICAL
/	VARS TO INTEGER IN ARITHMETIC IF STATEMENT
/6.	FIXED BUG RE /A AND .RA EXTENSION

/LAST MINUTE CHANGES:

/7.	ALLOWED PARITY INPUT
/8.	IGNORE NULLS ON INPUT
/9.	FIXED BUG RE IGNORING LAST LINE IF IN ERROR
/	OR IN FACT IGNORING ANY LAST LINE IF NO END STATEMENT
/10.	ALLOW MULTIPLE INPUT FILES
/
/
/CHANGES FOR OS/8 V3D AND OS/78 BY P.T.
/  .PATCH LEVEL NOW CONTAINED IN LOCATION 1130
	*7
LINENO,	1			/2.01/ LINE NUMBER
X10,	0			/AUTO INDEX REGISTERS
X11,	0
X12,	0
NEXT,	FREE-1			/FREE SPACE POINTER
STACK,	STACKS-1		/STACK POINTER
CHRPTR,	0			/INPUT BUFFER POINTER
X16,	0
X17,	0
STKLVL,	STACKS-1		/STACK BASE LEVEL
BUCKET,	0			/FIRST CHAR OF NAME
WORD1,	0			/SIX WORD LITERAL BUFFER
WORD2,	0
WORD3,	0
WORD4,	0
WORD5,	0
WORD6,	0
ACO,	0			/FLOATING AC OVERFLOW WORD
OP1,	0			/SEVEN WORD OPERAND FOR &quot;NUMBER&quot;
OP2,	0
OP3,	0
OP4,	0
OP5,	0
OP6,	0
OPO,	0
CHAR,	0			/ICHAR PUTS CHARACTER HERE
NOCODE,	0			/IS 1 IF CODE GENERATION OFF
NCHARS,	0			/SIZE OF INPUT LINE
NUMELM,	0			/NUMBER OF VARS IN TYPED LIST
TEMP,	0
TEMP2,	0
DECPT,	0			/SET 1 IF NUMBER CONTAINED .
ESWIT,	0			/1 FOR E  0 FOR D
NDIGIT,	0			/NUMBER OF DIGITS TO RIGHT OF .
HCHAR,	HCOUNT			/HOLLERITH GETTER ROUTINE
SNUM,	0			/POINTER TO ST ENTRY FOR STMT NUMBER
IFSWIT,	0			/=1 IF INSIDE LOGICAL IF
EXPON,	0			/HOLDS EXPONENT FOR CONVERSION
TMPFIL,	0617;2224;2216;2415	/PASS1 OUTPUT FILE
	0;0;0;0			/PASS2 OUTPUT FILE
DOEND,	0			/SET 1 IF THIS STMT WAS A IF,
				/GOTO, RETURN, PAUSE, OR STOP
THSNUM,	0			/CURRENT STATEMENT NUMBER
DIMNUM,	0			/LINEARIZED SS FOR EQ
DPRDCT,	0			/HOLDS DIMENSION PRODUCT
EQTEMP,	0			/TEMP FOR EQUIVALENCE
MQ,	0			/MQ FOR 12 BIT MULTIPLY
MASTER,	0			/POINTER TO MASTER IN EQUIV GROUP
MNUM,	0			/LINEARIZED SS FOR MASTER
NSLAVE,	0			/NUMBER OF SLAVES IN GROUP
PASS2O,	0			/START OF PASS 2 OVERLAY SECTION
OUFILE,	0			/START OF PASS1 OUTPUT FILE
DSERES,	0			/MAGIC NUMBER
PROGNM,	MAIN			/POINTER TO PROG NAME
ARGLST,	0			/POINTER TO ARG LIST
FUNCTN,	0			/0=MAIN, 1=FUNCTION, -2=SUBROUTINE
SETBIT,	0			/TEMPS FOR DECLARATION SCANNER
BADBIT,	0
DOINDX,	0			/POINTER TO DO INDEX FOR DO LOOPS
TLTEMP,	0			/TEMP FOR TYPE ROUTINE
OWTEMP,	0			/TEMP FOR OUTWRD
CNT72,	-102			/72 COLUMN COUNTER
DPUSED,	0			/=1 IF DOUBLE HARDWARE USED
VERS,	VERSON			/VERSION NUMBER
M211,	-211
P211,	211
P240,	240
IXLNP5,	LINE+5			/**
IXLINE,	LINE
IXLINM,	LINE-1
STMJMP,	0		/FOR DEFINE FILE
/ OPCODES AND EQUS
	MAXHOL=100		/MAXIMUM HOLLERITH LITERAL
	COMREG=4600		/INTER-PASS COMMUNICATION REGION
	STACKS=4700		/STACK AREA
	NAME1=6200		/NAME AND HOLLERITH BUFFER (WAS 6400)**
	LINE=6300		/LINE BUFFER (WAS 6500)**
	INBUF=6600		/INPUT BUFFER (FIELD 1)
	OUBUF=7200		/OUTPUT BUFFER (DITTO)
	INDEVH=7200		/INPUT DEVICE HANDLER (WAS 7400)**
	PAUSOP=22
	DPUSH=PAUSOP+1
	BINRD1=DPUSH+1		/OPCODE DEFINITIONS
	FMTRD1=BINRD1+1
	RCLOSE=FMTRD1+1
	DARD1=RCLOSE+1
	BINWR1=DARD1+1
	FMTWR1=BINWR1+1
	WCLOSE=FMTWR1+1
	DAWR1=WCLOSE+1
	DEFFIL=DAWR1+1
	ASFDEF=DEFFIL+1
	ARGSOP=ASFDEF+1
	EOLCOD=ARGSOP+1
	ERRCOD=EOLCOD+1
	RETOPR=ERRCOD+1
	REWOPR=RETOPR+1
	STOROP=REWOPR+1
	ENDOPR=STOROP+1
	DEFLBL=ENDOPR+1
	DOFINI=DEFLBL+1
	ARTHIF=DOFINI+1
	LIFBGN=ARTHIF+1
	DOBEGN=LIFBGN+1
	ENDFOP=DOBEGN+1
	STOPOP=ENDFOP+1
	ASNOPR=STOPOP+1
	BAKOPR=ASNOPR+1
	FMTOPR=BAKOPR+1
	GO2OPR=FMTOPR+1
	CGO2OP=GO2OPR+1
	AGO2OP=CGO2OP+1
	IOLMNT=AGO2OP+1
	DATELM=IOLMNT+1
	DREPTC=DATELM+1
	DATAST=DREPTC+1
	ENDELM=DATAST+1
	PRGSTK=ENDELM+1
	DOSTOR=PRGSTK+1
/ ASSEMBLE STATEMENT
	PAGE
RDLOOP,	CIF	10		/FOR OS/8 2 PG HANDLERS**
	JMS I	[ICHAR		/GET CHAR FROM INPUT FILE
	JMP	ENDLIN		/END LINE OR CR
	TAD	M211		/CHECK FOR TAB**
	SNA
	TAD	(240-211	/CONVERT TO BLANK
	TAD	P211		/**
	DCA I	CHRPTR		/SAVE CHAR
	ISZ	CNT72		/PAST COLUMN 72 ?
	SKP
	JMP	SKPLIN		/SKIP 73 TO 80
	TAD	CHRPTR
	CIA CLL
	TAD	(LINE+670
	SZL CLA			/TEST FOR TOO MANY CONTINUATIONS
	JMP	RDLOOP
	JMS I	[ERMSG		/LINE TOO LONG
	1424
SKPCOM,	TAD	X16		/RESTORE CHRPTR
	DCA	CHRPTR
SKPLIN,	CIF	10		/**
	JMS I	[ICHAR		/SKIP REST OF LINE
	JMP	ENDLIN
	CLA
	JMP	SKPLIN
ENDLIN,	TAD	CHRPTR		/SAVE CHAR POSITION
	DCA	X16
	TAD	CHRPTR
	DCA	X10		/SAVE POSITION FOR COMMENT CHECK
	TAD	(-102		/SET COLUMN COUNT
	DCA	CNT72
	TAD	M6
	DCA	NCHARS
GET6,	CIF	10		/**
	JMS I	[ICHAR		/GET FIRST 6 CHARS
	JMP	SHORTL		/IGNORE SHORT LINES
	TAD	M211		/IS CHAR A TAB ? **
	SZA CLA
	JMP	NOTAB		/NO
	TAD	P240		/TREAT FIRST TAB AS SIX BLANKS
	DCA I	CHRPTR
	ISZ	NCHARS
	JMP	.-3
	TAD	P240		/FAKE CONTINUATION CHECK
	DCA	CHAR
	JMP	CCHECK		/GO TO COMMENT CHECK
SHORTL,	TAD	X16		/RESET CHAR POINTER
	DCA	CHRPTR		/TO IGNORE SHORT LINES
	JMP	ENDLIN
NOTAB,	TAD	CHAR
	DCA I	CHRPTR
	ISZ	NCHARS
	JMP	GET6		/LOOP
CCHECK,	TAD I	X10		/IS IT A COMMENT ?
	TAD	(-303
	SNA CLA
	JMP	SKPCOM		/COMMENT, SKIP REST
NOCMNT,	TAD	CHAR		/WAS SIXTH CHAR A BLANK ?
	TAD	MMM240
	SNA CLA
	JMP	GOTLIN		/YES, NO MORE CONTINUATIONS
CCARD,	TAD	X16		/IGNORE THESE SIX CHARACTERS
	DCA	CHRPTR
	JMP	RDLOOP		/CONTINUE WITH THIS LINE
GOTLIN,	TAD	CHRPTR		/COMPUTE -NCHARS-1
	CIA
	TAD	(LINE+4
	DCA	NCHARS
	TAD	[LINE-1		/RESET CHAR POINTER
	DCA	CHRPTR
	JMS I	[CKCTLC		/CHECK FOR CONTROL C
LINE1,	DCA	THSNUM		/ZERO CURRENT STMT NUMBER
	CLL CML RAR		/SET LABEL DEFINE BIT
	JMS I	[STMNUM		/GO LOOK FOR LABEL
	JMP	COMPIL		/NONE THERE
	TAD	SNUM		/SAVE STATEMENT NUMBER
	DCA	THSNUM
	TAD	(DEFLBL		/OUTPUT DEFINITION FOR THIS LABEL
	JMS I	[OUTWRD
	TAD	SNUM
	JMS I	[OUTWRD		/FOLLOWED BY THE LABEL ADDRESS
COMPIL,	JMS I	[SAVECP
	ISZ	LINENO		/2.01/ PUT LINE NUMBER
	TAD	LINENO		/2.01/ INTO MQ
	7421			/2.01/
	CLA IAC
	DCA	NOCODE		/SET NOCODE SWITCH
	JMS I	[ERMSG		/SET UP DEFAULT ERROR MESSAGE
	1513
	JMS I	[LEXPR		/IS IT ARITHMETIC ?
	JMP	NOTAR		/NO
	JMS I	[GETC		/LOOK FOR =
	JMP	NOTAR		/NOT ARITHMETIC
	TAD	MMM275		/=
	SNA CLA
	JMS I	[EXPR		/SCAN LEFT PART
	JMP	NOTAR
	JMS I	[ERMSG		/SET MESSAGE TO ILLEGAL OPERATOR
	1720
	ISZ	NCHARS		/SHOULD BE NOTHING LEFT
	JMP	NOTAR		/IF THERE IS, ITS NOT ARITHMETIC
ITSAR,	JMS I	[RESTCP		/RESTORE TO START OF LINE
	DCA	NOCODE		/ALLON CODE
	JMS I	[LEXPR		/GET LEFT SIDE
M6,	-6			/V3C MUST BE HERE
	JMS I	[GETC		/SKIP =
MMM240,	-240			/SHOULD NEVER GET HERE
	CLA
	JMS  I	[EXPR		/GET RIGHT SIDE
MMM275,	-275			/SHOULD NEVER GET HERE
	TAD	(STOROP		/OUTPUT STORE
	JMS I	[OUTWRD
	JMP I	[NEXTST		/DO NEXT LINE
NOTAR,	JMS I	[RESTCP		/RESTART LINE
	DCA	NOCODE
	JMS I	[SAVECP		/RESAVE CHAR POSITION
	TAD	(CMDLST-1
	DCA	X10
	JMP I	(CMDLUP		/GO SEARCH FOR KEYWORD
/ KEYWORD SEARCH
	PAGE
CMDLUP,	CDF	10		/TABLE IN FIELD ONE
	TAD I	X10		/GET NEXT 2 CHARS OF KEYWORD
	SZA
	JMP	CMDLP2		/NOT DONE YET
	CLL CMA RAL		/REMOVE CHAR POS FROM STACK
	TAD	STACK
	DCA	STACK
	TAD I	X10		/GET ROUTINE ADDRESS
	CDF
	DCA	STMJMP
	JMP I	STMJMP		/JUMP TO THE ROUTINE
CMDLP2,	DCA	TEMP		/SAVE THE TWO CHARS
	CDF
	JMS I	[GET2C		/GET TWO CHARS FROM THE INPUT
	JMP	.+4		/NOT ENOUGH CHARS, CAN&#039;T BE THIS ONE
	TAD	TEMP		/COMPARE
	SNA CLA
	JMP	CMDLUP		/MATCHES, KEEP GOING
	JMS I	[RESTCP		/RESTORE CHAR POS
	ISZ	STACK
	ISZ	STACK		/AND SAVE IT AGAIN
	CDF	10
	TAD I	X10		/FIND END OF THIS COMMAND
	SZA CLA
	JMP	.-2
	ISZ	X10		/SKIP ROUTINE ADDRESS
	TAD I	X10		/IS THE LIST EXHAUSTED ?
	SZA
	JMP	CMDLP2		/NO, GO AGAIN
BADCMD,	JMS I	[ERMSG		/TREAT AS BAD ARITHMETIC STMT
ERCODE,	0
/ END OF STMT PROC
NEXTLN,
NEXTST,
DOENDR,	TAD	STKLVL		/RESET STACK POINTER
	DCA	STACK
	JMS I	[POP		/LOOK FOR DO END
	CIA
	TAD	THSNUM		/DOES THIS LINE END A DO LOOP ?
	SZA CLA
	JMP	NODOND		/NO, REPLACE STACK AND COMPILE STMT
	TAD	(DOFINI
	JMS I	[OUTWRD		/OUTPUT DO END COMMAND
	JMS I	[POP		/GET INDEX VARIABLE
	JMS I	[OUTWRD
	TAD	STACK		/RESET STACK BASE LEVEL
	DCA	STKLVL
	TAD	DOEND		/WAS THIS A LEGAL ENDING STMT ?
	SZA CLA
	JMS I	[ERMSG
	0504			/DO END ERROR
	DCA	DOEND		/KILL SWITCH
	JMP	DOENDR
NODOND,	ISZ	STACK		/REPLACE STACK ENTRY
	DCA	DOEND		/KILL SWITCH
	TAD	(EOLCOD		/OUTPUT EOL CODE
	JMS I	[OUTWRD
	DCA	ERCODE		/RESET ERROR CODE
	DCA	IFSWIT		/KILL IF SWITCH
	TAD	(-6		/MOVE FIRST 6 CHARS
	DCA	NCHARS
	TAD	[LINE-1		/INTO START OF BUFFER
	DCA	CHRPTR
	TAD I	X16
	DCA I	CHRPTR
	ISZ	NCHARS
	JMP	.-3
	JMP I	(RDLOOP
/ GOTO&#039;S
GOTO,	ISZ	DOEND		/DO END ILLEGAL
	JMS I	[STMNUM		/IS IT A SIMPLE GOTO ?
	JMP	CMPGO2		/NO, SEE IF ITS A COMPUTED ONE
	TAD	(GO2OPR		/OUTPUT GOTO OPERATOR
	JMS I	[OUTWRD
	TAD	SNUM		/FOLLOWED BY STMT NUMBER
	JMS I	[OUTWRD
	JMP I	[NEXTST
CMPGO2,	JMS I	[GETC		/LOOK FOR (
	JMP	BADGO2		/BAD GOTO
	TAD	(-250
	SZA CLA
	JMP	ASNGO2		/NOT ( , MAYBE ITS AN ASSIGNED GOTO
	TAD	STACK		/SAVE STACK POSITION
	DCA	X12
	DCA	TEMP		/ZERO BRANCH COUNTER
GO2LUP,	JMS I	[STMNUM		/GET NEXT STMT NUMBER
	JMP	BADGO2		/MUST BE THERE
	TAD	SNUM
	JMS I	[PUSH		/SAVE IT TEMPORARILY
	ISZ	TEMP		/BUMP BRANCH COUNT
	JMS I	[COMARP		/LOOK FOR COMMA OR RIGHT PAREN
	JMP	BADGO2		/NEITHER
	JMP	GO2LUP		/COMMA, GO GET NEXT LABEL
	JMS I	[GETC		/SKIP NEXT CHAR (ITS A COMMA)
	JMP	BADGO2
	CLA
	TAD	TEMP		/SAVE COUNT
	JMS I	[PUSH		/ON STACK
	JMS I	[EXPR		/COMPILE INDEX EXPR
	JMP I	[NEXTST
	TAD	(CGO2OP		/OUTPUT COMPUTED GOTO OPERATOR
	JMS I	[OUTWRD
	JMS I	[POP		/GET COUNT
	CIA
	DCA	TEMP		/SAVE COMPLEMENT
	TAD	TEMP
	CIA
	JMS I	[OUTWRD		/OUTPUT COUNT
	TAD	X12		/RESTORE STACK POINTER
	DCA	STACK
	TAD I	X12		/MOVE STMT NUMBERS TO OUTPUT
	JMS I	[OUTWRD
	ISZ	TEMP
	JMP	.-3
	JMP I	[NEXTST
ASNGO2,	JMS I	[BACK1		/PUT BACK NON (
	JMS I	[LEXPR		/GET ASSIGN VAR
	JMP	BADGO2
	TAD	(AGO2OP		/OUTPUT GOTO OPERATOR
	JMS I	[OUTWRD
	JMP I	[NEXTST
BADGO2,	JMS I	[ERMSG
	0724
	JMP I	[NEXTST
/ I/O STATEMENTS
	PAGE
RDWR,	0			/SUBR FOR IO STATEMENTS
	JMS I	[CHECKC		/LOOK FOR (
M250,	-250
	JMP	BADRD
	JMS I	[EXPR		/COMPILE UNIT
	JMP I	[BADCMD
	JMS I	[COMARP
	JMP	DAQUOT		/LOOK FOR &#039; (DIRECT ACCESS I/O)
	JMP	RDFMT		/,
	TAD	(BINRD1		/FORMATLESS READ/WRITE
IOSTRT,	TAD I	RDWR		/ADD ADJUSTOR
	JMS I	[OUTWRD		/OUTPUT BINARY READ
IOLIST,	JMS I	[PUSH		/MARK STACK
	JMS I	[GETC		/IS IT AN IMPLIED DO ?
	JMP	ENDIOL		/NO, END OF LIST
	TAD	M250
	SZA CLA
	JMP	TRYIOE		/NO, LOOK FOR IO ELEMENT
	JMS I	[SAVECP		/SAVE CHAR POS AT START OF IDO
	DCA	IDOPAR		/ZERO PAREN COUNTER
FINDND,	JMS I	[GETNAM		/GET A NAME IF THERE IS ONE
XPURGE,	PRGSTK			/DON&#039;T WORRY ITS A NOP
	JMS I	[GETC		/GET A CHAR
	JMP	ENDIOL
	TAD	M251		/IS IT A ) ?
	SNA
	JMP	RPIOL		/YES
	IAC			/IS IT ( ?
	SNA
	JMP	LPIOL		/YES
	TAD	(250-275	/IS IT = ?
	SZA CLA
	JMP	FINDND		/NONE OF THESE
	TAD	IDOPAR		/IS PAREN COUNT 0 ?
	SZA CLA
	JMP	FINDND		/NO, ITS FROM AN INNER LOOP
	JMS I	[LOOKUP		/THIS ELEMENT IS THE DO INDEX
	DCA	DOINDX
	JMS I	(DOSTUF		/COMPILE THE LOOP
	JMP	BADIOL		/ERROR IN DO PARMS
	JMS I	[CHECKC		/MUST HAVE )
	-251
	JMP	BADIOL
	TAD	CHRPTR		/SAVE CHAR POSITION
	DCA	TEMP
	TAD	NCHARS
	DCA	TEMP2
	JMS I	[RESTCP		/RESTORE TO START OF IMPLIED LOOP
	TAD	TEMP2		/NOW SAVE POS AFTER LOOP
	JMS I	[PUSH
	TAD	TEMP
	JMS I	[PUSH
	TAD	DOINDX		/AND DO INDEX
	JMP	IOLIST
LPIOL,	ISZ	IDOPAR		/( INCREASES COUNT
	JMP	FINDND
RPIOL,	CMA			/) DECREASES COUNT
	TAD	IDOPAR
	SMA
	JMP	FINDND-1
	CLA
BADIOL,
BADRD,	JMS I	[ERMSG		/BAD IO STMT
	2227
	JMP I	[NEXTST
TRYIOE,	JMS I	[BACK1		/PUT BACK NON (
	JMS I	[LEXPR		/GET IOLIST ELEMENT
	JMP	BADRD		/NOT THERE, ERROR
	JMS I	[GETC		/LOOK FOR A COMMA
	JMP	.+4		/EOL
	TAD	(-254
	SZA
	JMP	NOTIOL		/NOT AN ELEMENT
	TAD	(IOLMNT		/OUTPUT OPCODE
	JMS I	[OUTWRD
	JMP	IOLIST+1
NOTIOL,	TAD	(254-275	/IS IT AN = (END OF IDO)
	SZA CLA
	JMP	BADIOL		/NO, BAD
	JMS I	[POP		/GET STUFF FROM THE STACK
	SNA
	JMP	BADIOL		/ZERO IS BAD
	DCA	DOINDX		/THIS IS THE INDEX
	JMS I	[RESTCP		/GET THE CHAR POSITION
	TAD	XPURGE		/OUTPUT PURGE OPERATOR
	JMS I	[OUTWRD		/BECAUSE AN EXTRA IS ON THE STK
	TAD	(DOFINI		/END LOOP
	JMS I	[OUTWRD
	TAD	DOINDX
	JMS I	[OUTWRD
	JMS I	[GETC		/END OF LIST ?
	JMP	ENDIOL
	TAD	(-254
	SZA CLA
	JMP	BADIOL		/MUST BE A COMMA
	JMP	IOLIST+1
IDOPAR,	0
ENDIOL,	JMS I	[POP		/IS THE MARK THERE ?
	SZA CLA
	JMP	BADRD		/NO, ERROR
	TAD I	RDWR
	TAD	(RCLOSE		/END OF IO OPERATION
	JMS I	[OUTWRD
	JMP I	[NEXTST
RDFMT,	JMS I	[STMNUM		/LOOK FOR FMT LINE NUMBER
	JMP	RTFMT
	JMS I	[OUTWRD		/OUTPUT PUSH COMMAND
	TAD	SNUM		/OUTPUT STMT NUMBER OF FORMAT
	JMS I	[OUTWRD
RDLIST,	TAD	(FMTRD1		/START OF FORMATTED READ
	TAD I	RDWR		/ADD ADJUSTOR
	JMS I	[OUTWRD
	JMS I	[CHECKC		/LOOK FOR )
M251,	-251
	JMP	BADRD
	JMP	IOLIST		/GO GET IO LIST
RTFMT,	JMS I	[LEXPR		/GET R.T. FORMAT
	JMP	BADRD
	JMP	RDLIST		/GET LIST
/DIRECT ACCESS I/O
	PAGE
DAQUOT,	JMS I	[BACK1
	JMS I	[CHECKC		/LOOK FOR &#039;
	-247
	JMP	BADRD		/SYNTAX IS NO GOOD
	JMS I	[EXPR		/GET RECORD NUMBER EXPR
	JMP	BADRD
	JMS I	[CHECKC		/LOOK FOR )
	-251
	JMP	BADRD
	TAD	(DARD1		/DIRECT ACCESS OPEN
	JMP	IOSTRT
FIND,	JMP I	[NEXTST		/COOL ISN&#039;T IT ?
DFINFL,	JMS I	[EXPR		/COMPILE UNIT
	JMP	BADDEF		/BAD DEFINE STMT
	DCA	STMJMP		/PERMIT VARIABLE FOR LOG UNIT
	JMS I	[CHECKC		/(
	-250
	JMP	BADDEF
	JMS I	[EXPR		/NUMBER OF RECORDS
	JMP	BADDEF
	JMS I	[CHECKC		/,
	-254
	JMP	BADDEF
	JMS I	[EXPR		/RECORD SIZE
	JMP	BADDEF
	JMS I	[CHECKC		/,
	-254
	JMP	BADDEF
	JMS I	[CHECKC		/U
	-325
	JMP	BADDEF
	JMS I	[CHECKC		/,
MCOMA,	-254
	JMP	BADDEF
	JMS I	[GETNAM		/GET INDEX VARIABLE
	JMP	BADDEF
	JMS I	[OUTWRD
	JMS I	[LOOKUP
	JMS I	[OUTWRD		/OUTPUT INDEX VAR
	TAD	(DEFFIL		/OUTPUT DEFINE OPERATOR
	JMS I	[OUTWRD
	JMS I	[CHECKC		/)
	-251
	JMP	BADDEF
	JMS I	[GETC		/ANOTHER DEFINE ?
	JMP I	[NEXTST
	TAD	MCOMA		/, ?
	SNA CLA
	JMP	DFINFL		/YES, ANOTHER FILE
BADDEF,	JMS I	[ERMSG		/BAD DEFINE FILE STMT
	0406
	JMP I	[NEXTST
RESTCP,	0			/RESTORE CHAR POSITION FROM STACK
	JMS I	[POP
	DCA	CHRPTR
	JMS I	[POP
	DCA	NCHARS
	JMP I	RESTCP
INTEGE,	JMS I	[CHECKC		/INTEGER STMT
	-322
	JMP I	[BADCMD
	JMS I	[TYPLST
	0101
	0100
	NOP
	JMP I	[NEXTST
PAUZE,	JMS I	[CHECKC		/LOOK FOR E
	-305
	JMP I	[BADCMD
	JMS I	[GETC		/ANY EXPR ?
	JMP	NOARGP		/MAKE IT PAUSE 1
	JMS I	[BACK1		/PUT IT BACK
	JMS I	[EXPR		/GET PAUSE NUMBER
XPAUZ,	PAUSOP
OPAUZ,	TAD	XPAUZ		/OUTPUT PAUSE OPERATOR
	JMS I	[OUTWRD
	JMP I	[NEXTST
NOARGP,	JMS I	[OUTWRD		/PUSH 1.0
	TAD	[ONE
	JMS I	[OUTWRD
	JMP	OPAUZ		/GO PUT OPERATOR
READ,	JMS I	(RDWR		/COMPILE READ STMT
	0
WRITE,	JMS I	[CHECKC		/LOOK FOR E
	-305
	JMP I	[BADCMD
	JMS I	(RDWR		/COMPILE WRITE
	BINWR1-BINRD1
CKCTLC,	6401			/CHECK FOR CONTROL C
	TAD	(7600
	KRS
	TAD	(-7603		/^C
	SNA CLA
	KSF
	JMP I	CKCTLC
	JMP I	(7600

XOCTAL,	DCA	WORD1		/**
	DCA	WORD2
	DCA	WORD3		/STATEMENT NUM LEFT THERE**
	DCA	WORD5
	DCA	WORD6
XCTAL1,	DCA	WORD4
	JMS I	[DIGIT		/GET NEXT DIGIT
	JMP	ENDOXT		/NO DIGITS LEFT
	AND	[7		/THROW AWAY SOME BITS
	DCA	TEMP
	JMS I	(AL1		/MOVE WORD LEFT THREE
	JMS I	(AL1
	JMS I	(AL1
	TAD	WORD4		/ADD DIGIT TO WORD4
	TAD	TEMP
	JMP	XCTAL1		/LOOP
ENDOXT,	TAD	WORD2		/PUT WORDS INTO THE LEFT PLACE
	DCA	WORD1
	TAD	WORD3
	DCA	WORD2
	TAD	WORD4
	DCA	WORD3
	JMP	DATAFP		/GO STUFF IT AWAY
/ DIMENSION, COMMON, REAL
	PAGE
DIMENS,	JMS I	[IFCHEK
	JMS I	[CHECKC		/CHECK FOR &quot;N&quot;
	-316
	JMP I	[BADCMD		/NO GOOD
	JMS I	[TYPLST		/PROCESS LIST
	0000			/DIMENSION IS THE SIMPLEST CASE
	0000
	NOP			/ERROR RETURN
	JMP I	[NEXTST
REAL,	JMS I	[IFCHEK		/CHECK FOR INSIDE IF
	JMS I	[TYPLST		/PROCESS LIST
	0102			/TYPE-REAL
	0100
	NOP
	JMP I	[NEXTST
COMPLE,	JMS I	[CHECKC		/CHECK FOR &quot;X&quot;
	-330
	JMP I	[BADCMD
	JMS I	[IFCHEK
	JMS I	[TYPLST		/PROCESS COMPLEX LIST
	0103
	0100
	NOP
	CLA IAC			/SET DP SWITCH
	DCA	DPUSED
	JMP I	[NEXTST
COMMON,	JMS I	[IFCHEK		/BAD INSIDE LOGICAL IF
	JMS I	[GETC		/CHECK FOR SLASH
	JMP I	[BADCMD
	TAD	M257
	SZA CLA
	JMP	BLANKC		/MUST BE BLANK COMMON
	JMS I	[GETNAM		/GET NAME OF COMMON
	JMP	DBLSLS		/MIGHT BE //
	JMS I	[CHECKC		/LOOK FOR /
M257,	-257
	JMP	BADCOM
	JMS I	[LOOKUP		/LOOKUP COMMON NAME
	IAC
	DCA	COMNAM		/SAVE ADDR OF TYPE WORD
	CDF	10
	TAD I	COMNAM		/LOOK AT TYPE
	SZA
	TAD	(-111		/MUST BE COMMON OR UNDEF.
	SZA CLA
	JMP	BADCOM
	TAD	(111		/SET CORRECT BITS
	DCA I	COMNAM
	CDF
DOCOMN,	JMS I	[TYPLST		/HANDLE LIST
	4000
	5460
	JMP I	[NEXTST
	TAD	X12
	DCA	STACK		/RESET STACK
	CDF	10
	ISZ	COMNAM		/POINTER TO COMMON INFO
	DCA I	NEXT		/ZERO NEXT PTR WORD
	TAD I	COMNAM		/LOOK FOR END OF LIST
	SNA
	JMP	EOCL		/THIS IS IT
	DCA	COMNAM		/PROCEED DOWN LIST
	JMP	.-4
EOCL,	TAD	NEXT		/HOOK IN NEXT PART
	DCA I	COMNAM
	TAD	NUMELM
	DCA I	NEXT		/NUMBER IN THIS PART
	TAD	NUMELM
	CIA
	DCA	NUMELM
	CDF
	TAD I	X12		/MOVE VARIABLE PTRS
	CDF	10
	DCA I	NEXT
	ISZ	NUMELM
	JMP	.-5
	CDF
	JMS I	[GETC		/ANOTHER BLOCK ?
	JMP I	[NEXTST		/NO
	JMP	COMMON+3	/MAYBE
DBLSLS,	JMS I	[CHECKC		/LOOK FOR SECOND SLASH
	-257
	JMP	BADCOM
	SKP
BLANKC,	JMS I	[BACK1		/PUT BACK NON SLASH
	TAD	(BLNKCN		/USE BLANK COMMON
	DCA	COMNAM
	JMP	DOCOMN
BADCOM,	JMS I	[ERMSG		/ERROR IN COMMON STMT
	0317
	JMP I	[NEXTST
COMNAM,	0
/ EXTERNAL, FORMAT, BACKSPACE
EXTERN,	JMS I	[TYPLST		/PROCESS LIST
	1000
	6660
	NOP
	JMP I	[NEXTST
FORMAT,	TAD	(FMTOPR		/OUTPUT FORMAT OPERATOR
	JMS I	[OUTWRD
	TAD	NCHARS		/GET NUMBER OF WORDS
	CIA
	CLL RAR			/NWORDS=(NCHARS+1)/2
FMTLUP,	JMS I	[OUTWRD		/OUTPUT IT
	JMS I	[GETCWB		/GET THE CHARS
	JMP I	[NEXTST		/NO MORE
	AND	[77
	CLL RTL			/SHIFT LEFT 6
	RTL
	RTL
	DCA	TEMP
	JMS I	[GETCWB		/GET OTHER HALF
	NOP			/IGNORE END OF LINE
	AND	[77
	TAD	TEMP		/PUT THEM TOGETHER
	JMP	FMTLUP		/LOOP
	/NOTE : THE ENTIRE FORMAT INCLUDING PARENTHESIS ()
	/	IS PASSED TO THE CODE
BACKSP,	JMS I	[CHECKC		/CHECK FOR &quot;E&quot;
	-305
	JMP I	[BADCMD
	JMS I	[EXPR		/COMPILE UNIT EXPR
	JMP I	[BADCMD
	TAD	(BAKOPR		/OUTPUT BACKSPACE OPERATOR
	JMS I	[OUTWRD
	JMP I	[NEXTST
/ OUTPUT ROUTINE
	PAGE
OUPTR,	OUBUF
OCOUNT,	-401
OUTWRD,	0			/OUTPUT ROUTINE
	DCA	OWTEMP		/SAVE WORD
	TAD	NOCODE
	SZA CLA
	JMP I	OUTWRD		/COOL IT IF NOCODE
	ISZ	OCOUNT		/TEST FOR BUFFER FULL
	JMP	NOWRIT		/STILL SOME ROOM
	JMS	OUDUMP		/DUMP THE BUFFER
	TAD	OUBLOK-1	/RESET BUFFER PARAMETERS
	DCA	OUPTR
	TAD	(-400
	DCA	OCOUNT
NOWRIT,	TAD	OWTEMP		/PUT WORD
	CDF	10
	DCA I	OUPTR		/INTO BUFFER
	CDF
	ISZ	OUPTR		/MOVE POINTER
	JMP I	OUTWRD
OULEN,	0			/NUMBER OF BLOCKS LEFT IN HOLE
OUDUMP,	0			/DUMP OUT BUFFER
	TAD	OULEN		/ANY ROOM LEFT ?
	SNA
	JMP	OUERR
	IAC
	DCA	OULEN
	JMS I	(7607		/CALL SYSTEM HANDLER
	4210
	OUBUF
OUBLOK,	0
	JMP	OUERR
	ISZ	OUBLOK		/INCREMENT BLOCK NUMBER
	ISZ	FILSIZ		/ALSO SIZE OF FILE
	JMP I	OUDUMP
OUERR,	JMS I	[MESSAG		/ERROR IN WRITING OR OPENING FILE
	317
	306
/ END PASS ONE
XEND,	JMS I	[CHECKC		/LOOK FOR &quot;D&quot;
	-304
	JMP I	[BADCMD
	JMS I	[GETC		/END MUST BE ALL
	JMP	ENDX
L7700,	SMA CLA			/NEVER SKIPS
	JMP I	[BADCMD
ENDX,	CDF 0
	TAD	(ENDOPR		/OUTPUT END OF FILE
	JMS I	[OUTWRD
	JMS	OUDUMP		/DUMP BUFFER
	CIF	10
	JMS I	L7700		/LOCK MONITOR IN
	10
	CIF	10
	CLA IAC
	JMS I	L200		/CLOSE TEMP FILE
	4
	TMPFIL
FILSIZ,	0
	JMP	OUERR
	CIF	10
	CLA IAC
	JMS I	L200		/OPEN PASS 2 OUTPUT FILE
L3,	3
OBLK,	TMPFIL+4		/STARTING BLOCK
	0			/SIZE
	JMP	OUERR		/ERROR
	TAD	(COMREG-1	/SAVE IMPORTANT STUFF
	DCA	X10
	TAD	NEXT		/ADDR OF FREE SPACE
	DCA I	X10
	TAD	STKLVL		/STACK LEVEL
	DCA I	X10
	TAD	OUFILE		/START OF PASS1 OUTPUT FILE
	DCA I	X10
	TAD	FILSIZ		/ALSO THE SIZE
	DCA I	X10
	TAD	PASS2O		/START OF PASS2 OVERLAY
	DCA I	X10
	TAD	OBLK		/START OF PASS2 OUTPUT FILE
	DCA I	X10
	TAD	OBLK+1		/AND MAX SIZE
	DCA I	X10
	TAD	PROGNM		/POINTER TO PROG NAME
	DCA I	X10
	TAD	ARGLST		/AND ARG LIST
	DCA I	X10
	TAD	FUNCTN		/AND PROG SWITCH
	DCA I	X10
	TAD	DPUSED		/STORE THE DP SWITCH
	DCA I	X10
	TAD	VERS		/AND THE VERSION NUMBER
	DCA I	X10
	CIF	10
	JMS I	L200		/CHAIN TO PASS TWO
	6
PASS2B,	0			/FILLED BY ONCE ONLY CODE FOR PASS 1
RETURN,	TAD	(RETOPR		/OUTPUT RETURN CODE
	JMS I	[OUTWRD
	ISZ	DOEND		/DO END ILLEGAL HERE
	JMP I	[NEXTST
COMARP,	0			/LOOK FOR COMMA OR RIGHT PAREN
	JMS I	[GETC
	JMP I	COMARP
	TAD	[-254		/COMMA ?
	SNA
	JMP	.+5
	TAD	L3		/RIGHT PAREN ?
	SZA CLA
	JMP I	COMARP
	ISZ	COMARP
	ISZ	COMARP		/COMMA INCR ONCE
	JMP I	COMARP
LOGICA,	JMS I	[CHECKC		/LOOK FOR L
	-314
	JMP I	[BADCMD		/NO GOOD
	JMS I	[TYPLST		/PROCESS LIST
	0105
	0100
L200,	0200			/NOP
	JMP I	[NEXTST
/ EQUIVALENCE (UGH!)
	PAGE
EQUIV,	JMS I	[IFCHEK		/BAD WITH IF
	JMS I	[CHECKC		/LOOK FOR &quot;E&quot;
	-305
	JMP I	[BADCMD
EQVLUP,	JMS I	[CHECKC		/LOOK FOR (
	-250
	JMP	BADEQU
	TAD	STACK		/SAVE STACK POS
	DCA	X17
	DCA	NSLAVE		/NUMBER OF SLAVES = 0
	JMS I	[GETSS		/GET THE MASTER
	JMP	BADEQU
SVMSTR,	CDF	10		/1.03/ CHECK FOR ALREADY EQUIVALENCED
	TAD I	TEMP2		/1.03/
	CDF			/1.03/
	AND	(200		/1.03/ (AS A SLAVE)
	SZA CLA			/1.03/
	JMP	DOFUNY	/3.01/BACK UP TO ITS MASTER
	TAD	TEMP2		/SAVE THE MASTER TYPE ADDRESS
	DCA	MASTER
	DCA	SFUDGE	/3.01/CLEAR OFFSET FUDGE
	TAD	DIMNUM		/SAVE THE MASTER SUBSCRIPT
	DCA	MNUM
GETSLV,	JMS I	[COMARP		/LOOK FOR , OR )
	JMP	BADEQU
	JMP	DOSLAV		/,
	TAD	NSLAVE		/COMPLEMENT THE NUMBER OF SLAVES
	SNA
	JMP	ENDGRP		/NO SLAVES
	CIA
	DCA	NSLAVE
	TAD	X17		/RESTACK THE STORE
	DCA	STACK
EQLOOP,	TAD I	X17		/GET NEXT SUBSCRIPT NUMBER
	DCA	TEMP
	TAD I	X17		/AND NEXT TYPE WORD ADDRESS
	DCA	TEMP2
	CDF	10
	TAD I	TEMP2		/LOOK AT TYPE WORD
	TAD	(200		/SET EQUIVALENCE BIT
	DCA I	TEMP2
	ISZ	TEMP2		/MOVE TO EQUIVALENCE/DIMENSION PTR
	TAD I	TEMP2		/PROPAGATE DIMENSION POINTER
	DCA I	NEXT		/TO EQUIVALENCE INFO BLOCK
	TAD	NEXT		/NOW STORE EQ INFO BLK ADDRESS
	DCA I	TEMP2		/INTO EQ-DIM POINTER WORD
	CLA CMA
	TAD	MASTER		/STORE S.T. ADDR OF MASTER
	DCA I	NEXT		/INTO THE EQUIVALENCE BLOCK
	TAD	MNUM		/OUTPUT NUMBERS
	DCA I	NEXT
	TAD	TEMP
	DCA I	NEXT
	CDF
	ISZ	NSLAVE		/ANY MORE SLAVES ?
	JMP	EQLOOP		/YES, EQUIVALENCE NOT YET ATTAINED
ENDGRP,	JMS I	[GETC		/FINI, ALL VARIABLES ARE CREATED
	JMP I	[NEXTST		/EQUIVALENCED
	TAD	(-254		/IS NEXT CHAR A COMMA ?
	SNA CLA
	JMP	EQVLUP		/IF YES, DO NEXT GROUP
BADEQU,	JMS I	[ERMSG		/SYNTAX ERROR IN EQUIVALENCE
	2123
	JMP I	[NEXTST
EQUCOM,	JMS I	[ERMSG		/MULTIPLE LEVELS OF EQUIVALENCE OR
	2114			/MORE THAN ONE COMMON VARIABLE
	JMP I	[NEXTST
DOSLAV,	ISZ	NSLAVE		/ANOTHER SLAVE VARIABLE
	JMS I	[GETSS		/GET THE GOODS
	JMP	BADEQU
	CDF	10
	TAD I	TEMP2		/LOOK AT THE TYPE
	SMA CLA
	JMP	SVSLAV		/IT ISN&#039;T IN COMMON
	TAD I	MASTER		/LOOK AT THE MASTERS TYPE
	SPA CLA
	JMP	EQUCOM		/MASTER IS IN COMMON TOO .. BAD
	CDF
	TAD	MNUM		/SAVE THE MAGIC NUMBER
	JMS I	[PUSH
	TAD	MASTER
	JMS I	[PUSH		/AND THE S.T. ADDRESS
	JMP	SVMSTR		/NOW GO MAKE THE NEW ONE MASTER
SVSLAV,	TAD I	TEMP2		/1.03/ PREVIOUSLY EQUIVALENCED ?
	AND	(200		/1.03/
	SZA CLA			/1.03/
	JMP	EQUCOM		/1.03/ YES, ERROR
	TAD	DIMNUM		/SAVE THE NEW SLAVE
	TAD	SFUDGE	/3.01/ADD OFFSET FUDGE
	CDF
	JMS I	[PUSH
	TAD	TEMP2
	JMS I	[PUSH
	JMP	GETSLV		/AND GO GET THE NEXT SLAVE

SFUDGE,	0
/ROUTINE TO HANDLE TRIVIAL CASES OF EQUIVALENCE CHAINING
/THIS WHOLE PAGE IS 3.01

DOFUNY,	CLA IAC
	TAD	TEMP2
	DCA	MASTER	/GET POINTER TO EQUIVALENCE BLOCK
	CDF 10
	TAD I	MASTER
	DCA	X12
	CLA IAC
	TAD I	X12	/GET ADDRESS OF &quot;REAL&quot; MASTER&#039;S
	DCA	MASTER	/TYPE WORD
	TAD I	X12
	TAD	DIMNUM
	DCA	MNUM	/OFFSETS ARE ADDITIVE
	TAD I	X12
	DCA	SFUDGE	/SAVE OTHER HALF OF OFFSET TO ADD
	CDF		/TO SLAVES
	JMP	GETSLV	/            (PRAY)
	PAGE
/ EQUIVALENCE (UGH!)
O1420,	1420		/1.03/ MUST BE FIRST ON PAGE
GETSS,	0		/GET THE LINEARIZED SUBSCRIPT
	DCA	DIMNUM
	JMS I	[GETNAM		/GET THE VARIABLE
	JMP I	GETSS
	JMS I	[LOOKUP
	IAC			/ADDRESS OF TYPE WORD
	DCA	TEMP2
	CDF	10
	TAD I	TEMP2
	CDF
O200,	AND	O1420		/1.03/ EXT, STMTFUN, SUBARG ?
	SZA CLA
	JMP I	GETSS
	TAD	STACK
	DCA	X12		/SAVE STACK POSITION
	DCA	TEMP		/ZERO NUMBER OF DIMENSIONS
	TAD	TEMP2
	IAC
	DCA	EQTEMP		/ADDRESS OF EQ-DIM POINTER
	JMS I	[GETC
	JMP I	GETSS
	TAD	(-250		/LOOK FOR (
	SNA CLA
	JMP	DIMGET-1	/OK
	JMS I	[BACK1
	JMP	RGETSS
	DCA	DIMNUM		/DATA CALLS GETSS WITH AC = 7777
DIMGET,	JMS I	(SMLNUM		/GET A SUBSCRIPT
	CLA CMA
	TAD	EXPON		/SS-1
	JMS I	[PUSH		/SAVE SS
	ISZ	TEMP		/BUMP COUNT OF SS
	JMS I	[COMARP		/LOOK FOR , OR )
	JMP I	GETSS
	JMP	DIMGET		/,
	CLA IAC			/)
	DCA	DPRDCT		/SET DIMENSION PRODUCT TO 1
	TAD	X12		/RESTORE STACK POSITION
	DCA	STACK
	TAD	TEMP		/COMPLEMENT NUMBER OF SS
	CIA
	DCA	TEMP
	CDF	10
	CLL CML RTR		/2000
	AND I	TEMP2		/HAS VARIABLE BEEN DIMENSIONED ?
	SNA CLA
	JMP I	GETSS		/NO, THATS BAD
	TAD I	EQTEMP		/GET ADDRESS OF DIMENSION BLOCK
	DCA	EQTEMP
	TAD I	EQTEMP		/IS NUMBER OF DIMENSIONS
	TAD	TEMP		/EQUAL TO NUMBER OF SUBSCRIPTS ?
	SZA CLA
	JMP	TRY1SS		/1.03/ SEE IF ITS ONE SUBSCRIPT
	CLA CLL IAC		/+1 V3C
	TAD I	EQTEMP		/+ NUMBER OF DIMENSIONS
	TAD	EQTEMP		/+ ADDRESS OF COUNT WORD
	DCA	EQTEMP		/GIVES ADDRESS OF NEXT TO LAST DIMENSION
LINEAR,	CDF
	TAD I	X12		/GET NEXT SS - 1
	DCA	MQ
	TAD	DPRDCT		/MULTIPLY BY THE DIMENSION PRODUCT
	JMS	MUL12		/WHERE D.P. = 1,D1,D1D2,D1D2D3,...
	TAD	DIMNUM		/ACCUMULATE THE SUM
	DCA	DIMNUM
	CDF	10
	TAD I	EQTEMP		/ADDR OF LITERAL
	IAC
	DCA	X11		/WORKING POINTER TO VALUE
	TAD I	X11		/GET DIMENSION INTO FAC
	DCA	WORD1
	TAD I	X11
	DCA	WORD2
	TAD I	X11
	DCA	WORD3
	CDF
	JMS I	[FIXNUM		/GO FIX IT
	DCA	MQ
	TAD	DPRDCT		/OF THE D.P. SERIES (ABOVE)
	JMS	MUL12
	DCA	DPRDCT
	CLA IAC			/V3C BUMP POSITION POINTER
	TAD	EQTEMP
	DCA	EQTEMP
	ISZ	TEMP		/ANY MORE SS ?
	JMP	LINEAR		/YES
RGETSS,	ISZ	GETSS
	JMP I	GETSS
TRY1SS,	CLA IAC			/1.03/
	TAD	TEMP		/1.03/ ONLY ONE SS ?
	SZA CLA			/1.03/
	JMP I	GETSS		/1.03/ MORE, THATS NO GOOD
	CDF			/1.03/
	TAD I	X12		/1.03/ GET THE SUBSCRIPT
	DCA	DIMNUM		/1.03/ AND RETURN IT
	JMP	RGETSS		/1.03/
MUL12,	0			/12 BIT UNSIGNED MULTIPLY
	DCA	OP2		/SAVE OPERAND
	TAD	(-15		/SET SHIFT COUNT
	DCA	SC
	JMP	STMUL
M12LUP,	TAD	AC
	SNL
	JMP	.+3
	CLL
	TAD	OP2
	RAR
STMUL,	DCA	AC
	TAD	MQ
	RAR
	DCA	MQ
	ISZ	SC
	JMP	M12LUP
	TAD	MQ		/RETURN VALUE
	JMP I	MUL12
	AC=OP3
	SC=OP4
/ IF STATEMENTS
	PAGE
IF,	JMS I	[EXPR		/COMPILE CONDITION EXPRESSION
	JMP I	[BADCMD
	JMS I	[STMNUM		/IS IT ARITHMETIC IF ?
	JMP	LOGIF
	TAD	(ARTHIF		/START IF COMMAND
	JMS I	[OUTWRD
	CLL CMA RTL
	DCA	TEMP
	ISZ	DOEND		/DO END ILLEGAL HERE
	JMP	IFLABL		/GET IF LABELS
IFLOOP,	JMS I	[CHECKC		/LOOK FOR ,
	-254
	JMP I	[NEXTST
	JMS I	[STMNUM		/GET NEXT STMT NUMBER
	JMP	BADIF
IFLABL,	TAD	SNUM		/OUTPUT LABEL
	JMS I	[OUTWRD
	ISZ	TEMP
	JMP	IFLOOP
	JMP I	[NEXTST
LOGIF,	JMS	IFCHEK		/IF()IF()... NOT LEGAL
	ISZ	IFSWIT		/CLEAR IF SWITCH
	TAD	(LIFBGN		/START LOGICAL IF
	JMS I	[OUTWRD
	JMP I	(COMPIL		/COMPILE THE STATEMENT
DOSWT,
IFCHEK,	0			/CHECK IF SWITCH
	TAD	IFSWIT
	SNA CLA
	JMP I	IFCHEK
BADIF,	JMS I	[ERMSG
	1111
	JMP I	[NEXTST
/ CALL STMT
CALL,	JMS I	[SAVECP		/SAVE CHAR POS
	JMS I	[GETNAM		/GET SUBROUTINE NAME
	JMP	BADCAL		/NO NAME HERE IS BAD
	JMS I	[LOOKUP		/GET ADDRESS OF TYPE WORD
	IAC
	DCA	TEMP
	CDF	10
	TAD I	TEMP		/LOOK AT TYPE
	AND	(6640		/ANYTHING BUT EXT OR ARG ?
	SZA CLA
	JMP	BADCAL		/YES, BAD
	TAD I	TEMP		/SET EXT BIT
	AND	(137		/LEAVE TYPE AND ARG BITS
	TAD	(1000
	DCA I	TEMP
	CDF
	JMS I	[RESTCP		/RESTORE CHAR POS
	CLA IAC			/SIGNAL THAT THIS IS A CALL
	JMS I	[LEXPR		/COMPILE IT
XSTORE,	DOSTOR			/DON&#039;T WORRY VIRGINIA, ITS A NOP
	TAD	OWTEMP		/WHAT WAS THE LAST THING OUT ?
	CLL
	TAD	(-63		/IF LESS THAN 63
	SNL CLA
	JMP I	[NEXTST		/IT WAS AN ARG COUNT
	TAD	[ARGSOP		/OTHERWISE IT WAS AN ARG LESS CALL
	JMS I	[OUTWRD		/SO TELL PASS 2 ABOUT IT
	JMS I	[OUTWRD
	JMP I	[NEXTST
BADCAL,	JMS I	[ERMSG
	2316
	JMP I	[NEXTST
/ DO DAH, DO DAH
DO,	JMS I	[IFCHEK		/IF(...)DO   IS ILLEGAL
	JMS I	[STMNUM		/LOOK FOR ENDING STMT NUMBER
	JMP I	[BADCMD
	JMS I	[GETNAM		/LOOKUP INDEX VARIABLE
	JMP I	[BADCMD
	JMS I	[LOOKUP
	DCA	DOINDX
	JMS I	[CHECKC		/LOOK FOR =
	-275
	JMP I	[BADCMD
	ISZ	DOEND		/CAN&#039;T END DO LOOP ON A DO
	JMS	DOSTUF		/GET DO PARAMETERS
	JMP	BADDO
	TAD	DOINDX		/PUSH DO INDEX
	JMS I	[PUSH
	TAD	SNUM		/PUSH ENDING STMT NUMBER
	JMS I	[PUSH
	TAD	STACK
	DCA	STKLVL		/SAVE NEW STACK BASE
	JMP I	[NEXTST

DOSTUF,	0			/SUBR FOR DO LOOP STUFF
	JMS I	[OUTWRD		/OUTPUT DO INDEX
	TAD	DOINDX
	JMS I	[OUTWRD
	JMS I	[EXPR		/GET EXPR FOR INITIAL VALUE
	JMP I	DOSTUF
	TAD	XSTORE		/YES
	JMS I	[OUTWRD
	JMS I	[CHECKC		/LOOK FOR COMMA
N254,	-254
	JMP I	DOSTUF
	JMS I	[EXPR		/GET EXPR FOR FINAL VALUE
	JMP I	DOSTUF
	JMS I	[GETC		/LOOK FOR A COMMA
	JMP	STEP1		/USE STEP OF 1
	TAD	N254
	SZA CLA
	JMP	STEP1-1
	JMS I	[EXPR		/GET EXPR FOR STEP
	JMP I	DOSTUF
DORET,	ISZ	DOSTUF
	TAD	(DOBEGN		/DO BEGIN OPERATOR
	JMS I	[OUTWRD
	JMP I	DOSTUF
	JMS I	[BACK1		/PUT BACK NON , (OFFICER BELOW LT.)
STEP1,	JMS I	[OUTWRD		/OUTPUT A PUSH 1.0
	TAD	(ONE
	JMS I	[OUTWRD
	JMP	DORET		/FINISH DO STUFF
BADDO,	JMS I	[ERMSG		/BAD DO COMMAND
	0417
	JMP I	[NEXTST
BDERR,	JMS I	[ERMSG		/ILLEGAL IN BLOCK DATA
	0223
	JMP I	[NEXTST
/ TYPE STATEMENT SUBROUTINE
	PAGE
TYPLST,	0			/HANDLE LIST FOR TYPE DELL
	TAD	STACK
	DCA	X12		/SAVE STACK POINTER
	DCA	NUMELM
	TAD I	TYPLST		/GET SET BITS
	DCA	SETBIT
	ISZ	TYPLST
	TAD I	TYPLST		/AND ILLEGAL BITS
	DCA	BADBIT
	ISZ	TYPLST
LSTLUP,	JMS I	[GETNAM		/GET VARIABLE
	JMP	BADLST
	JMS I	[LOOKUP		/S.T. SEARCH
	DCA	TLTEMP		/SAVE VAR ADDRESS
	TAD	TLTEMP		/PUT IT ON THE STACK
	ISZ	TLTEMP		/NOW POINT TO TYPE WORD
	JMS I	[PUSH		/INCREMENT NUMBER
	ISZ	NUMELM		/INCREMENT NUMBER
	CDF	10
	TAD I	TLTEMP		/COMPARE TYPES
	AND	BADBIT		/CHECK FOR ILLEGAL BITS
	SZA CLA
	JMP	TYPAGN		/ATTEMPT TO RE-TYPE
	TAD	SETBIT		/GET SET BITS
	CMA			/GENERATE MASK
	AND I	TLTEMP
	TAD	SETBIT		/DO THE SET
	DCA I	TLTEMP		/BUT NOT DIMENSION BIT
	CDF
GETDIM,	JMS I	[GETC
	JMP	EOL
	TAD	(-250		/LOOK FOR (
	SZA
	JMP	NOTDIM		/NOT DIMENSIONED
	CLA IAC			/INITIALIZE MAGIC NUMBER
	DCA	DSERES
	CLA IAC
	DCA	DPRDCT		/AND DIMENSION PRODUCT
	TAD	STACK
	DCA	X17		/SAVE STACK POINTER
	DCA	TEMP2		/DIMENSION COUNT=0
	JMP I	(DIMLUP		/GET DIMENSIONS
PUTDIM,	TAD	X17
	DCA	STACK		/RESTORE STACK
	CDF	10
	TAD	(3400		/DIM, EXT, SF ?
	AND I	TLTEMP
	SZA CLA
	JMP	DIMAGN		/ATTEMPT TP RE-DIMENSION
	CLL CML	RTR
	TAD I	TLTEMP		/SET DIMENSION BIT
	DCA I	TLTEMP
	ISZ	TLTEMP
	TAD	TEMP2		/NUMBER OF DIMS.
	DCA I	NEXT
	TAD I	TLTEMP		/GET EQUIVALENCE POINTER
	SZA
	DCA	TLTEMP
	TAD	NEXT		/STORE POINTER TO
	DCA I	TLTEMP		/DIMENSION INFORMATION
	TAD	DPRDCT		/SAVE DIM PRODUCT
	DCA I	NEXT
	TAD	DSERES		/AND MAGIC NUMBER
	DCA I	NEXT
	DCA I	NEXT		/ZERO MAGIC LITERAL POINTER
	TAD	TEMP2
	CIA
	DCA	TEMP2		/LEAVE LAST DIM
	CDF
MOVDIM,	TAD I	X17		/1.03/ GET THE DIMENSION
	CDF	10		/1.03/
	DCA I	NEXT		/1.03/ INTO THE DIMENSION INFO BLOCK
	CDF			/1.03/
	ISZ	TEMP2		/1.03/
	JMP	MOVDIM		/1.03/
NEXTEL,	JMS I	[GETC		/LOOK FOR ,
	JMP	TLRETN
	TAD	(-254
	SNA CLA
	JMP	LSTLUP		/OK, GET NEXT MEMBER
ENDLST,	JMS I	[BACK1
	ISZ	TYPLST
	JMP I	TYPLST
BADDIM,	JMS I	[ERMSG		/DIMENSION ERROR
	0204
	JMP I	TYPLST
BADLST,	JMS I	[ERMSG		/ERROR IN LIST
	2404
	JMP I	TYPLST
TYPAGN,	JMS I	[ERMSG
	2224			/RE-TYPE
	JMP	GETDIM
DIMAGN,	JMS I	[ERMSG		/ATTEMPT TO RE DIMENSION
	2204
	JMP	NEXTEL
NOTDIM,	TAD	(250-254	/IS IT A COMMA?
	SZA CLA
	JMP	ENDLST
	JMP	LSTLUP		/GET NEXT ELEMENT
EOL,
TLRETN,	ISZ	TYPLST
	JMP I	TYPLST		/TAKE OK EXIT
ENDFIL,	JMS I	[CHECKC		/LOOK FOR &quot;E&quot;
	-305
	JMP I	[BADCMD
	JMS I	[EXPR		/COMPILE UNIT
	JMP I	[BADCMD
	TAD	(ENDFOP		/OUTPUT ENDFILE OPERATOR
	JMS I	[OUTWRD
	JMP I	[NEXTST
DOUBLE,	JMS I	[CHECKC		/LOOK FOR N
	-316
	JMP I	[BADCMD
	
	JMS I	[IFCHEK		/NOT ON AN IF
	JMS I	[TYPLST		/PROCESS LIST
	0104
	0100
	NOP
	CLA IAC			/SET THE DP SWITCH
	DCA	DPUSED
	JMP I	[NEXTST
/ SYMBOL TABLE LOOKERUPPER
	PAGE
LOOKUP,	0			/SYMBOL TABLE LOOKUP FOR VARIABLE ENTRY
	TAD	NOCODE		/IS THIS IN NOCODE MODE ?
	SZA CLA
	JMP I	LOOKUP		/YES, DO NOTHING
	TAD	BUCKET
	TAD	(ALIST-1	/GET START OF CORRECT BUCKET
	CDF	10
LOOK,	DCA	OLDN3		/SAVE ADDR OF PREVIOUS ENTRY
	TAD I	OLDN3		/GET ADDR OF NEXT ENTRY
	SNA
	JMP	HOOKIN		/NO NEXT ENTRY, ATTACH NEW ENTRY
	TAD	(2		/SKIP OVER TYPE AND DIM POINTER
	DCA	X10
	TAD	(NAME1
	DCA	PNAME		/SETUP POINTER TO NAME
	CDF
CHKNAM,	TAD I	PNAME		/GET WORD NAME
	CIA CLL
	CDF	10
	TAD I	X10		/COMPARE WITH THIS ENTRY
	SZA CLA
	JMP	NOTSAM		/DIFFERENT
	CDF
	TAD I	PNAME
	AND	[77		/WAS THIS THE END OF NAME?
	ISZ	PNAME
	SZA CLA
	JMP	CHKNAM		/NO, KEEP COMPARING
	CDF	10
RLOOKU,	TAD I	OLDN3		/GET ADDR OF START OF ENTRY
	CDF			/AND RETURN IT IN THE AC
	JMP I	LOOKUP		/RETURN ADDR OF SYMBOL
NOTSAM,	SZL
	JMP	HOOKIN		/NEW SYMBOL &lt;CURRENT ONE
	TAD I	OLDN3
	JMP	LOOK		/CONTINUE SEARCH
HOOKIN,	TAD I	OLDN3		/HOOK NEW ENTRY INTO LIST
	DCA I	NEXT
	TAD	NEXT
	DCA I	OLDN3
	DCA I	NEXT		/ZERO TYPE WORD
	DCA I	NEXT		/ZERO EQUIVALENCE/DIMENSION POINTER
	TAD	(NAME1		/PREPARE TO STICK IN THE NAME
	DCA	PNAME
	CDF
ENTERN,	TAD I	PNAME		/MOVE NAME INTO S.T.
	CDF	10
	DCA I	NEXT
	CDF
	TAD I	PNAME
	ISZ	PNAME		/END OF NAME?
	AND	[77
	SZA CLA
	JMP	ENTERN		/NO, KEEP GOING
	CDF	10
STCHEK,	TAD	NEXT		/CHECK FOR S.T. OVERFLOW
	CIA CLL
	TAD	(4740		/5000 STARTS PASS2 SKELETON TABLES
	SZL CLA
	JMP	RLOOKU
	CDF
	JMS I	[ERMSG		/S.T. FULL
	2324
	JMP I	(ENDX		/TREAT AS END OF INPUT
OLDN3,	0			/ADDR OF PREVIOUS ENTRY
N3SIZE,	0			/SIZE OF ENTRY
LTEMP,
PNAME,				/POINTER TO NAME BUFFER
LUKUP2,	0			/LOOKUP FOR FIXED LENGTH SYMBOLS
	TAD I	LUKUP2		/GET THE BUCKET START
	DCA	OLDN3		/SAVE IT AS THE PREVIOUS ENTRY
	ISZ	LUKUP2
	TAD I	LUKUP2		/GET THE ENTRY SIZE
	ISZ	LUKUP2
	DCA	N3SIZE
	TAD	LUKUP2		/SAVE RETURN ADDR
	DCA	LOOKUP
	TAD	NOCODE		/IS CODE GENERATION OFF ?
	SZA CLA
	JMP I	LOOKUP		/YES, JUST RETURN
	CDF	10
LOOK2,	TAD I	OLDN3		/GET ADDR OF NEXT ENTRY
	SNA
	JMP	HOKIN2		/IF 0 ITS END OF LIST
	IAC
	DCA	X10		/START OF VALUE INFO
	TAD	(WORD1-1	/SETUP POINTER TO PROTOTYPE
	DCA	X11
	TAD	N3SIZE		/AND TEMP OF ENTRY SIZE
	DCA	LTEMP
CHKVAL,	CDF
	TAD I	X11
	CIA CLL			/COMPARE THIS WORD OF THE VALUE
	CDF	10
	TAD I	X10
	SZA CLA
	JMP	NOTSM2		/NOT THIS ONE
	ISZ	LTEMP		/INCR SIZE COUNT
	JMP	CHKVAL		/MORE STUFF
	JMP	RLOOKU		/RETURN WITH THE GOODS
NOTSM2,	SZL
	JMP	HOKIN2		/NEW SYMBOL &lt; CURRENT ONE
	TAD I	OLDN3		/CONTINUE SEARCH
	DCA	OLDN3
	JMP	LOOK2
HOKIN2,	TAD I	OLDN3		/HOOK NEW ENTRY INTO LIST
	DCA I	NEXT
	TAD	NEXT
	DCA I	OLDN3
	TAD	(WORD1-1	/PREPARE TO STICK IN THE VALUE
	DCA	X11
	DCA I	NEXT		/ZERO TYPE WORD
	CDF
ENTERV,	TAD I	X11		/MOVE VALUE INTO S.T.
	CDF	10
	DCA I	NEXT
	ISZ	N3SIZE		/INCR SIZE COUNT
	JMP	ENTERV-1
	JMP	STCHEK		/STORE TYPE AND CHECK FOR OVERFLOW
STOP,	TAD	(STOPOP		/OUTPUT STOP OPERATOR
	JMS I	[OUTWRD
	ISZ	DOEND		/DO ILLEGAL ON STOP
	JMP I	[NEXTST
/ EXPRESSION ANALYZER
	PAGE
EXPR,	0			/POLISHIZE EXPRESSION
	TAD	EXPR
	JMS I	[PUSH		/SAVE RETURN ADDR
	JMS I	[PUSH		/MARK STACK
UNOPR,	JMS I	[GETC		/LOOK FOR UNARY OPERATOR
	JMP	MISARG		/THERE HAS TO BE AN OPERAND
	TAD	(-253		/UNARY+(NOP)
	SNA
	JMP	UNOPR
	TAD	(253-255	/UNARY-
	SNA
	JMP	UMINUS
	TAD	(255-256	/.NOT.
	SZA CLA
	JMP	OPRAND
	DCA	BUCKET		/FOR CKNOT
	JMS I	(TRUFAL		/.TRUE. OR .FALSE. ?
	JMP	CKNOT		/NEITHER, IS IT &gt;.NOT.
	JMP	.+3		/.TRUE.
	TAD	(NOTOPR		/FALSE=.NOT.TRUE
	JMS I	[PUSH
	JMS I	[OUTWRD
	TAD	(TRUE
	JMS I	[OUTWRD
	JMP I	(NOSS
CKNOT,	TAD	BUCKET
	TAD	(-16
	SZA CLA
	JMP	OPRAND		/MIGHT BE LITERAL .XXXXXX
	TAD	(NOTOPR		/PUSH .NOT. OPERATOR
	JMS I	[PUSH
	JMP	UNOPR
UMINUS,	TAD	(UMOPR		/PUSH UNARY MINUS
	JMS I	[PUSH
	JMP	UNOPR
OPRAND,	JMS I	[BACK1		/PUT BACK NON UNARY OPERATOR
	JMS I	[GETNAM		/LOOK FOR VARIABLE REFERENCE
	JMP	NOTVAR		/NOPE.
	JMS I	[LOOKUP		/SYMBOL TABLE SEARCH
	JMP I	[OPR8R		/GO OUTPUT PUSH-VAR
NOTVAR,	JMS I	[NUMBER		/LOOK FOR A LITERAL
	JMP	NOTNUM		/NO KIND OF NUMBER
	JMP	HOLCHK		/INTEGER
	JMP	DPLIT		/DOUBLE PRECISION
FPLIT,	JMS I	[LUKUP2		/FLOATING, ENTER INTO TABLE
	FPLIST
	-3
	JMP I	[OPR8RL		/PUSH VARIABLE, NO SUBSCRIPTS
DPLIT,	JMS I	[LUKUP2		/DOUBLE-PREC., ENTER IN TABLE
	DPLIST
	-6
	JMP I	[OPR8RL
HOLCHK,	JMS I	[GETC		/IS THIS HOLLERITH?
	JMP	.+5
	TAD	(-310
	SNA CLA
	JMP I	(HFIELD		/YES
	JMS I	[BACK1
	JMS I	[LUKUP2		/FIND THE ENTRY
	INTLST
	-3
	JMP I	[OPR8RL
NOTNUM,	JMS I	[GETC		/LOOK FOR COMPLEX LITERAL
	JMP	MISARG		/MISSING OPERAND
	TAD	(-250		/OPEN PAREN?
	SZA
	JMP	QUOTE		/GO LOOK FOR A STRING
	JMS I	[SAVECP		/SAVE CHAR POSITION
	JMS I	[NUMBER		/GET REAL PART
	JMP I	(NCMPLX		/NO NUMBER
	SKP			/INTEGER-OK
	JMP I	(NCMPLX		/DOUBLE-NOT LEGAL FOR COMPLEX
	JMS I	[CHECKC		/LOOK FOR ,
	-254
	JMP I	(NCMPLX		/NO, CAN&#039;T BE COMPLEX LIT.
	TAD	WORD1		/SAVE REAL PART
	DCA	TEMP
	TAD	WORD2
	DCA	TEMP2
	TAD	WORD3
	DCA	CHAR
	JMS I	[NUMBER		/GET IMAGINARY PART
	JMP	BADCL		/NOT THERE, BAD
	SKP			/I
	JMP	BADCL		/D-BAD
	JMS I	[CHECKC		/LOOK FOR )
	-251
	JMP	BADCL		/NO ) BAD
	TAD	WORD1		/PUT IMAGINARY PART
	DCA	WORD4
	TAD	WORD2		/INTO SECOND AHLF
	DCA	WORD5
	TAD	WORD3		/OF COMPLEX LITERAL
	DCA	WORD6
	TAD	TEMP		/NOW RESTORE REAL PART
	DCA	WORD1
	TAD	TEMP2
	DCA	WORD2
	TAD	CHAR
	DCA	WORD3
	CLL CMA RAL		/REMOVE CHAR POS FROM STACK
	TAD	STACK		/SINCE OTHERWISE IT GOES OUT
	DCA	STACK		/AS CODE
	JMS I	[LUKUP2		/WHICH WE WILL NOW SEARCH
	CMPLST			/USE COMPLEX LIST
	-6
	JMP I	[OPR8RL
BADCL,	JMS I	[ERMSG		/BAD COMPLEX LITERAL
	0314
	JMP I	[BADEXP
MISARG,	JMS I	[ERMSG		/MISSING OPERAND
	1517
	JMP I	[BADEXP
/ EXPRESSION ANALYZER
	PAGE
HQUOTE,	0			/SUBR FOR QUOTE STRINGS
	JMS I	[GETCWB		/GET CHAR
	JMP	BADH
	TAD	[-247		/IS IT &#039;
	SZA
	JMP	NOTQ2		/NO
	JMS I	[GETCWB
	JMP	LUHOL
	TAD	[-247		/LOOK FOR &#039;&#039;
	SNA CLA
	JMP	NOTQ2		/REPLACE &#039;&#039; BY &#039;
	JMS I	[BACK1		/ITS END OF STRING
	JMP	LUHOL
NOTQ2,	TAD	[247		/RESTORE CHAR
	AND	[77
	JMP I	HQUOTE
HFIELD,	JMS I	[FIXNUM		/INTEGERIZE NUMBER
	SNA
	JMP	BADH		/ZERO IS BAD
	CMA CLL
	DCA	TEMP
	TAD	(HCOUNT		/SET SUBR POINTER
DOHOL,	DCA	HCHAR
	TAD	(-MAXHOL	/SET COUNTER FOR MAX
	DCA	HOLCTR
	TAD	(NAME1		/SET UP NAME POINTER
	DCA	TEMP2
PAKHOL,	DCA I	TEMP2		/PACK HOLLERITH STRING
	JMS I	HCHAR
	CLL RTL
	RTL
	RTL
	DCA I	TEMP2
	JMS I	HCHAR
	TAD I	TEMP2
	DCA I	TEMP2
	ISZ	TEMP2
	ISZ	HOLCTR		/CHECK FOR TOO MANY
	JMP	PAKHOL
BADH,	JMS I	[ERMSG		/BAD OR TOO BIG HOLLERITH FIELD
	1017
	JMP I	[BADEXP
LUHOL,	TAD	(33		/LOOK UP THIS LITERAL
	DCA	BUCKET
	JMS I	[LOOKUP
	JMP I	[OPR8RL
HCOUNT,	0
	ISZ	TEMP		/CHECK COUNT
	SKP
	JMP	LUHOL		/EXPIRED
	JMS I	[GETCWB		/GET CHAR
	JMP	BADH
	AND	[77		/6-BIT IZE IT
	JMP I	HCOUNT
HOLCTR,	0			/COUNTER FOR HOLLERITH FIELDS
NCMPLX,	JMS I	[RESTCP		/NOT COMPLEX LITERAL
	JMS I	[EXPR		/MUST BE SUB EXPRESSION
	JMP	BADEXP
	JMS I	[GETC		/LOOK FOR )
	JMP	PARMM
	TAD	(-251
	SNA CLA
	JMP I	(NOSS		/NO SUBSCRIPT LEGAL AFTER SUB EXPR
PARMM,	JMS I	[ERMSG		/MISSING )
	1515
BADEXP,	JMS I	[POP		/BAD EXPRESSION,
	SZA CLA
	JMP	BADEXP		/LOOK FOR STACK MARKER
	JMS I	[POP
	DCA	TEMP		/RETURN ADDR.
	JMP I	TEMP
	JMS I	[BACK1		/PUT BACK TEMINAL CHAR
ENDEXP,	JMS I	[POP		/GET NEXT THING FROM STACK
	SNA
	JMP	EXPDUN		/IF ZERO, FINISH
	IAC			/GET ADDR OF OPERATION NUMBER
	DCA	TEMP
	TAD I	TEMP		/GET OPERATOR VALUE
	JMS I	[OUTWRD		/OUTPUT OPERATOR XXXXXX
	JMP	ENDEXP		/LOOP
EXPDUN,	JMS I	[POP		/GET RETURN ADDR
	IAC
	DCA	TEMP
	JMP I	TEMP
LETTER,	0			/GET A LETTER
	JMS I	[GETC
	JMP I	LETTER
	TAD	(-301
	SPA
	JMP	NLETR
	TAD	(301-333
	SMA
	JMP	NLETR
	TAD	(33
	ISZ	LETTER
	JMP I	LETTER
NLETR,	JMS I	[BACK1
	JMP I	LETTER
QUOTE,	TAD	(250-247	/IS IT &#039;
	SZA
	JMP	MISARG		/NO, OPERAND IS MISSING
	TAD	(HQUOTE		/SET SUBR POINTER
	JMP	DOHOL
CHECKC,	0			/CHECK FOR A SINGLE CHAR
	TAD I	CHECKC		/GET THE CHAR
	DCA	CCTEMP
	ISZ	CHECKC		/SKIP PAST THE CHAR
	JMS I	[GETC		/GET CHAR FROM INPUT
	JMP I	CHECKC		/DIDN&#039;T MAKE IT
	TAD	CCTEMP		/IS THIS IT ?
	SNA CLA
	ISZ	CHECKC		/YES
	JMP I	CHECKC
CCTEMP,	0
/ EXPRESSION ANALYZER
	PAGE
BADFSS,	JMS I	[ERMSG
	2323
	JMP I	[BADEXP
OPR8R,	DCA	TEMP
	JMS I	[OUTWRD		/PUSH
	TAD	TEMP
	JMS I	[OUTWRD		/OUTPUT OPERAND PTR
	JMS I	[GETC
	JMP I	[ENDEXP
	TAD	(-250		/IS IT S.S. OR FUNCTION
	SZA
	JMP	NOTFSS
	TAD	STMJMP
	TAD	(-DFINFL
	SNA	CLA		/FOR D.F.,PERMIT VARPARENS
	JMP	NOTFSS
	ISZ	TEMP		/LOOK AT TYPE
	CDF	10
	TAD	(3420		/DIM, EXT, SF, OR ARG ?
	AND I	TEMP
	SZA CLA
	JMP	NOTFUN		/NOT A FUNCTION REFERENCE
	TAD I	TEMP
	TAD	(1000		/SET EXT BIT
	DCA I	TEMP
NOTFUN,	CDF
	SKP
	JMS I	[POP		/PUT COUNT INTO AC
SSFUN,	IAC			/INCREMENT ARG COUNT
	JMS I	[PUSH		/SAVE IT ON THE STACK
	JMS I	[EXPR		/GET ARG (OR S.S.)
	JMP I	[BADEXP
	JMS I	[COMARP		/LOOK FOR , OR )
	JMP	BADFSS		/NEITHER
	JMP	SSFUN-1		/, GET NEXT ARG (SUBSCRIPT?)
	TAD	(ARGSOP		/YES, OUTPUT ARGLIST OPER
	JMS I	[OUTWRD
	JMS I	[POP		/AND THE COUNT
	JMS I	[OUTWRD
NOSS,	JMS I	[GETC		/GET NEXT CHAR
	JMP I	[ENDEXP
	TAD	(-253		/PREPARE IT
	JMP	NOTFSS+1
OPR8RL,	DCA	TEMP		/SAVE ADDR OF LITERAL
	JMS I	[OUTWRD
	TAD	TEMP
	JMS I	[OUTWRD
	JMP	NOSS
/ TYPLST PART TWO
DIMLUP,	JMS I	[NUMBER		/GET DIMENSION
	JMP	VARDIM		/MAYBE ITS VAR DIM ?
	JMP	.+3		/OK, INTEGER
	JMP	BADDIM
	JMP	BADDIM		/DP AND FP ARE BAD
	JMS I	[FIXNUM		/FIX IT FOR SOME STUFF
	DCA	MQ
	TAD	DPRDCT		/GET NEW DIMENSION PRODUCT
	JMS I	[MUL12
	DCA	DPRDCT
	ISZ	TEMP2		/INCREMENT DIM COUNT
	TAD	WORD2		/IF WORD2 OR AC NON ZERO
	TAD	AC		/DIM IS TOO BIG 
	SZA CLA			/1.03/
	JMP	BADDIM		/1.03/
	JMS I	(ANORM		/1.03/ RENORMALIZE THE NUMBER
	JMS I	[LUKUP2		/1.03/ ENTER IT INTO LITERAL LIST
	INTLST			/1.03/
	-3			/1.03/
PSHDIM,	JMS I	[PUSH		/1.03/ AND SAVE ON THE STACK
	JMS I	[COMARP		/LOOK FOR , OR )
	JMP	BADDIM
	SKP			/COMMA MEANS ANOTHER DIM FOLLOWS
	JMP	PUTDIM		/) MEANS END OF DIMS
	TAD	DSERES		/FORM NEXT VALUE OF MAGIC NUMBER
	TAD	DPRDCT
	DCA	DSERES
	JMP	DIMLUP		/NOW LOOP FOR NEXT DIM
VDTEMP,	0
VARDIM,	CDF	10		/IS ARRAY AN ARG ?
	TAD I	TLTEMP
	CDF
	AND	(20
	SNA CLA
	JMP	BADDIM		/NO, BAD DIMENSION
	JMS I	[GETNAM		/OK, GET DIMENSION
	JMP	BADDIM
	JMS I	[LOOKUP
	IAC
	DCA	VDTEMP		/ADDR OF TYPE WORD
	CDF	10		/IS THA VARIABLE AN ARG ?
	TAD I	VDTEMP
	AND	(20
	CDF
	SNA CLA
	JMP	BADDIM		/NO, THATS BAD
	DCA	DPRDCT		/3.02 ZERO DIM PRODUCT
	ISZ	TEMP2		/INCREMENT DIM COUNT
	CMA			/1.03/
	TAD	VDTEMP		/1.03/ SAVE DIMENSION VARIABLE
	JMP	PSHDIM		/3.02 SAVE DIM ON STACK
MESSAG,	0			/PRINT PASS1 IMMEDIATE ERROR
	TAD I	MESSAG		/GET CHAR ONE
	ISZ	MESSAG
	JMS I	(TTYOUT
	TAD I	MESSAG		/GET CHAR TWO
	JMS I	(TTYOUT
	TAD	(215		/CR
	JMS I	(TTYOUT
	TAD	(212		/LF
	JMS I	(TTYOUT
	JMP I	(7605		/EXIT TO MONITOR
/ EXPRESSION ANALYZER REVISITED
	PAGE
NOTFSS,	TAD	(250-253	/IS IT +
	SZA
	JMP	.+3
	TAD	(ADDOPR		/YES
	JMP	GOTOPR
	TAD	(253-255	/IS IT -
	SZA
	JMP	.+3
	TAD	(SUBOPR		/YES
	JMP	GOTOPR
	TAD	(255-252	/IS IT *
	SZA
	JMP	NOTMUL		/NO
	JMS I	[GETC
	JMP	NOTEXP
	TAD	(-252		/IS IT **
	SZA CLA
	JMP	.+3
	TAD	(EXPOPR		/YES
	JMP	GOTOPR
	JMS I	[BACK1
NOTEXP,	TAD	(MULOPR		/IT WAS *
	JMP	GOTOPR
NOTMUL,	TAD	(252-257	/IS IT /
	SZA
	JMP	.+3
	TAD	(DIVOPR		/YES
	JMP	GOTOPR
	IAC			/IS IT .
	SZA CLA
	JMP I	(ENDEXP-1	/NO, END OF EXPR
	JMS	CKEOPR		/LOOK FOR EXTENDED OPERATOR
	JMP	BADOPR		/NONE THERE
	JMS I	[CHECKC		/CHECK FOR CLOSING .
	-256
	JMP	BADOPR		/NOT THERE
	CDF 10		/3.01/
	TAD I	X10		/GET OPERATOR POINTER
	CDF
	JMP	GOTOPR
CKEOPR,	0			/CHECK FOR EXTENDED OPERATOR
	JMS I	[GETNAM		/GET NAME
	JMP I	CKEOPR		/NONE
	TAD	(OPRLST-1	/PTR TO LIST
	DCA	X10
OPRLUP,	CDF 10		/3.01/
	TAD I	X10		/COMPARE FIRST CHAR
	CDF 0
	SNA
	JMP I	CKEOPR		/END OF LIST
	TAD	BUCKET
	SZA CLA
	JMP	NOTHIS		/NOT THIS ONE
	CDF 10		/3.01/
	TAD I	X10
	CDF
	TAD I	(NAME1		/COMPARE 2ND AND 3RD
	SZA CLA
	JMP	NOTHIS+1	/NOT THIS ONE
	ISZ	CKEOPR		/BUMP RETURN
	JMP I	CKEOPR
NOTHIS,	ISZ	X10		/BUMP LIST PTR
	ISZ	X10		/AGAIN
	JMP	OPRLUP		/KEEP GOING
BADOPR,	JMS I	[ERMSG		/NOT LEGAL EXT. OPER.
	1720
	JMP I	[BADEXP
GOTOPR,	DCA	NEWOP		/SAVE NEWEST OPER.
	JMS I	[POP		/GET STACK TOP
	SNA
	JMP	PUSH2		/EMPTY
	DCA	OLDOP
	TAD I	OLDOP		/COMPARE PREC.
	CIA
	TAD I	NEWOP		/NEW-OLD
	SPA SNA	CLA
	JMP	OUTOLD		/OLD&gt;NEW
	TAD	OLDOP
PUSH2,	JMS I	[PUSH		/OLD &lt; NEW
	TAD	NEWOP		/GO PUSH BOTH
	JMS I	[PUSH
	JMP I	(UNOPR		/GO LOOK FOR NEXT OPERAND
OUTOLD,	ISZ	OLDOP		/OUTPUT OPERATOR
	TAD I	OLDOP
	JMS I	[OUTWRD
	JMP	GOTOPR+1	/TRY NEXT STACK ELEMENT
	NEWOP=WORD1
	OLDOP=WORD2
/ UTILITIES
GETCWB,	0			/GET A CHARACTER (PRESERVE BLANKS)
	ISZ	NCHARS
	JMP	.+4
	CLA CMA
	DCA	NCHARS		/RESET NCHARS
	JMP I	GETCWB
	ISZ	GETCWB
	TAD I	CHRPTR		/GET THE CHAR
	JMP I	GETCWB
SAVECP,	0			/SAVE CHAR POSITION
	TAD	NCHARS
	JMS I	[PUSH
	TAD	CHRPTR
	JMS I	[PUSH
	JMP I	SAVECP
FIXNUM,	0			/FIX FAC (I&#039;M MOVING IT AGAIN)
	TAD	WORD1		/IS IT FIXED ?
	TAD	(-27
	SNA
	JMP	RETFN		/YES, EXPONENT IS 23
	SMA CLA
	JMP I	FIXNUM		/BAD IF EXP IS &gt;23
	JMS I	(AR1		/RIGHT SHIFT ONE
	JMP	FIXNUM+1	/TEST AGAIN
RETFN,	TAD	WORD3		/RETURN LOWEST 12 BITS
	JMP I	FIXNUM
/ UTILITIES
	PAGE
GETC,	0			/GET A CHARACTER (IGNORING BLANKS)
	ISZ	NCHARS
	JMP	.+4
	CLA CMA
	DCA	NCHARS
	JMP I	GETC
	TAD I	CHRPTR
	TAD	(-240		/IS IT A BLANK
	SNA
	JMP	GETC+1		/YES IGNORE IT
	TAD	(240		/FIX CHAR
	ISZ	GETC
	JMP I	GETC
ERMSG,	0			/ERROR MESSAGE HANDLER
	CDF
	TAD	NOCODE		/IS CODE GENERATION ON ?
	SZA CLA
	JMP	NOTOUT		/NO
	TAD	(ERRCOD		/ERROR CODE TO OUTPUT FILE
	JMS I	[OUTWRD
	TAD I	ERMSG
	ISZ	ERMSG
	JMS I	[OUTWRD
	JMP I	ERMSG		/RETURN
NOTOUT,	TAD I	ERMSG		/SAVE THE ERROR CODE
	ISZ	ERMSG
	DCA	ERCODE
	JMP I	ERMSG
POP,	0			/PUT TOP OF STACK INTO AC
	TAD	STACK
	DCA	ERMSG
	CLA CMA
	TAD	STACK
	DCA	STACK		/DECREMENT STACK POINTER
	TAD I	ERMSG
	JMP I	POP
TRUFAL,	0			/CHECK FOR LOGICAL LITERALS
	JMS I	[GETNAM
	JMP I	TRUFAL
	JMS I	[CHECKC		/LOOK FOR TERMINAL .
	-256
	JMP I	TRUFAL
	TAD	BUCKET		/LOOK AT FIRST CHAR
	TAD	(-24
	SNA
	JMP	.+5		/ITS &quot;T&quot;
	TAD	(24-6
	SZA CLA
	JMP I	TRUFAL		/ITS NEITHER
	ISZ	TRUFAL		/ITS &quot;F&quot;
	ISZ	TRUFAL
	JMP I	TRUFAL
/ LEFT HALF EXPRESSION ANALYZER
LEXPR,	0			/GET LEFT HAND EXPRESSION
	DCA	LETEMP		/SAVE CALL SWITCH
	JMS I	[GETNAM		/LOOK FOR VAR NAME
	JMP	MSNGOP		/MUST BE THERE
	JMS I	[OUTWRD		/OUTPUT A ZERO (PUSH)
	JMS I	[LOOKUP		/SEEK OUT ENTRY FOR THIS VAR
	DCA	TEMP
	TAD	TEMP
	JMS I	[OUTWRD
	JMS I	[GETC		/LOOK FOR DIMENSIONS
	JMP	LEXPOK		/NO (
	TAD	(-250
	SZA CLA
	JMP	LEXPOK-1	/NO (
	ISZ	TEMP		/LOOK AT TYPE
	CDF	10
	CLL CML RTR		/DIMENSIONED ?
	AND I	TEMP
	TAD	LETEMP		/OR A CALL ?
	TAD	NOCODE		/OR CODE OFF ?
	SZA CLA
	JMP	NOTSF		/YES, NOT AN ARITHMETIC S.F.
	TAD I	TEMP
	AND	(1420		/EXT, SF, OR ARG ?
	SNA CLA			/V3C
	TAD	[-M6		/SEE IF CALLED FROM SPECIAL PLACE
	TAD	LEXPR		/V3C  COMPARE WITH ENTRY PT
	SZA CLA
	JMP	ASFERR		/THIS IS BAD IF SO
	TAD I	TEMP
	TAD	(400
	DCA I	TEMP		/SET A.S.F. BIT
	CDF
	TAD	(ASFDEF		/DEFINE ASF
	JMS I	[OUTWRD
NOTSF,	CDF
	SKP
	JMS I	[POP		/ARG COUNT TO AC
SSLOOP,	IAC			/INCREMENT SS COUNT
	JMS I	[PUSH		/SAVE ON THE STACK
	JMS I	[EXPR		/COMPILE SUBSCRIPT
	JMP	FSSBAD+2	/ERROR WITHIN SS
	JMS I	[COMARP		/LOOK FOR , OR )
	JMP	FSSBAD		/NEITHER (THERE WAS A BUG HERE)
	JMP	SSLOOP-1	/, GET NEXT ARG/SS
	TAD	(ARGSOP		/OUTPUT SS OPERATOR
	JMS I	[OUTWRD
	JMS I	[POP		/THEN COUNT
	JMS I	[OUTWRD
	SKP
	JMS I	[BACK1		/PUT BACK A CHARACTER
LEXPOK,	ISZ	LEXPR
	JMP I	LEXPR		/RETURN
MSNGOP,	JMS I	[ERMSG		/MISSING OPERAND
	1517
	JMP I	LEXPR
FSSBAD,	JMS I	[ERMSG		/MISSING COMMA OR CLOSE PARENTHESIS
	2323
	JMS I	[POP		/GET ARG COUNT OFF STACK
	CLA
	JMP I	LEXPR
ASFERR,	JMS I	[ERMSG		/BAD ARITHMETIC STMT FUNCTION
	2306
	JMP	NOTSF		/DO THE REST OF THE ASF DEF
LETEMP,	0
/UTILITIES
	PAGE
G2CTMP,
PUSH,	0			/PUT AC ONTO STACK
	DCA I	STACK		/STORE
	TAD	(STACKS+100	/CHECK FOR STACK OVERFLOW
	CIA CLL
	TAD	STACK
	SNL CLA
	JMP I	PUSH		/OK, RETURN
	DCA	NOCODE		/SET CODE GENERATION ON
	JMS I	[ERMSG
	2004
	JMP I	[NEXTST
GET2C,	0			/GET 2 SIX BIT CHARS INTO ONE WPRD
	JMS I	[GETC		/GET FIRST CHAR
	JMP I	GET2C
	AND	[77
	CLL RTL
	RTL
	RTL
	DCA	G2CTMP
	JMS I	[GETC		/GET SECOND CHAR
	JMP I	GET2C
	ISZ	GET2C		/FIX RETURN ADDR
	AND	[77
	TAD	G2CTMP
	JMP I	GET2C
STMNUM,	0			/PICK UP STATEMENT NUMBER
	DCA	WORD4		/SAVE DEFINED BIT (IF ANY)
	DCA	WORD2		/ZERO SOME STUFF
	DCA	WORD3
	JMS	DIGIT		/GET A DIGIT
	JMP I	STMNUM		/NONE THERE, NO STMT NUMBER
	TAD	(-60		/IS IT A LEADING 0 ?
	SNA
	JMP	.-4		/YES, IGNORE IT
	TAD	(60
	CLL RTL
	RTL
	RTL
	DCA	WORD1
	JMS	DIGIT		/GET SECOND DIGIT
	JMP	ENDNUM		/END OF NUMBER
	TAD	WORD1
	DCA	WORD1		/COMBINE FIRST AND SECOND
	JMS	DIGIT
	JMP	ENDNUM
	CLL RTL
	RTL
	RTL
	DCA	WORD2
	JMS	DIGIT
	JMP	ENDNUM		/COMBINE THIRD AND FOURTH
	TAD	WORD2
	DCA	WORD2
	JMS	DIGIT		/GET FIFTH DIGIT
	JMP	ENDNUM
	CLL RTL
	RTL
	RTL
	DCA	WORD3
ENDNUM,	JMS I	[LUKUP2		/LOOK UP IN S.T.
	SNLIST			/STMT NUMBER LIST
	-3
	ISZ	STMNUM
	DCA	SNUM		/SAVE S.T. ADDRESS OF LABEL
	CDF	10		/SET TYPE WORD
	TAD	SNUM		/GET ADDR OF TYPE
	IAC
	DCA	SNTEMP
	TAD I	SNTEMP		/GET TYPE WORD
	CLL
	TAD	WORD4		/PUT IN THE DEFINITION BIT
	SNL
	DCA I	SNTEMP		/RESTORE IT IF NOT MULTIPLE DEFN
	CDF
	SNL CLA
	JMP I	STMNUM
	JMS I	[ERMSG
	1514
	JMP I	STMNUM
SNTEMP,
DIGIT,	0			/GET A DIGIT
	JMS I	[GETC		/GET A CHAR
	JMP I	DIGIT
	TAD	(-272		/IS IT &gt; 271 (9)
	SMA
	JMP	NODIGT		/YES, ITS GREATER
	TAD	(272-260	/IS IT &lt; 260 (0)
	SPA
	JMP	NODIGT		/YES, ITS LESS
	TAD	(60
	ISZ	DIGIT
	JMP I	DIGIT		/TAKE SUCCESSFUL RETURN
NODIGT,	JMS I	[BACK1		/RESTORE NON DIGIT
	JMP I	DIGIT
ASSIGN,	JMS I	[STMNUM		/GET STMT NUMBER
	JMP	BADASN
	JMS I	[GET2C		/LOOK FOR &quot;TO&quot;
	JMP	BADASN
	TAD	(-2417
	SNA CLA
	JMS I	[LEXPR		/GET ASSIGN VARIABLE
	JMP	BADASN
	TAD	(ASNOPR		/OUTPUT ASSIGN OPERATOR
	JMS I	[OUTWRD
	TAD	SNUM		/NOW STMT NUMBER
	JMS I	[OUTWRD
	JMP I	[NEXTST
BADASN,	JMS I	[ERMSG
	0123
	JMP I	[NEXTST
TTYOUT,	0			/TTY OUTPUT ROUTINE
	TLS
	TSF
	JMP	.-1
	CLA
	JMP I	TTYOUT
/ PRECEDENCE TABLE
	PAGE
ADDOPR,	100
	1
SUBOPR,	100
	2
MULOPR,	200
	3
DIVOPR,	200
	4
EXPOPR,	500
	5
NOTOPR,	30
	6
UMOPR,	400
	7
EQOPR,	40
	16
NEOPR,	40
	17
GEOPR,	40
	10
GTOPR,	40
	11
LEOPR,	40
	12
LTOPR,	40
	13
ANDOPR,	20
	14
OROPR,	10
	15
XOROPR,	7
	20
EQVOPR,	7
	21
/ UTILITY ROUTINES
BACK1,	0			/BACK UP ONE CHAR
	CLA CMA
	TAD	NCHARS
	DCA	NCHARS
	CLA CMA
	TAD	CHRPTR
	DCA	CHRPTR
	JMP I	BACK1
OADD,	0			/ADD OPERAND TO FAC
	CLL
	TAD	OPO
	TAD	ACO
	DCA	ACO
	RAL
	TAD	OP6
	TAD	WORD6
	DCA	WORD6
	RAL
	TAD	OP5
	TAD	WORD5
	DCA	WORD5
	RAL
	TAD	OP4
	TAD	WORD4
	DCA	WORD4
	RAL
	TAD	OP3
	TAD	WORD3
	DCA	WORD3
	RAL
	TAD	OP2
	TAD	WORD2
	DCA	WORD2
	JMP I	OADD
/ FLOATING POINT DIVIDE ROUTINE
	PAGE
FPDIV,	0
	JMS I	DAR1		/UNNORMALIZE AC BY ONE
	TAD	OP1		/COMPUTE FINAL EXPONENT
	CIA
	TAD	WORD1
	DCA	OP1		/AND SAVE IT
	TAD	DM74		/SET ITERATION COUNTER
	DCA	DITCNT
	TAD	WORD2
	RAL			/INITIALIZE LINK
FPDVLP,	CLA RAR			/COMPARE SIGNS
	TAD	OP2
	SPA CLA
	JMP	.+3
	TAD	OPMAC		/NEGATE OPERAND
	JMS I	DFNEG
	JMS I	DOADD		/ADD OPERAND AND FAC
	TAD	D6		/RIGHT SHIFT QUOTIENT
	RAL			/PRESERVING ADD OVERFLOW BIT
	DCA	D6
	TAD	D5
	RAL
	DCA	D5
	TAD	D4
	RAL
	DCA	D4
	TAD	D3
	RAL
	DCA	D3
	TAD	D2
	RAL
	DCA	D2
	JMS I	DAL1		/LEFT SHIFT FAC ONE
	ISZ	DITCNT		/TEST ITERATION COUNT
	JMP	FPDVLP
	TAD	OP1		/PUT QUOTIENT INTO FAC
	DCA	WORD1
	TAD	D2
	DCA	WORD2
	TAD	D3
	DCA	WORD3
	TAD	D4
	DCA	WORD4
	TAD	D5
	DCA	WORD5
	TAD	D6
	DCA	WORD6
	DCA	ACO
	JMS I	DNORM		/NORMALIZE
	JMP I	FPDIV
D2,	0
D3,	0
D4,	0
D5,	0
D6,	0
DITCNT,	0
DAR1,	AR1
DAL1,	AL1
DM74,	-74
OPMAC,	OPO-ACO
DFNEG,	NEGFAC
DOADD,	OADD
DNORM,	ANORM
	*STACKS-1
	-1			/TO PREVENT SPURIOUS DO ENDS
/ NUMERIC CONVERSION ROUTINE
	PAGE
NUMBER,	0			/GENERAL NUMBER CONVERSION ROUTINE
	DCA	ESWIT		/ZERO E/D SWITCH
	DCA	DECPT		/ZERO DECIMAL POINT SWITCH
	DCA	WORD1		/ZERO FAC
	DCA	WORD2
	DCA	WORD3
	DCA	WORD4
	DCA	WORD5
	DCA	WORD6
	DCA	ACO
	DCA	SIGN		/CLEAR SIGN SWITCH
	JMS I	[GETC		/GET A CHAR
	JMP I	NUMBER		/NO CHAR IS NO NUMBER
	JMS	CHKSGN		/CHECK FOR SIGN
SIGN,	0			/THIS SWITCH GETS SET
	DCA	NDIGIT		/ZERO DIGIT COUNT
CONVLP,	JMS I	[DIGIT		/GET A DIGIT
	JMP	TRYDEC		/IS THERE A DECIMAL POINT ?
	AND	[17
	DCA	NXTDGT		/SAVE THE DIGIT
	ISZ	NDIGIT		/INCR NUMBER OF DIGITS
	TAD	WORD2		/PREPARE TO MULT BY 10
	DCA	OP2
	TAD	WORD3
	DCA	OP3
	TAD	WORD4
	DCA	OP4
	TAD	WORD5
	DCA	OP5
	TAD	WORD6
	DCA	OP6
	TAD	ACO
	DCA	OPO
	JMS I	(AL1		/DOUBLE FAC
	JMS I	(AL1		/DOUBLE AGAIN
	JMS I	(OADD		/TIMES FIVE
	JMS I	(AL1		/ONE MORE DOUBLING IS TIMES 10
	DCA	OP2
	DCA	OP3		/PUT NEWEST DIGIT INTO OPERAND
	DCA	OP4
	DCA	OP5
	DCA	OP6
	TAD	NXTDGT
	DCA	OPO
	JMS I	(OADD		/ADD IN NEWEST DIGIT
	JMP	CONVLP
TRYDEC,	TAD	DECPT		/DECIMAL ALREADY ?
	SZA CLA
	JMP	TRYE2		/YES, LOOK FOR EXPONENT
	JMS I	[GETC		/LOOK FOR .
	JMP	DIGTST		/SEE IF THERE WAS ANYTHING
	TAD	(-256
	SZA
	JMP	TRYE1		/TRY FOR E
	JMS I	[SAVECP		/SAVE CHAR POS
	JMS I	(CKEOPR		/CHECK FOR SPECIAL CASE OF LIT.RE.
	JMP	NOLDRE		/NOT LIT.RE.
	JMS I	[RESTCP
	JMS I	[BACK1		/PUT BACK .  IT BELONGS TO RELATIONAL
DIGTST,	TAD	NDIGIT		/ANY DIGITS ?
	SNA CLA
	JMP I	NUMBER		/NO, NO NUMBER
	JMP	INTEGR		/TAKE INTEGER EXIT
NOLDRE,	ISZ	DECPT		/SET DECIMAL POINT SW
	JMS I	[RESTCP		/RESTORE CHAR POS
	JMP	CONVLP-1	/LOOP FOR OTHER DIGITS
TRYE1,	JMS I	[BACK1		/PUT BACK NON .
	TAD	NDIGIT		/ANY DIGITS YET ?
	SNA CLA
	JMP I	NUMBER		/NO, NO NUMBER
	JMS	EORD		/LOOK OR E OR D
	JMP	INTEGR
TRYE2,	JMS	EORD		/LOOK FOR E OR D
FPNUM,	ISZ	NUMBER
	ISZ	NUMBER
	DCA	EXPON		/ZERO EXPONENT
	JMS I	(DODEC		/HANDLE DIGITS RIGHT OF .
	JMP	DOSIGN-1	/GO DO SIGN
INTEGR,	TAD	(107		/PUT IN EXPONNT
	DCA	WORD1
	JMS I	(ANORM		/NORMALIZE
	ISZ	NUMBER		/BUMP RETURN
DOSIGN,	TAD	SIGN		/CHECK THE SIGN
	SZA CLA
	JMS I	(NEGFAC		/NEGATE IF NEGATIVE
	JMP I	NUMBER		/RETURN
CHKSGN,	0			/CHECK FOR SIGN
	TAD	(-255		/IS IT - ?
	SNA
	ISZ I	CHKSGN		/YES, SET SWITCH
	SZA
	TAD	(255-253	/IS IT + ?
	SZA CLA
	JMS I	[BACK1		/RETURN CHAR OTHERWISE
	JMP I	CHKSGN
EORD,	0			/LOOK FOR E OR D
	JMS I	[GETC		/LOOK FOR E OR D
	JMP I	EORD
	TAD	(-304
	CLL RAR
	SZA CLA		/E OR D?
	JMP	NOEORD	/NO
	SZL
	ISZ	ESWIT	/SET SWITCH IF E
	SNL
	ISZ	DPUSED	/SET D.P. SWITCH IF D
	JMP I	(GETEXP		/OK, GET EXPONENT
NOEORD,	JMS I	[BACK1		/PUT IT BACK CAUSE ITS NOT OURS
	JMP I	EORD
NXTDGT,	0
REWIND,	JMS I	[EXPR		/COMPILE UNIT
	JMP I	[NEXTST
	TAD	(REWOPR		/OUTPUT REWIND OPERATOR
	JMS I	[OUTWRD
	JMP I	[NEXTST
/ NUMERIC CONVERSION ROUTINE
	PAGE
SMLNUM,	0			/INPUT A NUMBER &lt;= 4095
EXPLUP,	DCA	EXPON		/ZERO THE EXPONENT
	JMS I	[DIGIT		/GET THE NEXT DIGIT
	JMP I	SMLNUM		/NUMBER DONE
	AND	[17
	DCA	OPO		/SAVE THE DIGIT
	TAD	EXPON		/MULT BY 10
	CLL RAL
	CLL RAL
	TAD	EXPON
	CLL RAL
	TAD	OPO		/ADD IN DIGIT
	JMP	EXPLUP		/STORE BACK INTO EXPONENT
GETEXP,	DCA	ESIGN		/ZERO EXPONENT SIGN SWITCH
	JMS I	[GETC		/GET A CHAR
	JMP I	(FPNUM+1
	JMS I	(CHKSGN		/IS IT A SIGN
FPRTNE,
ESIGN,	0			/THIS IS THE SWITCH TO SET
	JMS	SMLNUM		/GO GET THE EXPONENT
FIXEXP,	TAD	ESIGN		/CHECK EXPONENT SIGN
	SNA CLA
	JMP	.+4
	TAD	EXPON		/COMPLEMENT EXPONENT
	CIA
	DCA	EXPON
	JMS	DODEC		/GO HANLE EXPONENT
	CLL CML RTL		/BUMP RETURN BY TWO (DP) OR 3 (FP)
	TAD	ESWIT		/DEPENDING ON E/D SWITCH
	TAD I	[NUMBER
	DCA I	[NUMBER
	JMP I	(DOSIGN		/CHECK THE SIGN
DODEC,	0
	TAD	DO107		/NORMALIZE THE NUMBER
	DCA	WORD1
	JMS I	(ANORM
	TAD	DECPT		/WAS THERE A DECIMAL POINT ?
	SZA CLA
	TAD	NDIGIT		/HOW MANY DIGITS TO THE RIGHT ?
	CIA
	TAD	EXPON		/SUBTRACT THAT NUMBER FROM EXP
	SMA
	JMP	POSEXP		/EXPONENT IS POSITIVE
	CIA
	DCA	EXPON		/ONLY NEED ABS VALUE
	TAD	(FPDIV		/DO DIVIDES
	JMP	.+3
POSEXP,	DCA	EXPON
	TAD	(FPMUL		/DO MULTIPLIES
	DCA	FPRTNE		/MULTIPLY/DIVIDE ROUTINE
	TAD	(PETABL-1	/POWERS OF TEN TABLE
	DCA	X17
EXPMUL,	TAD	EXPON		/LOOK AT THE EXPONENT
	SNA
	JMP I	DODEC		/IF 0 ITS THRU
	CLL RAR
	DCA	EXPON		/PUT LOWEST BIT INTO LINK
	SNL
	JMP	SKPEXP		/THIS ONE DOESN&#039;T COUNT
	CDF 10		/3.01/
	TAD I	X17		/MOVE FACTOR INTO OPERAND
	DCA	OP1
	TAD I	X17
	DCA	OP2
	TAD I	X17
	DCA	OP3
	TAD I	X17
	DCA	OP4
	TAD I	X17
	DCA	OP5
	TAD I	X17
	DCA	OP6
	DCA	OPO
	CDF
	JMS I	FPRTNE		/MULTIPLY OR DIVIDE BY THIS FACTOR
	JMP	EXPMUL		/CHECK NEXT BIT
SKPEXP,	TAD	X17		/SKIP OVER THIS FACTOR
	TAD	(6
	JMP	EXPMUL-1
AR1,	0			/SHIFT FAC RIGHT ONE
	TAD	WORD2
	CLL RAR
	DCA	WORD2
	TAD	WORD3
	RAR
	DCA	WORD3
	TAD	WORD4
	RAR
	DCA	WORD4
	TAD	WORD5
	RAR
	DCA	WORD5
	TAD	WORD6
	RAR
	DCA	WORD6
	TAD	ACO
	RAR
	DCA	ACO
	ISZ	WORD1
DO107,	107
	JMP I	AR1

AL1,	0			/SHIFT FAC LEFT ONE
	TAD	ACO
	CLL RAL
	DCA	ACO
	TAD	WORD6
	RAL
	DCA	WORD6
	TAD	WORD5
	RAL
	DCA	WORD5
	TAD	WORD4
	RAL
	DCA	WORD4
	TAD	WORD3
	RAL
	DCA	WORD3
	TAD	WORD2
	RAL
	DCA	WORD2
	JMP I	AL1
/ NUMERIC CONVERSION ROUTINE
	PAGE
FPMUL,	0			/FLOATING MULTIPLY ROUTINE
	TAD	WORD1		/COMPUTE NEW EXPONENT
	TAD	OP1
	DCA	OP1
	TAD	WORD2		/SAVE AC MANTISSA
	DCA	TW2
	TAD	WORD3
	DCA	TW3
	TAD	WORD4
	DCA	TW4
	TAD	WORD5
	DCA	TW5
	TAD	WORD6
	DCA	TW6
	TAD	(-74		/SET ITERATION COUNTER
	DCA	ITRCNT
	DCA	WORD2		/ZERO FAC MANTISSA
	DCA	WORD3
	DCA	WORD4
	DCA	WORD5
	DCA	WORD6
	DCA	ACO
MULLUP,	JMS I	(AR1		/SHIFT FAC RIGHT ONE
	TAD	TW2		/SHIFT MULTIPLIER RIGHT
	CLL RAR
	DCA	TW2
	TAD	TW3
	RAR
	DCA	TW3
	TAD	TW4
	RAR
	DCA	TW4
	TAD	TW5
	RAR
	DCA	TW5
	TAD	TW6
	RAR
	DCA	TW6
	SZL
	JMS I	(OADD		/ADD IF LINK IS ONE
	ISZ	ITRCNT		/BUMP COUNT
	JMP	MULLUP		/LOOP
	TAD	OP1		/PUT IN CORRECT EXPONENT
	DCA	WORD1
	JMS I	(ANORM		/NORMALIZE THE RESULT
	JMP I	FPMUL
TW2,	0
TW3,	0
TW4,	0
TW5,	0
TW6,	0
ANORM,	0			/NORMALIZE FAC
	TAD	WORD2		/IS MANTISSA 0 ?
	SNA
	TAD	WORD3
	SNA
	TAD	WORD4
	SNA
	TAD	WORD5
	SNA
	TAD	WORD6
	SNA
	TAD	ACO
	SNA CLA
	JMP	ZEXP		/YES, ZERO EXPONENT
NORMLP,	CLA CLL CML RTR		/IS HIGH ORDER MANTISSA = 6000
	TAD	WORD2
	SZA
	JMP	NO6000		/NO, SKIP THIS STUFF
	TAD	WORD3		/YES, IS THE REST 0 ?
	SNA
	TAD	WORD4
	SNA
	TAD	WORD5
	SNA
	TAD	WORD6
	SNA
	TAD	ACO
	SZA CLA			/SKIP IF 600000 ... 0000
NO6000,	SPA CLA
	JMP I	ANORM		/NORM IS DONE WHEN BITS DIFFER
	JMS I	(AL1		/SHIFT LEFT ONE
	CLA CMA			/DECREMENT EXPONENT
	TAD	WORD1
	DCA	WORD1
	JMP	NORMLP		/LOOP
ZEXP,	DCA	WORD1
	JMP I	ANORM
NEGFAC,	0			/NEGATE FAC
	TAD	(ACO		/GET POINTER TO OPERAND
	DCA	NFPTR
	TAD	(-6		/SIX WORD NEGATE
	DCA	NFCNT
	CLL
NFLOOP,	RAL
	TAD I	NFPTR		/GET NEXT WORD
	CLL CML CIA
	DCA I	NFPTR		/RESTORE AFTER COMPLEMENTING
	CML CLA CMA		/LINK GETS COMPLEMENTED ONCE HERE
	TAD	NFPTR		/AND ONCE AGAIN HERE
	DCA	NFPTR		/RESTORE DECREMENTED POINTER
	ISZ	NFCNT
	JMP	NFLOOP
	JMP I	NEGFAC
NFPTR,	0
NFCNT,	0
ITRCNT,
DHLRTH,	0			/HOLLERITH IN DATA SUBR
	ISZ	TEMP
	SKP
	JMP I	DHLRTH
	ISZ	DHLRTH
	JMS I	[GETCWB
	JMP	DHOLER
	JMP I	DHLRTH
/ VARIABLE SCANNER
	PAGE
GETNAM,	0			/GET VARIABLE NAME
	JMS	LETTER		/FIRST CHAR MUST BE ALPHABETIC
	JMP I	GETNAM		/NO VARIABLE
	DCA	BUCKET		/FIRST ONE IS THE BUCKET
	TAD	(NAME1
	DCA	NPTR		/POINTER TO NAME BUFFER
	CLL CMA RTL		/SIX CHARS MAX (3 WORDS)
	DCA	NCNT
PAKLUP,	JMS	LETTER		/GET A LETTER
	SKP
	JMP	.+3		/WE GOT IT
	JMS I	[DIGIT		/NO LETTER, IS IT A DIGIT ?
	JMP	NDONE		/NO, NAMES OVER
	CLL RTL
	RTL
	RTL			/MOVE CHAR TO A HIGHER PLACE
	DCA I	NPTR		/STORE IT
	ISZ	NCNT		/BUMP COUNTER
	JMP	MORNAM		/MORE TO COME
	SKP
NDONE,	DCA I	NPTR		/ZERO NEXT WORD
	ISZ	GETNAM		/FIX RETURN ADDR
	JMP I	GETNAM
MORNAM,	JMS	LETTER		/GET NEXT CHAR
	SKP
	JMP	.+3		/ITS A LETTER
	JMS I	[DIGIT
	JMP	NDONE+1		/NO GOOD, NAMES OVER
	TAD I	NPTR
	DCA I	NPTR		/COMBINE TWO CHARS
	ISZ	NPTR
	JMP	PAKLUP
NPTR,	0
	NCNT=OADD
/ DATA STATEMENT
DATA,	JMS I	[IFCHEK		/IF(..)DATA   ????
	TAD	(DATAST		/START DATA STATEMENT
	JMS I	[OUTWRD
DATLUP,	CLA CMA			/SET DIMNUM = -1 IF NO SUBSCRIPTS
	JMS I	[GETSS		/GET LIST ELEMENT
	JMP	DATAER
	TAD	(DPUSH		/OUTPUT DPUSH OPERATOR
	JMS I	[OUTWRD
	CMA
	TAD	TEMP2		/FOLLOWED BY POINTER
	JMS I	[OUTWRD
	TAD	DIMNUM		/FOLLOWED BY NUMBER
	JMS I	[OUTWRD
	CDF	10
	TAD I	TEMP2		/LOOK AT TYE TYPE
	AND	(20		/IS IT AN ARG ?
	CDF
	SZA CLA
	JMP	DATAER		/YES, THATS BAD
	JMS I	[GETC		/, ?
	JMP	DATAER
	TAD	(-254
	SNA
	JMP	DATLUP		/LOOK FOR MORE
	TAD	(254-257	// ?
	SZA CLA
	JMP	DATAER
	JMP	DLOOP2		/GO LOOK FOR ELEMENT
DATA3,	TAD	(WORD1-1
	DCA	X10		/POINTER TO THE GOODS
	TAD I	X10		/THEN STUFF
	JMS I	[OUTWRD
	ISZ	TEMP
	JMP	.-3
NXTDE,	TAD	(ENDELM		/OUTPUT END OF ELEMENT
	JMS I	[OUTWRD
	JMS I	[GETC		/LOOK FOR COMMA
	JMP	DATAER
	TAD	(-254
	SNA
	JMP	DLOOP2		/YES, GET MORE DATA
	TAD	(254-257	/SLASH ?
	SZA CLA
	JMP	DATAER		/NO, ERROR
	JMS I	[GETC		/ANOTHER DATA GROUP ?
	JMP I	[NEXTST		/NO
	TAD	(-254		/COMMA ?
	SNA CLA
	JMP	DATA+1		/START A NEW DATA STMT
DATAER,	JMS I	[ERMSG
	0401			/OK WHEN THIS IS AN AND
	JMP I	[NEXTST
DHOLER,	JMS I	[ERMSG
	0410			/HOLLERITH DATA ERROR
	JMP I	[NEXTST
DQUOTE,	0			/GET CHAR FOR QUOTED DATA
	JMS I	[GETCWB
	JMP	DHOLER
	TAD	[-247
	SZA
	JMP	DNOTQ2
	JMS I	[GETCWB
	JMP I	DQUOTE
	TAD	[-247
	SNA CLA
	JMP	DNOTQ2		/REPLACE &#039;&#039; BY &#039;
	JMS I	[BACK1
	JMP I	DQUOTE
DNOTQ2,	TAD	[247		/FIX CHAR
	ISZ	DQUOTE
	JMP I	DQUOTE
OUT3WD,	0			/2.02/ OUTPUT 3 WORDS 
	TAD	[DATELM		/2.02/ OUTPUT ELEMENT HEAD
	JMS I	[OUTWRD		/2.02/
	TAD	(3		/2.02/ AND SIZE
	JMS I	[OUTWRD		/2.02/
	TAD	WORD1		/2.02/ NOW THREE WORDS
	JMS I	[OUTWRD		/2.02/
	TAD	WORD2		/2.02/
	JMS I	[OUTWRD		/2.02/
	TAD	WORD3		/2.02/
	JMS I	[OUTWRD		/2.02/
	JMP I	OUT3WD		/2.02/
/ DATA STATEMENT
	PAGE
DLOOP2,	JMS I	[GETC
	JMP	DATAER
	TAD	(-250		/IS CHAR ( ?
	SZA
	JMP	NOCMPD		/NO, NOT COMPLEX DATA
	JMS I	[NUMBER		/GET REAL PART
	JMP	DATAER
	SKP
	JMP	DATAER		/DP IS NG WITH COMPLEX
	JMS	OUT3WD		/2.02/ OUTPUT 3 WORDS
	JMS I	[CHECKC		/LOOK FOR COMMA
	-254
	JMP	DATAER		/BAD IF NOT THERE
	JMS I	[NUMBER		/GET IMAGINARY PART
	JMP	DATAER
	SKP
	JMP	DATAER
	JMS I	[CHECKC		/LOOK FOR )
	-251
	JMP	DATAER		/NOT THERE
	JMP	DATAFP		/GO MOVE IMAGINARY PART
NOCMPD,	IAC			/IS IT QUOTED STRING ?
	SZA
	JMP	NQUOTD		/NO
	TAD	(DQUOTE		/GET SUBR ADDRESS
	JMP	HOLDAT		/GO HANDLE IT
NQUOTD,	TAD	(247-317	/IS IT AN O (OCTAL)
	SNA
	JMP I	(XOCTAL		/YES
	TAD	(317-256	/IS IT .
	SNA CLA
	JMS I	(TRUFAL		/CHECK FOR TRUE OR FALSE
	JMP	NOTF		/NO TRUE-FALSE, TRY NUMBER
	CLL CML RTR		/2000
	DCA	WORD2
	TAD	WORD2
	SZA CLA
	IAC
	DCA	WORD1		/TRUE=1.0  FALSE=0.0
	DCA	WORD3
	JMP	DATAFP		/GO PUT IT
NOTF,	JMS I	[BACK1		/PUT BACK CHAR
	JMS I	[NUMBER		/TRY FOR A NUMBER
	JMP	DATAER		/ELEMENT MISSING
	JMP	TRYHOS		/IF INTEGER, TRY FOR H OR *
	TAD	(-3
DATAFP,	TAD	(-3		/FP DATA
	DCA	TEMP		/SIZE OF ITEM
	TAD	[DATELM		/DATA ELEMENT SIGNAL
	JMS I	[OUTWRD
	TAD	TEMP		/THEN SIZE
	CIA			/ALWAYS POSITIVE
	JMS I	[OUTWRD
	JMP	DATA3		/GO OUTPUT THE DATA
TRYHOS,	JMS I	[GETC		/LOOK FOR H
	JMP	DATAER
	TAD	(-310
	SZA
	JMP	TRYSTR		/NOT H, MAYBE ITS *
	JMS I	[FIXNUM		/INTEGERIZE IT
	SNA
	JMP	DHOLER		/HOLLERITH DATA ERROR
	CMA
	DCA	TEMP		/SAVE COUNT
	TAD	(DHLRTH		/GET SUBR POINTER
HOLDAT,	DCA	HCHAR
	CLL CMA RTL		/2.02/ COUNT
	DCA	TEMP2		/2.02/ BY THREES
	TAD	(WORD1-1	/2.02/
	DCA	X10		/2.02/ POINTER
HDLOOP,	JMS I	HCHAR		/GET A CHAR
	JMP	EOHD		/2.02/
	AND	[77		/6 BITIZE IT
	CLL RTL
	RTL
	RTL			/UPPER-PART-OF-WORDIZE
	DCA	WORD3		/2.02/ STORAGIZE IT
	JMS I	HCHAR		/GET ANOTHER
	JMP	LASTHD		/LAST HALF WORD MUST GO OUT
	AND	[77
	TAD	WORD3		/2.02/ COMBINIZE THE TWO HALVES
	DCA I	X10		/2.02/ STORE IT
	ISZ	TEMP2		/2.02/ THREE AT A TIME
	JMP	HDLOOP		/2.02/
	JMS	OUT3WD		/2.02/ OUTPUT THREE
	JMP	HOLDAT+1	/2.02/ GO DO NEXT THREE WDS
EOHD,	CLL CML RTL		/2.02/ ANY CHARS IN THIS SET ?
	TAD	TEMP2		/2.02/
	SPA CLA			/2.02/
	JMP	NXTDE		/2.02/ NO, DO NEXT ELEMENT
	JMP	.+4		/2.02/ YES, FILL IT OUT
LASTHD,	TAD	WORD3		/2.02/ FILL OUT LOWER CHAR
	TAD	(40		/2.02/ WITH A BLANK
	DCA I	X10		/2.02/
	TAD	(4040		/2.02/ THEN FILL REST
	DCA I	X10		/2.02/ WITH BLANKS
	TAD	(4040		/2.02/
	DCA I	X10		/2.02/
	JMP	DATAFP		/2.02/ GO OUTPUT IT
TRYSTR,	TAD	(310-252	/*
	SNA CLA
	JMP	.+3
	JMS I	[BACK1		/PUT BACK THAT CHAR
	JMP	DATAFP		/ITS JUST AN INTEGER
	TAD	(DREPTC		/REPETITION COUNT
	JMS I	[OUTWRD
	JMS I	[FIXNUM
	JMS I	[OUTWRD		/OUTPUT COUNT
	JMP	DLOOP2		/LOOP
/ INITIALIZE READ IN
	*6400
INITLN,	TAD	IX7772		/READ FIRST SIX CHARS
	DCA	TEMP
	TAD	IXLINM
	DCA	CHRPTR
INITLP,	CIF	10
	JMS I	[ICHAR		/READ A CHAR
	JMP	INITLN
	TAD	IXM211		/TAB ?
	SZA CLA
	JMP	NIXTAB		/NO THIS ONE
	TAD	IX0240
	DCA I	CHRPTR
	ISZ	TEMP
	JMP	.-3
	JMP	CHKCOM		/DO COMMENT CHECK
NIXTAB,	TAD	CHAR
	DCA I	CHRPTR		/STORE THE CHAR
	ISZ	TEMP
	JMP	INITLP
CHKCOM,	TAD I	IXLINE		/COMMENT ?
	TAD	IXM303
	SNA CLA
	JMP	IGNORE		/IGNORE IT
	TAD I	IXLNP5		/CONTINUATION ?
	TAD	IXM240
	SZA CLA
	JMP	IGNORE
	TAD	IX7700		/FIX CALL
	CDF	10		/SEE WHAT HAPPENS WHEN YOU MOVE A ROUTINE**
	DCA I	IXINCL
	CDF			/**
	CIF	10
	JMS I	IX200		/REMOVE MONITOR
	11
	CDF	10		/FIX FIELD ONE STUFF
	TAD I	MOV1
	DCA I	MOV2
	ISZ	MOV1
	ISZ	MOV2
	ISZ	MOVCNT
	JMP	.-5
	CDF
	JMP I	IXRDFS		/LOOK FOR PROG HEADER
MOV1,	2020
MOV2,	20
MOVCNT,	-160
IGNORE,	CIF	10		/**
	JMS I	[ICHAR		/SKIP TILL CARRIAGE RETURN
	JMP	INITLN
	CLA
	JMP	IGNORE
IXRDFS,	RDFRST
IXINCL,	INCALL
IXM240,	-240
IXM303,	-303
IX0240,	0240
IX200,	200
IX7600,	7600
IX7772,	7772
IXM211,	-211
IX7700,	7700		/V3C
/ SEARCH FOR PROGRAM HEADER
	PAGE
RDFRST,	CIF	10		/**
	JMS I	[ICHAR		/THIS IS A DUPLICATE OF THE CODE
	JMP	ENDLNF		/AT LABEL &#039;RDLOOP&#039; , ONLY THE
	TAD	(-211
	SNA
	TAD	(240-211
	TAD	(211
	DCA I	CHRPTR		/NAMES HAVE BEEN CHANGED TO
	ISZ	CNT72
	SKP
	JMP	SKPFL2
	TAD	CHRPTR		/PROTECT THE ASSEMBLY
	CIA CLL			/(IT GETS THE FIRST LINE
	TAD	(LINE+270	/WHICH MAY BE SUBROUTINE OR 
/FUNCTION. 1ST LINE SHORTER THAN REST BEC OF BUFFER OVERWRITES**
	SZL CLA			/OR SOMETHING ELSE, IN WHICH CASE
	JMP	RDFRST		/ITS THE MAIN PROGRAM)
	JMS I	[ERMSG		/LINE TOO LONG
	1424
	JMP	SKPFL		/SKIP REST
SKPFL2,	CIF	10		/**
	JMS I	[ICHAR
	JMP	ENDLNF
	CLA
	JMP	SKPFL2
SKPCMF,	TAD	X16		/BY ORDER OF THE EMPEROR
	DCA	CHRPTR		/MARIO DE NOBILI
ENDLNF,	TAD	CHRPTR
	DCA	X16
	TAD	CHRPTR
	DCA	X10
	TAD	(-102
	DCA	CNT72
	TAD	(-6
	DCA	NCHARS
GET6F,	CIF	10		/**
	JMS I	[ICHAR
	JMP	SKPCMF
	TAD	(-211
	SZA CLA
	JMP	NOTABF
	TAD	(240
	DCA I	CHRPTR
	ISZ	NCHARS
	JMP	.-3
	TAD	(240
	DCA	CHAR
	JMP	CCHEKF
NOTABF,	TAD	CHAR
	DCA I	CHRPTR
	ISZ	NCHARS
	JMP	GET6F
CCHEKF,	TAD I	X10
	TAD	(-303
	SZA CLA
	JMP	NOCMTF
SKPFL,	CIF	10		/**
	JMS I	[ICHAR
	JMP	SKPCMF
	CLA
	JMP	SKPFL
NOCMTF,	TAD	CHAR
	TAD	(-240
	SNA CLA
	JMP	GOTFST
CCARDF,	TAD	X16
	DCA	CHRPTR
	JMP	RDFRST
GOTFST,	TAD	CHRPTR
	CIA
	TAD	(LINE+4
	DCA	NCHARS
	TAD	[LINE-1
	DCA	CHRPTR
	JMS I	[SAVECP
	TAD	(HDRLST-1
	DCA	X10		/PREPARE TO SEARCH THE LIST
CLOOP1,	CDF 10			/(FNC NAMES UP IN FLD 1)**
	TAD I	X10		/OF LEGAL HEADER LINES
	CDF
	SZA			/CODE IS AS UNDER &#039;CMDLUP&#039;
	JMP	CLOOP2
	CLA CMA RAL
	TAD	STACK
	DCA	STACK
	CDF	10		/**
	TAD I	X10
	CDF
	DCA	TEMP
	JMP I	TEMP
CLOOP2,	DCA	TEMP
	JMS I	[GET2C
	JMP	BADCMF
	CIA
	TAD	TEMP
	SNA CLA
	JMP	CLOOP1
SEARCH,	CDF	10		/**
	TAD I	X10
	CDF
	SZA CLA
	JMP	SEARCH
	ISZ	X10
	JMS I	[RESTCP
	ISZ	STACK
	ISZ	STACK
	CDF	10		/**
	TAD I	X10
	CDF
	SZA
	JMP	CLOOP2
BADCMF,	JMS I	[RESTCP		/NOT A FUNCTION OR SUBROUTINE
	JMP I	(LINE1		/SO GO TO MAIN PART OF COMPILER
BADDIE,	JMS I	[MESSAG		/SOMETHING MISSING FROM SYS
	323			/S
	331			/Y
/ ANALYZE PROGRAM HEADER
	PAGE
SUBRTN,	CLA CMA			/SET TO -1 FOR SUBR
	JMP	XXXFUN+1
REAFUN,	TAD	(102		/SET TYPE TO REAL
	DCA	TYPE
	JMP	XXXFUN
LOGFUN,	IAC			/SET TYPE OF FUN
DBLFUN,	IAC			/WITH DOUBLEMINT GUM !
CMPFUN,	IAC
	IAC
INTFUN,	TAD	(101
	DCA	TYPE
	JMS I	[CHECKC		/LOOK FOR &#039;N&#039;
	-316
	JMP	BADBGN
XXXFUN,	CLA IAC
	DCA	FUNCTN		/SET SWITCH
	CDF	10		/1.05/ KILL ENTRY FOR &#039;MAIN&#039;
	DCA I	(ALIST+14	/1.05/ BUT DO IT BEFORE THE M BUCKET
	CDF			/1.05/ CONTAINS ANYTHING USEFULL
	JMS I	[GETNAM		/GET FUNC/SUBR NAME
	JMP	BADBGN
	JMS I	[LOOKUP		/PUT INTO SYMBOL TABLE
	DCA	PROGNM
	TAD	PROGNM		/SET UP TYPE
	IAC
	DCA	TEMP
	TAD	STACK
	DCA	X12		/SAVE POINTER
	DCA	TEMP2		/ZERO ARG COUNTER
	CDF	10
	TAD	TYPE		/PUT IN THE TYPE BITS
	TAD	(1000
	DCA I	TEMP
	CDF
	JMS I	[CHECKC		/LOOK OFR (
	-250
	JMP	ISITFN		/IS IT A FUNCTION ?
ARGLUP,	JMS I	[GETNAM		/GET THE ARG
	JMP	BADBGN
	JMS I	[LOOKUP
	IAC
	DCA	TEMP		/ADDR OF TYPE WORD
	CDF	10
	TAD I	TEMP
	SZA CLA
	JMP	BADBGN		/ALREADY AN ARG
	TAD	(20
	DCA I	TEMP
	CDF
	CMA
	TAD	TEMP		/OUTPUT ADDR OF ARG
	JMS I	[PUSH
	ISZ	TEMP2		/KEEP COUNT
	JMS I	[COMARP		/LOOK FOR , OR )
	JMP	BADBGN		/NEITHER
	JMP	ARGLUP		/,
	TAD	TEMP2		/) HOW MANY ARGS ?
	CDF	10
	DCA I	NEXT		/INTO ARG LIST
	TAD	TEMP2
	CIA
	DCA	TEMP2
	TAD	NEXT		/SAVE ADDR OF ARG LIST
	DCA	ARGLST
	CDF
	TAD	X12		/RESTORE THE STACK
	DCA	STACK
MOVARG,	TAD I	X12		/PUT ARGS INTO ARG LIST
	CDF	10
	DCA I	NEXT
	CDF
	ISZ	TEMP2
	JMP	MOVARG
	JMP I	[NEXTST		/DO NEXT LINE
	TYPE=WORD6
ISITFN,	TAD	FUNCTN		/IS IT A FUNCTION
	SPA SNA CLA		/WITH NO ARGS ?
	JMP I	[NEXTST		/NO, WE&#039;RE OK
BADBGN,	JMS I	[ERMSG
	2010
	JMP I	[NEXTST
BDATA,	JMS I	[CHECKC		/LOOK FOR A
	-301
	JMP	BADBGN
	CLL CMA RAL		/SET FUNCTION SWITCH
	DCA	FUNCTN		/2.02/ STORE IT DUMMY!!
	TAD	(BDLIST-1	/POINTER TO LIST OF PATCHES
	DCA	X10
BDLOOP,	CDF	10
	TAD I	X10		/GET PATCH LOCATION
	CDF
	SNA
	JMP I	[NEXTST		/NO MORE PATCHES
	DCA	TEMP		/SAVE PATCH ADDRESS
	TAD	BADJMP		/GET ERROR JUMP
	DCA I	TEMP		/STORE IT
	JMP	BDLOOP		/LOOP
BADJMP,	JMP I	[BDERR
/ INITIAL SYMBOL TABLE
	FIELD	1
	*2020
	NOPUNC
	*20
	ENPUNC
	0
BLNKCN,	111;0			/BLANK COMMON SLOT
ALIST,	0;0;0;0;0;0;0;0;0;0;0;0;MAIN;0;0;0;0;0;0;0;0;0;0;0;0;0
HOLIST,	0
FPLIST,	0
DPLIST,	0
INTLST,	ONE
CMPLST,	0
SNLIST,	0
ONE,	THREE;0;1;2000;0
THREE,	SIX;0;2;3000;0
SIX,	0;0;3;3000;0
TRUE,	0;0145;0
MAIN,	0;1000;0;0111;1600
FREE,	0
/ BLOCK DATA PATCH LIST
BDLIST,	IF			/BLOCK DATA PATCH LIST
	DOUBLE
	DO
	GOTO
	CALL
	READ
	REWIND
	ENDFIL
	FORMAT
	WRITE
	BACKSP
	ASSIGN
	STOP
	PAUZE
	DFINFL
	FIND
	ITSAR
	0
/ INITIALIZATION
	*2200
START,	SKP			/NON-CHAINED ENTRY POINT
	JMP	.+5		/CCL ENTRY
	CIF CDF 10		/START HERE
	JMS I	(200		/COMMAND DECODE
	5
	0624			/DEFAULT EXT IS  .FT
	TAD I	L7600		/IS AN OUTPUT FILE GIVEN ?
	SNA CLA
	JMP	MYFILE		/NO, USE FORTRN.TM
MOVOFN,	TAD I	OFNAME		/MOVE NAME INTO PAGE 0
	CDF
	DCA I	NAMEOF
	CDF	10
	ISZ	NAMEOF
	ISZ	OFNAME
	ISZ	OFNSIZ
	JMP	MOVOFN
EXTEST,	TAD I	(7604		/SET DEFAULT EXTENSIONS
	SZA
	JMP	EXTSET
	TAD I	(7643
	SPA 
	JMP	GETRA		/A WAS SET.USE RA
	AND	L41		/CHECK FOR L+G
	SNA	CLA
	TAD	(0610		/USE RL
	TAD	(1404		/USE LD
EXTSET,	DCA I	(7604
	TAD I	(7604
	CDF	0
	DCA I	NAMF
	CDF	10
	TAD I	(7611
	SNA
	TAD	(1423		/.LS FOR LISTING
	DCA I	(7611
	TAD I	(7616
	SNA
	TAD	(1520		/.MP FOR LOAD MAP
	DCA I	(7616
EFILE,	CLA IAC			/OPEN PASS1 OUTPUT FILE
	JMS I	(200
	3
OBLOK,	TMPFL2
OSIZE,	0
	JMP	OBAD		/BADDIE
	CDF
	TAD	OBLOK		/SAVE STARTING BLOCK
	DCA	OUBLOK
	TAD	OBLOK
	DCA I	(OUFILE
	TAD	OSIZE
	DCA	OULEN
	CDF	10
	CLA IAC
	JMS I	(200		/GET PASS2
	2
SPASS2,	PASS2N
	0
	JMP	OBAD
	CLA IAC
	JMS I	(200
	2
SP2O,	PAS2ON			/GET PASS2 OVERLAY
	0
	JMP	OBAD
	CDF			/SAVE PASS2 AND PASS2O BLOCKS
	TAD	SPASS2
	DCA	PASS2B
	TAD	SP2O		/SKIP FIRST BLOCK
	IAC			/ITS THE CORE TABLE
	DCA I	(PASS2O
	CIF
	JMP	INITLN		/GO START COMPILE
MYFILE,	CDF			/PUT DEFAULT INTO 17600
	TAD I	NAMOF
	DCA I	NAMEOF
	TAD I	NAMOF		/ALSO INTO PAGE 0
	CDF	10
	DCA I	OFNAME
	ISZ	NAMOF
	ISZ	NAMEOF
	ISZ	OFNAME
	ISZ	OFNSIZ
	JMP	MYFILE
	CLA IAC			/SET DEV TO SYS
	DCA I	L7600
	JMP	EXTEST		/GO OPEN FILE
OBAD,	CIF CDF
	JMP	BADDIE
OFNAME,	7601			/IGNORE DEVICE (ALWAYS USE SYS)
NAMEOF,	TMPFIL+4
NAMOF,	TMPFIL
OFNSIZ,	-3
TMPFL2,	0617;2224;2216;2415	/FORTRN.TM
PASS2N,	2001;2323;6200;2326	/PASS2.SV
PAS2ON,	2001;2323;6217;2326	/PASS2O.SV
NAMF,	TMPFIL+7
L7600,
GETRA,	7600			/CLA
	TAD	(2201		/V3C USE RA
	JMP	EXTSET
L41,	41
	PAGE
/ PROGRAM HEADER LIST
HDRLST,	TEXT	&#039;INTEGERFUNCTIO&#039;
	INTFUN
	TEXT	&#039;REALFUNCTION&#039;
	REAFUN
	TEXT	&#039;COMPLEXFUNCTIO&#039;
	CMPFUN
	TEXT	&#039;DOUBLEPRECISIONFUNCTIO&#039;
	DBLFUN
	TEXT	&#039;LOGICALFUNCTIO&#039;
	LOGFUN
	TEXT	&#039;FUNCTION&#039;
	XXXFUN
	TEXT	&#039;SUBROUTINE&#039;
	SUBRTN
	TEXT	&#039;BLOCKDAT&#039;
	BDATA
	0
/ PS-8 FILE INPUT ROUTINES
/NEED TWO PAGES BEC. MOVING ICHAR OUT OF FIELD 1 REQUIRES
/ALOT OF FIELD DIDDLING.
	*5400
MORCHR,	TAD	(214		/FIX CHAR
	CDF	0		/**
	DCA I	QCHAR
	CDF	10
	TAD I	(ICHAR
	IAC			/UPDATE ADDR
	DCA	TCHAR
	CIF CDF	0
	TAD I	QCHAR		/RETURN VALUE IN AC
	JMP I	TCHAR
TCHAR,	0
QCHAR,	CHAR
/ EXTENDED OPERATOR LIST
OPRLST,	-01;-1604;ANDOPR
	-17;-2200;OROPR
	-05;-2100;EQOPR
	-16;-0500;NEOPR
	-07;-0500;GEOPR
	-07;-2400;GTOPR
	-14;-0500;LEOPR
	-14;-2400;LTOPR
	-30;-1722;XOROPR
	-05;-2126;EQVOPR
	0
/ EXPONENT TABLE
PETABL,	0004;2400;0000		/1E1
	0000;0000;0000
	0007;3100;0000		/1E2
	0000;0000;0000
	0016;2342;0000		/1E4
	0000;0000;0000
	0033;2765;7020		/1E8
	0000;0000;0000
	0066;2160;6744		/1E16
	6770;1000;0
	0153;2356;1326		/1E32
	6501;2670;2655
	0325;3023;6017		/1E64
	5117;7747;6466
	0652;2235;6443		/1E128
	7114;0164;6145
	1523;2523;7565		/1E256
	7734;7374;7357
	3245;3430;6320		/1E512
	2565;1407;2176
ENDSTM,	211;&quot;E;&quot;N;&quot;D;215;211;215;232	/V3C
/FAKE END STATEMENT USED IF PROGRAM HAS NONE
	PAGE
/MAIN PART OF OS/8 INPUT ROUTINES

ICHAR,	0			/READ CHAR FROM INPUT FILE
	CDF	10
	ISZ	INJMP		/BUMP THREE WAY UNPACK SWITCH
	ISZ	INCHCT
INJMPP,	JMP	INJMP
/	CDF			**
	TAD	INEOF		/DID LAST READ YEILD END OF FILE ?
	SNA CLA
	JMP	INGBUF		/NO, DO ANOTHER READ
GETNEW,	JMS	INNEWF		/OPEN A NEW INPUT FILE
	JMP	ENDIN		/END OF INPUT
INGBUF,	TAD	INCTR		/BUMP RECORD COUNTER
	CLL IAC
	SNL
	DCA	INCTR		/RESTORE IF IT HASN&#039;T OVERFLOWED
	SZL
	ISZ	INEOF		/SET END OF FILE SWITCH
	CDF	10		/**
	CIF	0		/**
	JMS I	INHNDL		/DO THE READ
	0210			/ONE BLOCK TO FIELD 1
INBUFP,	INBUF
INREC,	0
	JMP	INERR		/HANDLER ERROR
INBREC,	ISZ	INREC		/BUMP RECORD NUMBER
	TAD	INBUFP		/RESET BUFFER POINTER
SVIBPT,	DCA	INPTR		/V3C
	TAD	(-601		/SET CHAR COUNT
	DCA	INCHCT
	TAD	INJMPP		/RESET THREE WAY JUMP SWITCH
	DCA	INJMP
	JMP	ICHAR+1		/GO AGAIN
INERR,	ISZ	INEOF		/EITHER EOF OR BADDIE
	SMA CLA
	JMP	INBREC		/END OF FILE, DO NEXT FILE
	JMP	TERR		/INPUT ERROR, GIVE I F AND EXIT
ENDIN,	TAD	(ENDSTM		/V3C IF NO END STATEMENT, FORCE ONE
	JMP	SVIBPT

/ENDIN,	TAD	INCALL		/END OF INPUT IS USR IN CORE ?
/	TAD	(-200
/	CIF	0		/**
/	SZA CLA
/	JMP I	(ENDX		/NO, ITS END OF PROG
TERR,	JMS I	(MESSAG		/YES, BAD INPUT. WAS SQ.BRCK**
	311
	306
INJMP,	HLT			/3 WAY CHAR UNPACK BRANCH
	JMP	ICHAR1
	JMP	ICHAR2
ICHAR3,	TAD	INJMPP		/RESET JUMP SWITCH
	DCA	INJMP
	TAD I	INPTR
	AND	(7400		/COMBINE THE HIGH ORDER BITS
	CLL RTR			/OF THE TWO WORDS
	RTR
	TAD	INTMP		/TO FORM THE THIRD CHAR
	RTR
	RTR
	ISZ	INPTR		/BUMP WORD POINTER
	JMP	ICHAR1+1	/DO SOME COMMON STUFF
ICHAR2,	TAD I	INPTR		/SAVE THE HIGH ORDER BITS
	AND	(7400
	DCA	INTMP		/FOR THE THIRD CHAR
	ISZ	INPTR		/GO TO THE SECOND WORD
ICHAR1,	TAD I	INPTR		/GET THE LOW 8 BITS
/	CDF
	AND	(177		/AND I MEAN ONLY 8 !!
	SNA			/V3C YOU WERE WRONG - YOU MEANT ONLY 7
	JMP	ICHAR+1
	TAD	(-32		/IS IT ^Z (END OF FILE)
	SNA
	JMP	GETNEW		/YES, LOOK FOR THE NEXT FILE
	TAD	(232-212
	SNA
	JMP	ICHAR+1		/IGNORE LINE FEEDS
	TAD	(212-215
	SNA
	JMP 	ICHARN		/RETURN ON CARRIAGE RETURN **
	IAC
	SNA
	JMP	ICHAR+1		/IGNORE FORM FEEDS
	JMP I	(MORCHR		/**
ICHARN,	CIF CDF	0
	JMP I	ICHAR
INTMP,	0
INFPTR,	7617			/POINTER TO INPUT FILE LIST
INEOF,	1
INCHCT,
INNEWF,	-1			/FETCH HANDLER FOR NEXT FILE
	CDF	0		/**
	TAD	(INDEVH+1		/THIS IS WHERE IT GOES **
	DCA	INHNDL
	CDF	10
	TAD I	INFPTR		/GET NEXT INPUT FILE INFO
	SNA
	JMP I	INNEWF		/NO MORE FILES
	CDF	10		/WAS CIF 10**
	JMS I	INCALL		/CALL MONITOR
	1			/FETCH HANDLER
INHNDL,	0			/ENTRY ADDR GOES HERE
	JMP	INERR+3		/THIS CAN&#039;T HAPPEN HERE
	TAD I	INFPTR		/GET LENGTH
	AND	(7760
	SZA			/A ZERO HERE MEANS &gt;=256 BLOCKS
	TAD	(17		/PUT IN SOME MORE BITS
	CLL CML RTR
	RTR
	DCA	INCTR		/STORE LENGTH OF FILE
	ISZ	INFPTR
	TAD I	INFPTR		/GET STARTING RECORD NUMBER
	DCA	INREC
	ISZ	INFPTR
	DCA	INEOF		/CLEAR EOF FLAG
	ISZ	INNEWF
	JMP I	INNEWF
INCTR,	0
INCALL,	200			/CHANGED TO 7700 AFTER FIRST TIME
INPTR,	0
	PAGE
/ KEYWORD LIST
CMDLST,	-1106;0;IF		/IF
	-0417
	-2502
	-1405
	-2022
	-0503
	-1123
	-1117;0;DOUBLE		/DOUBLE PRECISION
	-0417;0;DO		/DO
	-0717
	-2417;0;GOTO		/GOTO
	-0317
	-1515
	-1716;0;COMMON		/COMMON
	-0317
	-1520
	-1405;0;COMPLE		/COMPLEX
	-0317
	-1624
	-1116
	-2505;0;NEXTST		/CONTINUE
	-0301
	-1414;0;CALL		/CALL
	-2205
	-0114;0;REAL		/REAL
	-2205
	-0104;0;READ		/READ
	-2205
	-2711
	-1604;0;REWIND		/REWIND
	-2205
	-2425
	-2216;0;RETURN		/RETURN
	-0516
	-0406
	-1114;0;ENDFIL		/ENDFILE
	-0516;0;XEND		/END
	-0411
	-1505
	-1623
	-1117;0;DIMENS		/DIMENSION
	-0401
	-2401;0;DATA		/DATA
	-0617
	-2215
	-0124;0;FORMAT		/FORMAT
	-2722
	-1124;0;WRITE		/WRITE
	-0521
	-2511
	-2601
	-1405
	-1603;0;EQUIV		/EQUIVALENCE
	-0405
	-0611
	-1605
	-0611
	-1405;0;DFINFL		/DEFINEFILE
	-1116
	-2405
	-0705;0;INTEGE		/INTEGER
	-1417
	-0711
	-0301;0;LOGICA		/LOGICAL
	-0530
	-2405
	-2216
	-0114;0;EXTERN		/EXTERNAL
	-0201
	-0313
	-2320
	-0103;0;BACKSP		/BACKSPACE
	-0123
	-2311
	-0716;0;ASSIGN		/ASSIGN
	-2001
	-2523;0;PAUZE		/PAUSE
	-2324
	-1720;0;STOP		/STOP
	-0611
	-1604;0;FIND		/FIND
	0			/END OF LIST
	$
</pre>
<hr/>
</div>