--- /dev/null
+/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'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
+\f/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
+\f *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 "NUMBER"
+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
+\f/ 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
+\f/ 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'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
+\f/ 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
+\f/ GOTO'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
+\f/ 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 ' (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'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
+\f/DIRECT ACCESS I/O
+ PAGE
+DAQUOT, JMS I [BACK1
+ JMS I [CHECKC /LOOK FOR '
+ -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'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
+\f/ DIMENSION, COMMON, REAL
+ PAGE
+DIMENS, JMS I [IFCHEK
+ JMS I [CHECKC /CHECK FOR "N"
+ -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 "X"
+ -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
+\f/ 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 "E"
+ -305
+ JMP I [BADCMD
+ JMS I [EXPR /COMPILE UNIT EXPR
+ JMP I [BADCMD
+ TAD (BAKOPR /OUTPUT BACKSPACE OPERATOR
+ JMS I [OUTWRD
+ JMP I [NEXTST
+\f/ 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
+\f/ END PASS ONE
+XEND, JMS I [CHECKC /LOOK FOR "D"
+ -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
+\f/ EQUIVALENCE (UGH!)
+ PAGE
+EQUIV, JMS I [IFCHEK /BAD WITH IF
+ JMS I [CHECKC /LOOK FOR "E"
+ -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'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
+\f/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 "REAL" MASTER'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
+\f/ 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
+\f/ 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
+\f/ 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'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
+\f/ 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'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
+\f/ 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 "E"
+ -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
+\f/ 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 <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 < 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
+\f/ 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 >.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'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
+\f/ EXPRESSION ANALYZER
+ PAGE
+HQUOTE, 0 /SUBR FOR QUOTE STRINGS
+ JMS I [GETCWB /GET CHAR
+ JMP BADH
+ TAD [-247 /IS IT '
+ SZA
+ JMP NOTQ2 /NO
+ JMS I [GETCWB
+ JMP LUHOL
+ TAD [-247 /LOOK FOR ''
+ SNA CLA
+ JMP NOTQ2 /REPLACE '' BY '
+ 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 '
+ 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'T MAKE IT
+ TAD CCTEMP /IS THIS IT ?
+ SNA CLA
+ ISZ CHECKC /YES
+ JMP I CHECKC
+CCTEMP, 0
+\f/ 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
+\f/ 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
+\f/ 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>NEW
+ TAD OLDOP
+PUSH2, JMS I [PUSH /OLD < 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
+\f/ 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'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 >23
+ JMS I (AR1 /RIGHT SHIFT ONE
+ JMP FIXNUM+1 /TEST AGAIN
+RETFN, TAD WORD3 /RETURN LOWEST 12 BITS
+ JMP I FIXNUM
+\f/ 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 "T"
+ TAD (24-6
+ SZA CLA
+ JMP I TRUFAL /ITS NEITHER
+ ISZ TRUFAL /ITS "F"
+ ISZ TRUFAL
+ JMP I TRUFAL
+\f/ 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
+\f/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 > 271 (9)
+ SMA
+ JMP NODIGT /YES, ITS GREATER
+ TAD (272-260 /IS IT < 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 "TO"
+ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ NUMERIC CONVERSION ROUTINE
+ PAGE
+SMLNUM, 0 /INPUT A NUMBER <= 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'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
+\f/ 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
+\f/ 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
+\f/ 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 '' BY '
+ 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/
+\f/ 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
+\f/ 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
+\f/ SEARCH FOR PROGRAM HEADER
+ PAGE
+RDFRST, CIF 10 /**
+ JMS I [ICHAR /THIS IS A DUPLICATE OF THE CODE
+ JMP ENDLNF /AT LABEL 'RDLOOP' , 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 'CMDLUP'
+ 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
+\f/ 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 'N'
+ -316
+ JMP BADBGN
+XXXFUN, CLA IAC
+ DCA FUNCTN /SET SWITCH
+ CDF 10 /1.05/ KILL ENTRY FOR 'MAIN'
+ 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'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
+\f/ 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
+\f/ 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
+\f/ 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
+\f PAGE
+/ PROGRAM HEADER LIST
+HDRLST, TEXT 'INTEGERFUNCTIO'
+ INTFUN
+ TEXT 'REALFUNCTION'
+ REAFUN
+ TEXT 'COMPLEXFUNCTIO'
+ CMPFUN
+ TEXT 'DOUBLEPRECISIONFUNCTIO'
+ DBLFUN
+ TEXT 'LOGICALFUNCTIO'
+ LOGFUN
+ TEXT 'FUNCTION'
+ XXXFUN
+ TEXT 'SUBROUTINE'
+ SUBRTN
+ TEXT 'BLOCKDAT'
+ BDATA
+ 0
+\f/ 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;"E;"N;"D;215;211;215;232 /V3C
+/FAKE END STATEMENT USED IF PROGRAM HAS NONE
+\f PAGE
+\f/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'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'T HAPPEN HERE
+ TAD I INFPTR /GET LENGTH
+ AND (7760
+ SZA /A ZERO HERE MEANS >=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
+\f/ 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
+ $
+\f
projects / pdp8.git / blobdiff