--- /dev/null
+/OS8 FORTRAN II COMPILER V5
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1971,1974,1975
+/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
+/
+/
+/
+/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
+/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
+/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
+/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
+/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
+/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
+/
+/
+/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
+/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
+/EQUIPMRNT COROPATION.
+/
+/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+/
+/
+/
+/
+/
+\f/
+/ SYMBOL TABLE FOR FORTRAN COMPILER (8K- PDP-8)
+/ FOR USE WITH DISK/DECTAPE MONITOR SYSTEM
+/ CHANGE LOCATION 'XFINI' TO A 'JMP I LFINI' THEN
+/ASSEMBLE AND SAVE
+/ .PAL FORT.PA
+/ .PAL FPATCH.PA
+/
+/ .LO FORT.BN$FPATCH.BN$
+/
+/ .SA SYS FORT
+/
+/
+
+ FIELD 0
+ *200
+INBUF, TEXT /PDP-8 FORTRAN DEC-08-A2B1-5A/
+
+ *1000
+BEGIN, PLS /INITIALIZATION ROUTINE
+ TLS
+ RFC
+ CDF 00
+ TAD CM1300 /SET SYMBOL TABLE TO ZEROS (6300-7577 FIELD 1)
+ DCA INDX
+ TAD BSYMP
+ DCA TPTT
+LP, DCA I TPTT
+ ISZ INDX
+ JMP LP
+ TAD CM60
+ DCA INDX
+ TAD BTTAB
+ DCA TPTT
+ DCA I TPTT /ZERO OUT TEMPORARY TABLES IN FIELD 0
+ ISZ INDX
+ JMP .-2
+ CDF 10
+ TAD MIN104 /ZERO EVERYTHING FROM ZERO TO 107
+ DCA INDX
+ TAD CP6
+ DCA TPTT
+LPP, DCA I TPTT
+ ISZ INDX
+ JMP LPP
+ TAD TPT /MOVE DATA FROM TABLE TO FIELD 0
+ DCA TPTT
+REP, CDF 00
+ TAD I TPTT
+ SNA /END OF FIELD 0 INITIALIZATION?
+ JMP DN /YES
+ DCA LOC
+ TAD I TPTT
+ CDF 10
+ DCA I LOC
+ JMP REP
+DN, TAD I TPTT /MOVE DATA FROM TABLE TO FIELD 1
+ SNA /END FIELD 1 INITIALIZATION
+ JMP DNN /YES
+ DCA LOC
+ TAD I TPTT
+ DCA I LOC
+ JMP DN
+DNN, CIF 10
+ JMP I STRT
+LOC, 0
+INDX, 0
+MIN104, L7-ASSIGN
+CP6, L7-1
+CM1300, -1300
+CM60, -60
+BTTAB, ITTAB-1
+BSYMP, BSYM-1 /BOTTOM OF TEMPORARY SYMBOL TABLE
+STRT, FORST /STARTING POINT AFTER INITIALIZATION
+TPTT=10
+TPT, TABLE-1
+TABLE,
+PUNCH
+ LTTYPE
+15
+ DOEND
+45
+ FTTAB
+51
+ ITTAB
+47
+ TSYM-3
+50
+ TSYM
+55
+ -25
+56
+ BSYM
+57
+ BSYM
+71
+ 5777
+74
+ 3000
+MIKE4
+ 3377
+POINTZ
+ 3377
+BASE
+ INBUF
+BASE2
+ INBUF+100
+SCOUNT
+ 0
+SCOUNT+1
+ 0
+SCOUNT+2
+ 0
+QONE
+ 0
+QONE+1
+ 0
+QONE+2
+ 0
+QONE+3
+ 0
+QONE+4
+ 0
+QONE+5
+ 0
+QONE+6
+ 0
+0 /THIS TERMINATES FIELD ZERO INITIALIZATION
+2375
+ 4000
+2376
+ 4000
+2377
+ 4000
+0
+
+\f/ ERROR MESSAGE TABLE AND TEXT
+
+ELIST, -ERR1-1; EMSG1 /ILLEGAL CONTINUATION
+ -ERR2-1; IE /ILLEGAL ARITHMETIC EXPRESSION
+ -ERR3-1; IE
+ -ERR6-1; IE
+ -ERR9-1; EMSG3
+ -ERR10-1; EMSG4
+ -ERR12-1; EMSG4
+ -ERR14-1; EMSG4
+ -ERR15-1; EMSG3
+ -ERR16-1; EMSG5
+ -ERR17-1; EMSG6
+ -ERR18-1; SE /SYNTAX ERROR
+ -ERR28-1; SE
+ -ERR29-1; SE
+ -ERR30-1; EMSG8 /ILLEGAL VARIABLE
+ -ERR31-1; SE
+ -ERR35-1; SE
+ -ERR36-1; EMSG36
+ -ERR37-1; CE
+ -ERR38-1; EMSG9 /ILLEGAL DO NESTING
+ -ERR39-1; SE
+ -ERR40-1; IE
+ -ERR41-1; EMSG10 /EXPRESSION TOO BIG
+ -ERR42-1; IE
+ -ERR43-1; EMSG11 /MIXED MODE
+ -ERR44-1; EMSG9
+ -ERR47-1; SF /SUBR. OR FUNCT. STMT. NOT FIRST
+ -ERR48-1; SE
+ -ERR50-1; SE
+ -ERR51-1; SE
+ -ERR52-1;IE
+ -ERR53-1; EMSG12 /ILLEGAL SUBSCRIPT
+ -ERR54-1; EMSG13 /ILLEGAL EQUIVALENCING
+ -ERR59-1; SE
+ -ERR60-1; EMSG3
+ 0; EMSG14 /COMPILER MALFUNCTION
+
+EMSG1, TEXT /ILLEGAL CONTINUATION/
+IE, TEXT /ILLEGAL ARITHMETIC EXPRESSION/
+EMSG3, TEXT /ILLEGAL STATEMENT/
+EMSG4, TEXT /ILLEGAL CONSTANT/
+EMSG5, TEXT /ILLEGAL STATEMENT NUMBER/
+EMSG6, TEXT /SYMBOL TABLE EXCEEDED/
+SE, TEXT /SYNTAX ERROR/
+EMSG8, TEXT /ILLEGAL VARIABLE/
+EMSG9, TEXT /ILLEGAL OR EXCESSIVE DO NESTING/
+EMSG10, TEXT /ARITHMETIC EXPRESSION TOO COMPLEX/
+EMSG11, TEXT /MIXED MODE EXPRESSION/
+EMSG12, TEXT /EXCESSIVE SUBSCRIPTS/
+EMSG13, TEXT /ILLEGAL EQUIVALENCING/
+EMSG14, TEXT /COMPILER MALFUNCTION/
+CE, TEXT /UNBALANCED QUOTES/
+SF, TEXT /SUBR. OR FUNCT. STMT. NOT FIRST/
+EMSG36, TEXT /ARRAY TOO LARGE/
+\fITTAB=710
+FTTAB=ITTAB+30
+DOEND=2377
+BSYM=6300
+TSYM=7600
+
+/ THE STATEMENT TYPE TABLE FOLLOWS
+ *2600
+STYPE, 7361 /-DO
+ 0000
+ LDO
+ 6672 /-IF
+ 0000
+ LIF
+ 7061 /-GO
+ 5361 /-TO
+ LGOTO
+ 7477 /-CA
+ 6364 /-LL
+ CAL
+ 5573 /-RE
+ 5353 /-TU
+ LRET
+ 7461 /-CO
+ 6154 /-NT
+ LCONT
+ 5454 /-ST
+ 6060 /-OP
+ LSTOP
+ 5777 /-PA
+ 5255 /-US
+ LPAUSE
+ 5573 /-RE
+ 7674 /-AD
+ LREAD
+ 5056 /-WR
+ 6654 /-IT
+ LWRIT
+ 7161 /-FO
+ 5563 /-RM
+ LFRMAT
+ 7262 /-EN
+ 7400 /-D
+ LLAST
+ 7461 /-CO
+ 6263 /-MM
+ LCOMON
+ 7367 /-DI
+ 6273 /-ME
+ LDIMEN
+ 7257 /-EQ
+ 5267 /-UI
+
+ EQUI
+ -0611 /-FI
+ -1611 /-NI
+ LFIN
+XXSUBR, 5453 /-SU
+ 7556 /-BR
+ LSUB
+ 7153 /-FU
+ 6175 /-NC
+ LFUNC
+ 0000 /THIS IS THE END OF LIST
+AREA1, 0
+AREA2, 0
+
+/ THE PRECEDENCE TABLE FOLLOWS, NON-ZERO PREC. OPERATORS APPEAR
+ -45 / PREC('%') = 7 NOTE: '%' REPLACES '**'
+ 700
+ -52 / PREC('*') = 5
+ 500
+ -57 / PREC('/') = 5
+ 500
+ -53 / PREC('+') = 4
+ 400
+ -55 / PREC('-') = 4
+ 400
+ -75 / PREC('=') = 1
+ 100
+ -74 / PREC('<') = 1 NOTE: '<' IMPLIES SUBSCRIPTED ASSIGNMENT
+ 100
+ 1 /THIS IS THE END OF THE TABLE
+THOU, -1750
+ -144
+ -12
+ -1
+
+/ THE PERMANENT SYMBOL TABLE BEGINS HERE
+ *6000
+ 1501 /MAIN
+ 1116
+ 0001
+ 0601 /FAD
+ 0400
+ 0001
+ 2324 /STO
+ 1700
+ 0001
+ 0623 /FSB
+ 0200
+ 0001
+ 0615 /FMP
+ 2000
+ 0001
+ 0604 /FDV
+ 2600
+ 0001
+ 1520 /MPY
+ 3100
+ 0001
+ 0411 /DIV
+ 2600
+ 0001
+ 2205 /READ
+ 0104
+ 0001
+ 2722 /WRITE
+ 1124
+ 0501
+ 1117 /IOH
+ 1000
+ 0001
+ 5060 /(0
+ 0000
+ 0001
+ 1215 /JMP
+ 2000
+ 0001
+ 1617 /NOP
+ 2000
+ 0001
+ 0516 /ENTRY
+ 2422
+ 3101
+ 0501 /EAP
+ 2000
+ 0001
+ 2001 /PAUSE
+ 2523
+ 0501
+OPTADI, 2401 /TAD I
+ 0440
+ 1101
+OPTAD, 2401 /TAD
+ 0400
+ 0001
+OPDCA, 0403 /DCA
+ 0100
+ 0001
+OPJMPI, 1215 /JMP I
+ 2040
+ 1101
+ 2205 /RETRN
+ 2422
+ 1601
+ 0320 /CPAGE
+ 0107
+ 0501
+OPSNA, 2316 /SNA
+ 0100
+ 0001
+ 2320 /SPC
+ 0300
+ 0001
+ 0301 /CALL
+ 1414
+ 0001
+ 0313 /CKIO
+ 1117
+ 0001
+ 1014 /HLT
+ 2400
+ 0001
+OPCLA, 0314 /CLA
+ 0100
+ 0001
+ 0614 /FLOT
+ 1724
+ 0001
+ 1106 /IFAD
+ 0104
+ 0001
+ 0311 /CIA
+ 0100
+ 0001
+ 0310 /CHS
+ 2300
+ 0001
+ 0611 /FIX
+ 3000
+ 0001
+ 1123 /ISTO
+ 2417
+ 0001
+ 2001 /PAGE
+ 0705
+ 0001
+BLCK, 0214 /BLOCK
+ 1703
+ 1301
+ 0516 /END
+ 0400
+ 0001
+ 1401 /LAP
+ 2000
+ 0001
+ 0317 /COMMN
+ 1515
+ 1601
+ 1123 /ISZ
+ 3200
+ 0001
+ 2325 /SUBSC
+ 0223
+ 0301
+DUMMY, 0425 /DUMMY
+ 1515
+ 3101
+ 0122 /ARG
+ 0700
+ 0001
+ 0314 /CLEAR
+ 0501
+ 2201
+ 1111 /IIPOW
+ 2017
+ 2701
+ 0611 /FIPOW
+ 2017
+ 2701
+ 1106 /IFPOW
+ 2017
+ 2701
+ 0606 /FFPOW
+ 2017
+ 2701
+ 0403 /DCA I
+ 0140
+ 1101
+ 0103 /ACH
+ 1000
+ 0001
+OPEN, 1720 /OPEN
+ 0516
+ 0001
+ 0522 /ERROR
+ 2217
+ 2201
+ 1116 /INC
+ 0300
+ 0001
+FORTR, 0617 /FORTR
+ 2224
+ 2201
+OPCMA, 0315 /CMA
+ 0100
+ 0001
+OPIAC, 1101 /IAC
+ 0300
+ 0001
+EXIT, 0530 /EXIT
+ 1124
+ 0001
+\f FIELD 1
+ *0
+FIRSTF, 1
+ *7
+L7, 0
+L10, 0
+L11, 0
+L12, 0 /LAST LINE'S CONTENTS FOR OPTOMIZATION
+ 0
+L14, 0
+L15, 2377 /POINTER INTO DOEND LIST
+L16, 0
+L17, 0
+L20, 0 /FLAG, NON-ZERO IF '=' SEEN
+L21, 0
+L22, 0 /SUBSCRIPT NESTING LEVEL
+L23, 0 /USED BY "DUMARG" AND "IOHAR" PATCH
+L24, 0 /LINE POINTER
+L25, 0 /HIGHEST SUBSCRIPT TEMP USED
+L26, 0 /USED FOR DIMENSION INFORMATION
+ 0 /UNUSED
+L30, 0 /FOLLOWING EIGHT LOCS ARE USED BY ENTITY
+L31, 0
+L32, 0
+L33, 0
+L34, 0
+L35, 0
+L36, 0
+L37, 0
+L40, 0 /CONTAINS THE CURRENT TRIPLE NUMBER
+L41, 0 /THIS IS THE POINTER INTO THE PUSH DOWN LIST
+L42, 0 /THESE TWO LOCATIONS ARE USED BY THE TRIPLE PROCESSOR
+L43, 0 /
+L44, 0 /CONTAINS ONE FOR RIGHT OF EQUALS, ZERO FOR LEFT
+L45, FTTAB /CONTAINS LARFEST FLOATING POINT TEMPORARY NUMBER USED
+L46, 0 /CONTAINS NUMBER OF THE TRIPLE CURRENTLY IN THE AC
+L47, 7575 /CONTAINS THREE LESS THAN START OF FCON TABLE
+L50, 7600 /CONTAINS START OF DIMENSION TABLE
+L51, ITTAB /CONTAINS LARGEST INTEGER TEMPORARY NUMBER USED
+L52, 0 /CONTAINS ONE IF RETURN FROM GENER IS DESIRED FOR BALANCE
+L53, 0 /CONTAINS THE LAST CREATED LABEL
+L54, 0 /CONTAINS THE LABEL FOR THE CURRENT STATEMENT
+L55, -25 /CONTAINS THE MAXIMUM ALLOWABLE NUMBER OF UNENDED DOS
+L56, 6300 /CONTAINS BEGINNING OF SYMBOL TABLE
+L57, 6300 /CONTAINS END OF SYMBOL TABLE
+L60, 0 /"INDIRECT =" FLAG FOR S.S LEFT OF EQUALS SIGN
+L61, 0 /NON-ZERO IF LAST STMT READ IS A COMMENT
+L62, 0 /NEXT FOUR LOCATIONS USED BY GENER AND ENTITY
+L63, 0 /CONTAINS THE CURRENT OPERATOR
+L64, 0 /POINTS TO THE LAST OPERATOR IN THE STACK
+L65, 0 /CONTAINS THE PRECEDENCE OF THE CURRENT OPERATOR
+BPAREN, 0 /PARENTHESIS COUNTER
+L67, 0 /ONE FOR FUNCTION AND ZERO FOR SUBROUTINE
+L70, 0 /CONTAINS POINTER TO SUBPROGRAM NAME
+L71, 5777 /BEGINNING OF PUSHDOWN LIST
+L72, 0 /SET TO ONE IF SUBSCRIPT IS ENCOUNTERED
+L73, 0 /
+L74, 3000 /BEGINNING OF ERASABLE LOCATIONS USED FOR PARAMETERS
+L75, 0 /SET TO ONE SUPPRESS /OUTPUT FROM COMPILER
+L76, 0 /
+L77, 0 /CONTAINS ADDRESS OF LAST ENTRY INTO FCON OR SYMBOL TABLE
+ /THE FOLLOWING THREE LOCS ARE USED BY THE
+ /LITERAL COLLECTER
+COUNT2, 0 /NUMBER OF DIGITS TO RIGHT OF DECIMAL POINT
+ESIGN, 0 /0 MEANS POSITIVE EXPONENT, 1 MEANS NEGATIVE
+FPSW, 0 /0 MEANS INTEGER CONSTANT, 1 MEANS FLOATING POINT
+MIKE4,MA, 3377
+MIKE8,TOTAL, 0
+INTA, 0
+INTB,MIKE7, 0
+SNUM,MB, 0
+POINTZ, 3377
+CHK, 0
+IMPDO, 0 /"IMPLIED DO-LOOP IN PROGRESS" FLAG
+KOUNT, 0
+ASSIGN, LASIGN /ROUTINE TO PROCESS ASSIGNMENT STATEMENTS
+PUTCH, LPUTCH /ROUTINE TO PUT A CHARACTER BACK IN THE INPUT BUFFER
+PROP, LPROP /PRINTS OPCODES
+PRCRL, LPRCRL /PRINTS CREATED LABELS
+PRINT, LPRINT /PRINTS ONE ASCII CHAR
+P2, LP2 /PRINT TWO PACKED ASCII CHARS
+GETCH, LGETCH /GETS ONE CHARACTER OUT OF THE INPUT BUFFER
+LUNCH, LLUNCH /PRINTS ERROR COMMENTS
+MODE, LMODE /DETERMINES THE MODE OF THE ARGUMENT
+LOOK, LLOOK /CHECKS FOR THE REST OF THE INPUT STATEMENT
+ZZZ, LZZZ /PRINTS OUT STATEMENT LABELS
+ENTITY, LENTT /GETS THE NEXT LOGICAL INPUT PARAMETER
+SYMTAB, LSYMTB /ENTERS SYMBOLS INTO THE SYMBOL TABLE
+DUMARG, LDMARG /SEES IF PARAMETER IS A DUMMY ARG OR SUBSCRIPT
+PRSYM, LPRSYM /PRINTS SYMBOLS
+CREATE, LCREAT /CREATES LABELS
+PROTAC, LPRTAC /PRINTS CONTENTS OF AC IN OCTAL
+PLAB, LPLAB /PRINTS LABELS
+PIFF, LPIFF /PUTS OUT AN IFF FOR THE CONTENTS OF THE AC
+TRIPL, LTRIPL /PROCESSES THE TRIPLES GENERATED FROM AN EXPRESSION
+GENER, LGENER /GENERATES THE TRIPLES
+LCHNG, CHNG /TEST FOR DUMMY ARG AND REPLACE
+CLAB, LCLAB /HANGS A CREATED LABEL ON THE NEXT LINE
+STORE, LSTORE /STORES THE CONTENTS OF THE AC
+FPROP, LFPROP /PUT OUT CALLS TO F.P. ROUTINES
+ZER, LZER
+DUM, LDUM /PROCESSES OCCURRANCES OF DUMMY ARGUMENTS IN LISTS
+DIM, LDIM /LOOKS UP DIMENSION INFORMATION ON VARIABLES
+PUNCH, LTTYPE /ADDRESS OF CURRENT OUTPUT ROUTINE
+C2, 2
+C3, 3
+\fC40, 40
+C7240, 5440 /THIS WAS COLON-SPACE NOW ITS COMMA-SPACE
+C77, 77
+CM40, -40
+CM4046, -4046
+CM50, -50
+CM51, -51
+CM54, -54
+CM2, -2
+CM3, -3
+CHECK, LCHECK
+SMODE, LSMODE
+BSS, LBSS
+ARG, LARG
+C54, 54
+BASE, INBUF
+BASE2, INBUF+100
+C4000, 4000
+GNB, LGNB
+\f *177
+START, CLA /COME HERE AT BEGINNING OF EACH STMT
+ DCA FIRSTF
+START1, TAD IMPDO
+ SZA CLA
+ JMP ERR1 /IF IMPDO<>0 THEN WE MUST HAVE SCREWED UP ON
+ /CONTINUATIONS (I THINK)
+ ISZ CHK /IS THERE A STMT IN THE BUFFER?
+ JMP .+3
+ JMS I SWAP /YES, SWITCH BUFFER POINTERS
+ JMP .+3
+ TAD BASE
+ JMS I RCD /NO, READ THE NEXT LINE
+TEST, TAD L15
+ TAD CM3
+ DCA L16 /SET UP XR FOR DO TERMINATION TEST
+ TAD L54
+ CIA
+ TAD I L16
+ SZA CLA /ARE WE TERMINATING A DO?
+ JMP ATRY
+ JMS LDNEXT /TERMINATE DO LOOP
+ JMP TEST /SEE IF THERE IS ANY MORE...
+ATRY, TAD L61
+ SZA CLA /A COMMENT?
+ JMP CMNT
+ TAD CHK
+ SZA CLA /ILLEGAL CONTINUATION?
+ERR1, JMS I LUNCH
+ JMS I STMT /GET THE STMT NR...
+ TAD L32
+ SNA
+ JMP .+4 /NO STMT NUMBER
+ CIA
+ TAD L12
+ SZA CLA /CAN WE OMIT A TERMINAL JMP?
+ JMS I PRINT
+ DCA L24
+FLST, JMS LIST /PUNCH SOURCE STMT
+ JMS I WIPE /ZERO THE SUBSCRIPT TEMP. TABLE
+ TAD L32
+ DCA L54
+ TAD CM2
+ DCA L64
+ SKP
+ACA, DCA I BAREA1
+ JMS I GETCH
+ JMP ALPH
+ NOP
+ JMS I PUTCH /PUT CHARACTER BACK
+ALPH, RTL CLL
+ RTL
+ RTL
+ DCA L65
+ JMS I GETCH
+ JMP ALPH2
+ NOP
+ JMS I PUTCH /PUT CHARACTER BACK
+ALPH2, TAD L65
+ ISZ L64
+ JMP ACA
+ DCA I BAREA2
+ DCA CHK
+ TAD SSTYP /COMPARE THESE CHARS WITH DISPATCH TABLE
+ DCA L17
+TRY, TAD I L17
+ SNA /END OF THE TABLE?
+ JMP I ASSIGN /YES, MUST BE ARITHMETIC STMT
+ TAD I BAREA1
+ SZA CLA
+ JMP NOHIT2
+ TAD I BAREA2
+ TAD I L17
+ SZA CLA
+ JMP NOHIT1
+ TAD I L17 /FOUND A MATCH, GO TO PROPER HANDLER...
+ DCA L30
+ JMP I L30
+NOHIT2, ISZ L17
+NOHIT1, ISZ L17
+ JMP TRY /DOESN'T MATCH, TRY AGAIN
+
+LDNEXT, 0
+ TAD L15 /RESET THE DO END POINTER
+ TAD CM3
+ DCA L15
+ TAD L15
+ IAC
+ DCA L16
+ CMA
+ TAD L55
+ DCA L55
+ JMS I PROP /PUNCH 'JMP <LABEL>'
+ 6044
+ TAD I L16
+ JMS I PRCRL
+ JMS I PRINT
+ TAD I L16 /PUNCH '<LABEL>,'
+ JMS I CLAB
+ JMS I PRINT
+ JMP I LDNEXT
+
+PTEM, 0
+
+LIST, 0 /PUNCH THE SOURCE STATEMENT
+ TAD BASE /GET THE POINTER
+ DCA PTEM
+ TAD I PTEM /PUNCH A CHARACTER PAIR...
+ JMS I P2
+ TAD I PTEM
+ ISZ PTEM
+ AND C77
+ SZA CLA /END OF THE BUFFER?
+ JMP LIST+3
+ JMS I PRINT /YES, PUNCH A CR-LF AND RETURN
+ JMP I LIST
+
+CMNT, JMS I PRINT /WE HAVE A COMMENT
+ DCA L24
+ JMS LIST
+ JMP START1 /ALLOW COMMENTS BEFORE SUBR. OR FUNCTION STMT.
+
+
+BAREA1, AREA1
+BAREA2, AREA2
+RCD, LRCD
+SSTYP, STYPE-1 /POINTER TO STATMENT TABLE IN FIELD 1
+WIPE, LWIPE
+STMT, LSTMT
+SWAP, LSWAP
+\f *400
+/ THE FOLLOWING ROUTINE IS ENTERED WITH THE BUFFER POINTER IN THE AC
+/ IT PUTS ONE LINE INTO THE BUFFER,
+/ CHECKS FOR COMMENTS AND COUTINUATION LINES, AND IF IT IS A
+/ CONTINUATION IT SETS KOUNT TO THE PROPER COLUMN
+/
+LRCD, 0
+ DCA TEM1 /SAVE THE BUFFER POINTER
+ DCA I TEM1
+ DCA CHK /ZERO CONTINUATION FLAG
+ DCA L20 /ZERO THE EQUALS FLAG
+ DCA L61 /ZERO THE COMMENT FLAG
+ TAD CM111 /BUFFER LIMIT IS 72 CHARACTERS
+ DCA IX
+LRCDL, CLA
+ JMS LPTRIN
+ AND D177
+ SZA /LEADER OR BLANK TAPE?
+ TAD CM177
+ SNA /RUBOUT?
+ JMP LRCDL
+ TAD (177-15
+ SNA
+ JMP LCAR
+ TAD (15-11
+ SNA
+ JMP TAB
+ TAD (11-40
+ SPA
+ JMP LRCDL
+ TAD (40-75
+ SNA /AN '=' ?
+ ISZ L20
+ TAD C75 /CHAR OK... RESTORE IT & PUT IN BUFFER
+ JMS KRONK /PUT IT IN THE BUFFER...
+ JMP LRCDL /AND GET ANOTHER
+
+LCAR, TAD IX /PROCESS A CAR RETURN...
+ CIA
+ TAD CM111
+ SNA CLA /NULL STATEMENT?
+ JMP LRCDL /YES, IGNORE
+ JMS KRONK /PUT A ZERO IN THE BUFFER
+ TAD I TEM1
+ TAD CM3
+ SNA
+ JMP COMNT
+ TAD CM20
+ SZA CLA /TEST FOR "S" IN COLUMN ONE
+ JMP TINUE
+ JMP I (SCODE
+COMNT, ISZ L61 /SET COMMENT FLAG...
+ TAD C40
+ JMP STORSL
+
+TINUE, TAD TEM1 /CHECK FOR CONTINUATION...
+ TAD C3
+ DCA P /SET THE POINTER TO COLS. 6 AND 7
+ TAD I P
+ AND C5700 /NON-ZERO OR NON BLANK IN COL 6
+ TAD C4000 /MAKES THIS A CONTINUATION...
+ SNA CLA /IS IT?
+ JMP LRCDA /MAYBE...
+LRCDX, TAD B7 /YES, MAKE IT START IN COL 7
+ DCA KOUNT
+ ISZ CHK /INCREMENT THE CONTINUATION FLAG
+ TAD I TEM1
+STORSL, TAD C5700 /MAKE THIS INTO A COMMENT LINE
+ DCA I TEM1
+ JMP I LRCD /THEN RETURN
+
+LRCDA, TAD I P /NUMERIC AND NON-ZERO IN COL 7 MAKES
+ AND C77 /THIS A CONTINUATION...
+ TAD CM61
+ SPA CLA /IS IT?
+ JMP LRCDX+3 /NO, RETURN
+ IAC /YES, MAKE IT START IN COL 8
+ JMP LRCDX
+
+TAB, TAD C40 /PROCESS TAB CHARACTERS...
+ JMS KRONK /PUT SOME SPACES IN THE BUFFER
+ TAD IX
+ TAD C3 /MAKE 1ST TAB GO TO COL 7
+ SMA /ARE WE AT END OF THE BUFFER?
+ CLA /YES, FORCE TERMINATION
+ AND B7
+ SZA CLA /MODULO 8?
+ JMP TAB /NO, PUNCH SOME MORE SPACES
+ JMP LRCDL /YES, GET ANOTHER CHAR
+
+KRONK, 0 /PUT A CHARACTER IN THE BUFFER...
+ DCA CAR
+ CLA IAC
+ TAD IX /FIRST COMPUTE BUFFER ADDRESS...
+ SNA /PAST COL. 72?
+ JMP I KRONK /YES-RETN.
+ TAD C111 /NO
+ CLL RAR
+ TAD TEM1
+ DCA P
+ TAD CAR /PICK UP THE CHARACTER
+ AND C77
+ SZL /ZERO LINK SAYS WE WANT THE LEFT HALF
+ JMP .+5
+ RTL
+ RTL
+ RTL
+ DCA I P
+ TAD I P /ADD IN THE LEFT 6 BITS
+ DCA I P /AND SALT THEM AWAY...
+ ISZ IX /BUFFER OVERFLOW?
+ JMP I KRONK
+
+LPTRIN, 0 /PAPER TAPE READER INPUT ROUTINE
+ RSF
+ JMP .-1
+ RRB RFC
+ JMP I LPTRIN
+
+CAR, 0 /TEMPORARY, HOLDS THE CURRENT CHARACTER
+P, 0 /THIS IS THE BUFFER POINTER
+TEM1, 0 /THIS CONTAINS THE CURRENT BUFFER ADDRESS
+IX, 0 /THIS IS THE CHARACTER COUNTER
+CM111, -111 /MINUS THE BUFFER LIMIT PLUS ONE
+C111, 111 /THIS IS THE BUFFER LIMIT PLUS ONE
+D177, 177
+CM177, -177
+C75, 75
+B7, 7
+C5700, 5700
+CM61, -61
+CM20, -20
+M1700, -1700
+\f *600
+CAL, TAD KOUNT /SUBROUTINE CALL STMT PROCESSOR
+ DCA COUNT3
+ JMS I ENTITY
+ JMP I ASSIGN
+ JMP ON
+COUNT3, 0
+Q12, 12
+ JMP I ASSIGN
+ON, JMS I GNB
+ SNA /ANY ARGUMENTS?
+ JMP CR2 /NO
+ TAD CM50
+ SZA /MAYBE, IS THIS A '(' ?
+ JMP I ASSIGN
+ JMS I ZZZ /YES, PUNCH STMT NR, IF ANY
+ TAD COUNT3
+ DCA KOUNT
+ ISZ L44
+ DCA L46 /AC SWITCH
+ DCA L52 /IF STATEMENT SWITCH
+ JMS I GENER /LET TRIPLE GENERATOR PROCESS IT
+ DCA L46 /ZERO AC AGAIN
+ JMP START /COMPLETE, GET NEXT STATEMENT
+CR2, ISZ L32 /NO ARGUMENTS
+ JMS I SYMTAB
+ TAD L77
+ DCA GLU
+ JMS I ZZZ /PUNCH '<LABEL>, CALL 0,<NAME>'
+ JMS I FPROP
+GLU, 0
+ JMP START
+LGNB, 0
+ JMS LGTC
+ DCA GLU
+ TAD GLU
+ TAD CM40
+ SNA CLA
+ JMP LGNB+1
+ TAD GLU
+ JMP I LGNB
+LGETCH, 0
+ JMS I GNB
+ SNA /IS IT A END OF CARD
+ JMP PUNC /YES ITS PUNTUATION
+ TAD QM32
+ SPA SNA /IS IT ALPHABETIC
+ JMP ALPHA //YES
+ TAD CM40
+ CLL
+ TAD Q12
+ SZL /IS IT NUMERIC?
+ ISZ LGETCH /NUMERIC
+PUNC, ISZ LGETCH /PUNCTUATION
+ALPHA, CLA /ALPHABETIC
+ TAD GLU
+ JMP I LGETCH /RETURN
+/ THIS ROUTINE DETERMINES WHETHER SYMBOL IS FP OR INTEBER
+/ ROUTINE SKIPS IF SYMBOL IS INTEGER
+LMODE, 0
+ SMA /IF ITS PLUS WE HAVE AN INTEGER
+ JMP AINT /WE HAVE AN INTEGER
+ RAL /GET NEXT BIT
+ SPA /CHECK THIS BIT
+ JMP FV /ITS EITHER A FCON OR VARIABLE
+ RTL /GET NEXT TWO BITS
+ SNL /IS IT AN OPERATOR
+ERR2, JMS I LUNCH /YES
+AFP, SMA CLA /CHECK THIS BIT
+ JMP AINT /ITS AN INTEGER
+ JMP I LMODE /SYMBOL WAS F P MODE
+FV, RAR /RESTORE AC TO ORIGINAL CONTENTS
+ CIA /SET NEGATIVE
+ TAD L47 /ADD START OF FCON TABLE
+ SPA /IS /SYMBOL FCON
+ JMP AFP /YES
+ CIA /NO /RESTORE AC AGAIN
+ TAD L47
+ DCA ATEM /SAVE THE RESTORED NUMBER
+ TAD I ATEM /GET THE POINTER TO THE VARIABLE
+ TAD CM1100 /SUBTRACT AN I
+ SPA /IS IT LESS THAN I
+ JMP AFP /YES ITS FLOATING POINT
+ TAD CON1 /NOW SUBTRACT AN N
+ SPA CLA /IS IT LESS THAN N
+AINT, ISZ LMODE /YES
+CON1, CLA /CLEAR THE AC FOR THE RETURN
+ JMP I LMODE
+ATEM, 0
+CM1100, -1100
+QM32, -32
+LGTC, 0 /GET A CHARACTER FROM THE BUFFER
+ TAD KOUNT
+ ISZ KOUNT
+ CLL RAR /LINK TELLS IF LEFT OR RIGHT HALF
+ TAD BASE
+ DCA GLU
+ TAD I GLU
+ SZL /WHICH CHARACTER
+ JMP MMSK
+ RTR
+ RTR
+ RTR
+MMSK, AND C77
+ SZA
+ JMP I LGTC
+ TAD CHK
+ SPA CLA /DO WE WANT A NEW LINE YET?
+ JMP I LGTC /NOT YET...
+ TAD BASE2 /YES, USE THE ALTERNATE BUFFER
+ JMS I RLCD
+ TAD CHK
+ SZA CLA /IS IT A CONTINUATION?
+ JMP .+4
+ CMA /NO, SET FLAG AND RETURN W ZERO AC
+ DCA CHK
+ JMP I LGTC
+ JMS LSWAP /YES, SWITCH BUFFERS AND CONTINUE
+ DCA CHK
+ JMP LGTC+1
+
+RLCD, LRCD
+LSWAP, 0 /SWITCH THE LINE BUFFER POINTERS
+ TAD BASE
+ DCA ATEM
+ TAD BASE2
+ DCA BASE
+ TAD ATEM
+ DCA BASE2
+ JMP I LSWAP
+\f *1000
+/ THE POINTER TO THE CURRENT LOCATION IN THE PUSH LIST IS
+/ IN LOC 41, THE CURRENT TRIPLE NUMBER IS IN LOCATION 40
+/ LOC 44 MUST BE SET TO 0 IF THERE IS AN '=' , TO 1 IF NOT.
+PBEGN, AREA2 /START OF THE PRECEDENCE LIST
+BINTEG, TAD L32 /HERE IF ENTITY SENT AN INTEGER
+ JMP I BPUSH /PUSH IT INTO STACK
+FLPT, JMS I FCON /HERE IF ENTITY FOUND A FLOATING POINT CON
+ SKP /ENTER IT INTO FPTABLE
+BLPHA, JMS I SYMTAB /HERE IF ENTITY FOUND A VARIABLE
+ TAD L77 /PICK UP POINTER INTO SYM TAB OR FLPT TAB AN
+ JMP I BPUSH /PUSH IT DOWN
+LABELX, JMP I LGENER
+LGENER, 0 /ENTRY POINT
+ TAD C5000
+ DCA L40 /*
+ DCA L21 /ZERO THE SYMBOL TABLE SWITCH
+ TAD L71
+ DCA L41 /SET PUSH DOWN POINTER
+ DCA L22
+ DCA BPAREN /ZERO OUT THE PAREN SWITCH
+ TAD C4000
+ DCA I L41 /FIRST PUSH DOWN LEFT CLOSURE NAMELY 0
+BNEXT, JMS I ENTITY /THIS WILL GET THE NEXT DATUM TO BE PROCESSE
+ JMP HOO /END OF STATEMENT RETURN,TREAT LIKE PUNCTION
+ JMP BLPHA /VARIABLE RETURN
+ JMP BINTEG /INTEGER RETURN
+ JMP FLPT /FLOATING POINT RETURN
+HOO, TAD CM50 /PUNCTIOATION RETURN,
+ SNA /IS IT (
+ JMP I BPAR /YES
+ TAD C7753
+ SZA /IS IT AN '=' ?
+ JMP BRET
+ TAD L44 /WE HAVE AN '=', IS IT LEGAL?
+ SNA CLA
+ JMP BRET /IT IS
+ TAD IMPDO
+ SZA CLA /ARE WE IN AN IMPLIED DO LOOP?
+ JMP I PIOEQL /YES - TERMINATE LOOP CODE
+ERR3, JMS I LUNCH
+PIOEQL, IOEQL
+BRET, TAD C0075
+ DCA L63
+ TAD I L41 /CHECK FOR A UNARY OPERATOR
+ TAD C4000
+ AND C7000
+ SZA CLA /WAS IT AN OPERAATOR AT ALL
+ JMP PREC /NO, STILL NOT UNARY OPERATOR
+ TAD L63
+ TAD C7725
+ SNA /IS IT A '+'
+ JMP BNEXT /YES, IGNORE IT
+ TAD CM2 /NO
+ SZA CLA /IS IT A '-' ?
+ JMP ERR3
+ TAD C4643 /THIS IS THE UNARY MINUS
+ JMP I BPUSH
+PREC, TAD PBEGN /HERE IS WHERE WE FIND THE PRECIDENCE
+ DCA L17
+ DCA L65
+ SKP
+RETUR, ISZ L17 /PICK UP NEXT OP CODE IN LIST
+ TAD I L17 /TO GET THE NEXT LIST ITEM
+ SMA SZA /IS THIS THE END OF THE LIST
+ JMP BMORE /NO, THE ASSUMPTION IS THAT THE PRECIDENCE
+ TAD L63 /IS ZERO
+ SZA CLA /IS THIS THE RIGHT TABLE ENTRY
+ JMP RETUR /TRY AGAIN (IT WASN"T)
+ TAD I L17 /TO GET THE PRECEDENCE
+ DCA L65
+BMORE, CLA IAC /HERE WE ARE GOING TO SEE IF THERE IS A PREC
+ TAD L41
+ DCA L64 /L64 NOW POINTS TO THE PREVIOUS OPERATOR
+ TAD I L64
+ TAD C4000
+ AND C7000
+ SZA /IS THERE A VALID OPERATOR ON THE STACK?
+ JMP ERR3 /APPARENTLY NOT...
+ TAD I L64 /IF THE PRECEDENCE OF THE PREVIOUS OPERATOR
+ AND C700 /IS NON-ZERO, AND ITS PRECEDENCE IS GREATER
+ SNA /THAN OR EQUAL TO THE PRECEDENCE OF THE
+ JMP NO /CURRENT OPERATOR, THEN PROCESS THE PREVIOUS
+ CIA /OPERATOR; IF NOT WE WILL PROBABLY PUT
+ TAD L65 /THE CURRENT OPERATOR ON THE STACK AND GET
+ SMA SZA CLA /ANOTHER ITEM FROM THE STATEMENT BUFFER...
+ JMP NO
+ ISZ L40 /YES, INCREMENT THE TRIPLE NUMBER AND....
+ JMS I TRIPL /PROCESS THE PREVIOUS OPERATOR
+ ISZ L41 /*****NOTE WHAT IF IT WAS UNARY************
+ TAD I L41
+ TAD C3135 /THIS IS MINUS UNARY MINUS
+ SZA CLA
+ ISZ L41 /DELETE THE LAST 3 ITEMS AND REPLACE WITH TR
+ TAD L46
+ DCA I L41
+ JMP BMORE /TRY FOR ANOTHER TRIPLE
+NO, TAD L63
+ SNA /IS IT A END OF STATEMENT MARK
+ JMP I LCDONE /IT WAS--WE ARE ALL FINISHED, EXCEPT CHECKING
+ TAD CM51
+ SNA /IS IT A ')' ?
+ JMP I LKPAR /YES
+ TAD CM3
+ SZA /IS IT A ',' ?
+ JMP NCOMMA /NO
+ TAD BPAREN
+ SNA CLA /IS A COMMA LEGAL HERE?
+ JMP I LCDONE /MAYBE...
+NCOMMA, TAD CM21
+ SNA CLA /IS IT AN EQUALS SIGN?
+ ISZ L44 /YES - SET EQUALS SWITCH ON
+ TAD L63 /PUT THE OPERATOR ON THE STACK
+ TAD L65 /ADD THE PRECEDENCE
+ TAD C4000
+ JMP I BPUSH
+/
+BPUSH, PUSH
+C5000, 5000
+BPAR, ALPAR
+C7753, 7753
+C0075, 75
+C7000, 7000
+CM21, -21
+C7725, 7725
+C4643, 4643
+C700, 700
+C3135, 3135
+LCDONE, CDONE
+LKPAR, KPAR
+FCON, LFCON
+\f *1200
+PUSH, DCA L63
+ CLA CMA
+ TAD L41 /SPACE THE POINTER UP ONE
+ DCA L41 /*
+ TAD L63
+ DCA I L41 /*
+ JMP I LBNEXT /BACK TO BEGINING
+/ THIS IS TO PROCESS SUBSCRIPTS OR FUNCTION CALLS---
+/ IF ARITHMETIC, JUST DELETE BOTH ( AND )
+KPAR, TAD I L64
+ TAD C3730 /MINUS LEFT PAREN
+ SZA /IS IT (
+ JMP BCON /NO-- CHECK SOME MORE
+ TAD I L41 /DELETE PARENS
+ DCA I L64
+ ISZ L41 /UPDATE POINTER
+LAPP, ISZ BPAREN /DO PARENS BALENCE
+ JMP I LBNEXT
+ TAD L52 /YES
+ SNA CLA /SHOULD WE RETURN IF BALANCED
+ JMP I LBNEXT
+ TAD L46
+ SZA CLA
+ JMP CDONE
+ TAD I L41
+ DCA L77
+ JMS I XTAD /GENERATE TAD OR (TAD I)
+ DCA I L41 /ZERO IS INTEGER
+CDONE, TAD L41
+ CMA
+ TAD L71
+ SZA /WELL...
+ERR6, JMS I LUNCH /HA...YOU GOOFED
+ JMS I XZQ
+ JMP I .+1
+ LABELX
+BCON, IAC /IS IT FUNCTION
+ ISZ L40
+ SNA
+ JMP BFOUT /YES
+ IAC /NO-- NOW IS IT SUBSCRIPT
+ SNA
+ JMP SOUT /YES
+ TAD C7772 /NO
+ SZA /IS IT COMMA
+ JMP ERR6 /NO - BYE BYE CHARLIE
+ ISZ L64
+ ISZ L64
+ TAD I L64
+ TAD C3724 /IS IT A COMMA
+ SNA
+ JMP BFOUT /FOUND TWO COMMAS,MUST BE FUNCTION
+ TAD C5 /NO
+ SNA /IS IT A PRIME
+ JMP BFOUT /GOT A FUNCTION
+ IAC /NO
+ SZA CLA
+ JMP ERR6 /SORRY, IT AIN'T NUTTIN
+SOUT, JMS I PLSBSC /PROCESS A SUBSCRIPT
+ CMA
+ TAD L22
+ DCA L22
+ SKP
+BFOUT, JMS I FUNCT
+ JMP LAPP
+FUNCT, LFUNCT
+/ THIS IS WHERE WE FIND OUT WHAT KIND OF LPAR
+ALPAR, CMA
+ TAD BPAREN
+ DCA BPAREN
+ TAD I L41
+ TAD C4000
+ AND B7000 /IS IT AN OPERAND
+ SZA CLA
+ JMP CUNT /NO , TRY SOME MORE
+ IAC
+ JMP PRIME
+CUNT, TAD I L41 /PICK UP TOP LIST ITEM
+ TAD C2 /ADD TWO TO FIND THE DIMENSION INTO(INFO)
+ DCA L64
+ TAD I L64
+ AND C20 /JUST WANT ONLY THIS ONE BIT(DIMENSION)
+ SNA CLA /IS IT DIMENSIONED
+ JMP PRIME /NO ITS GOT TO BE A FUNCTION CALL
+ ISZ L22
+ CMA
+PRIME, TAD C4047
+ JMP PUSH /GO PUSH A PRIME, IT IS THE FUNCTIONS LEFT PAREN
+XZQ, LXZQ
+LBNEXT, BNEXT
+C3730, 3730
+C7772, 7772
+C3724, 3724
+C5, 5
+D7, 7
+B7000, 7000
+C20, 20
+C4047, 4047
+XTAD, LXTAD
+LPUTCH, 0
+ CLA CMA
+ TAD KOUNT
+ DCA KOUNT
+ JMP I LPUTCH
+
+LASIGN, TAD L20 /ARITHMETIC STATEMENT PROCESSOR
+ SNA CLA /IS THERE AN '=' IN THE STMT?
+ERR9, JMS I LUNCH /NO, BETTER COMPLAIN...
+ TAD D7 /SET POINTER TO COL 7
+ DCA KOUNT
+ JMS I ZZZ /PUNCH THE LABEL, IF ANY
+ DCA L46
+ DCA L44
+ DCA L52
+ JMS I GENER /PROCESS IT...
+ TAD L63
+ SZA CLA /WAS TERMINATOR A <CR/LF> ?
+ JMP ERR9 /NO, ILLEGAL STATEMENT ERROR ...
+ JMP START
+PLSBSC, LSUBSC
+
+LPRCRL, 0 /SUBROUTINE PRINTS CREATED LABELS
+ DCA LPRCTM
+ TAD C36 /PUNCH '^'
+ JMS I PRINT
+ TAD LPRCTM /PUNCH THE LETTERS
+ JMS I P2
+ JMP I LPRCRL
+C36, 36
+LPRCTM, 0
+\f *1400
+PRET, ISZ LENTT /PUNCTIONATION EXIT POINT
+FRET, ISZ LENTT /FLOATING POINT EXIT POINT
+XIRET, ISZ LENTT /INTEGER EXIT POINT
+XARET, ISZ LENTT /VARIABLE EXIT
+ERET, JMP I LENTT /CR END OF LINE EXIT
+LENTT, 0 /ENTRY POINT
+ CLA /WIPE OUT PSEUDO ACCUMULATOR
+ DCA L32
+ DCA L31
+ DCA COUNT2 /RESET ALL KINDS OF THINGS TO ZERO
+ DCA L36
+ DCA L37
+ DCA L30
+ DCA FPSW
+ DCA ESIGN
+ TAD CM6
+ DCA L65 /SET UP FOR MAXIMUM OF 6 CHARS
+ JMS I GETCH /GET THE FIRST INPUT CHARACTER
+ JMP .+3 /ALPHA RETURN
+ JMP PUNCT /PUNCTIONATION RETURN
+ JMP DIG /DIGIT RETURN
+ JMS PACK /STORE THIS CHARACTER
+ JMS I GETCH /GET ANOTHER CHACTER
+ JMP .-2 /ALPHA- IS OK
+ SKP /PUNCTUATION
+ JMP .-4 /DIGIT--IS OK PROCESS IT
+ JMS I PUTCH /PUT THAT PUNCTUATION BACK IN THE BUFFER
+ TAD L32
+ AND CC7700 /MAKE SURE NAME IS <= 5 CHARACTERS LONG
+ DCA L32
+ JMP XARET /RETURN WITH VARIABLE
+
+PACK, 0 /THIS PACK CHARS INTO L30 L31 AND L32
+ DCA L64 /SAVE THE CHAR...
+ TAD L65
+ SNA /DO WE HAVE SIX CHARS ALREADY?
+ JMP I PACK /YES - IGNORE
+ STL; RAR
+ TAD P33
+ DCA LTEM
+ ISZ L65
+C7, 7
+ TAD L64
+ CDF 10
+ SNL /DO WE HAVE LEFT OR RIGHT HALF?
+ JMP .+5
+ CLL RTL /MUST BE LEFT HALF...
+ RTL
+ RTL
+ SKP
+ TAD I LTEM
+ DCA I LTEM
+ CDF 00
+ JMP I PACK
+LTEM, 0
+
+PUNCT, SNA /HERE TO PROCESS PUNCTION---IS IT A CARIAGE RET
+ JMP ERET /YES, GO RIGHT BACKTO THE CALLER....BY-BY
+ TAD C7722 /IS IT A PERIOD
+ SNA
+ JMP CC /YES--WE ASSUME THAT THIS LENTT IS A FLOATING
+ TAD C7
+ SNA /IS IT A QUOTE?
+ JMP I QUOTE /YES - CHARACTER LITERAL
+ TAD CM3
+ SZA /IS IT AN ASTERISK
+ JMP NAH /NO
+ JMS I GETCH /YES- PEEK AT NEXT CHAR
+ JMP NOASS /ALPHA-- PUT IT BACK
+ JMP ASSCK /PUNCTUATION-- CHECK FOR AN ASTERISK
+NOASS, JMS I PUTCH /DIGIT---PUT IT BACK
+NAH, TAD X52 /RESTORE CHARACTER TO WHAT IT WAS
+ JMP PRET /THATS ALL---IT WAS PUNCTIONATION
+ASSCK, TAD CM52 /ANOTHER PUNCTUATION--IS IT (*)
+ SZA
+ JMP NOASS /NO---PUT IT BACK
+ TAD C45 /IT WAS-- CHANGE ** TO PERCENT
+ JMP PRET /---ALTERED PUNCTUATION
+DIG, AND C17 /FIRST CHAR WAS A DIGIT, DONT KNOW IS INTEGER O
+ DCA L32 /AT ANY RATE SAVE IT IN THE PSEUDO ACCUMULATER
+CA, JMS I GETCH /GET ANOTHER CHACTER
+ JMP I LTESTE /ALPHA--GO SEE IF IT IS AN -E-
+ SKP /PUNCT
+ JMP BONT /DIGIT GO PROCESS IT
+ TAD C7722 /PUNCTUATION HERE, IS IT A PERIOD
+ SZA
+ JMP I LCOP / IT IS . WE HAVE A FLOATING POINT NUMBER
+CC, TAD FPSW
+ SZA
+ERR10, JMS I LUNCH /TOO MANY (.)
+ ISZ FPSW
+ DCA COUNT2
+ JMP CA /GO BACK AND GET ANOTHER CHAR
+BONT, AND C17 /***COME HERE WITH ANOTHER DIGIT.
+ DCA L36 /SAVE IT
+ ISZ COUNT2
+ JMS I LMUL10 / AC = AC * 10 + DIGIT
+ JMP CA /GO GET ANOTHER CHAR
+P33, L30+3
+CM6, -6
+C7722, 7722
+X52, 52
+CM52, -52
+C17, 17
+LTESTE, TESTE
+C45, 45
+LCOP, COP
+LMUL10, MUL10
+QUOTE, LQUOTE
+
+
+DMPLIN, 0 /SUBROUTINE TO DUMP "LAST LINE" BUFFER
+ ISZ L24
+ TAD I L24 /GET NEXT CHAR
+ JMS I PUNCH /PUNCH IT
+ TAD I L24
+ TAD CM212
+ SZA CLA /IS CHAR A LINE FEED?
+ JMP DMPLIN+1 /NO
+ CLA IAC
+ DCA L24 /RESET POINTER
+ DCA L12 /ZERO CONTENTS FLAG
+ JMP I DMPLIN /RETURN
+CM212, -212
+CC7700, 7700
+\f *1600
+TESTE, TAD C7773 /IS IT E
+ SZA
+ JMP COP /NO, GO PUT IT BACK AND PROCESS
+/ HERE IF EXPONENT FOLLOWES
+ DCA L37 /IT WAS AN E
+/ THIS ROUTINE IS TO PROCESS THE EXPONENT THAT FOLLOWES THE -E- THAT WE
+/
+ ISZ FPSW /MAKE SURE THE FLOATING POINT SWITCH WAS KICKED
+ JMS I GETCH /GET ANOTHER CHAR
+ JMP ERR12 /ALPHA , CANT BE-- SO LONG, ITS BEEN NICE
+ SKP /PUNCT
+ JMP CD /DIGIT, GO PROCESS IT
+ TAD X7725 /IS IT PULS SIGN
+ SNA
+ JMP CF /YES, IGNOR IT
+ TAD CM2
+ SZA /IS IT MINUS
+ JMP COP /NO, GO PROCESS THE FLOATING POINT NUMBER
+ CLA CMA
+ DCA ESIGN /YES- REMEMBER THAT THE EXPONENT WAS MINUS
+CF, JMS I GETCH /GET ANOTHER CHAR
+ JMP COP /ALPHA, ALL READY TO PROCESS
+ JMP COP /PUNCTUATION, READY TO PROCESS
+CD, AND X17 /DIGIT
+ DCA L36 /SAVE IT IN 36 AND..
+ TAD L37 /MULTIPLY THE - EXPONENT TO DATE- BY 10
+ RAL CLL
+ DCA L37
+ TAD L37
+ RAL CLL
+ RAL CLL
+ TAD L37
+ TAD L36 /AND ADD IN THIS DIGIT I.E. 37C10*
+ DCA L37 / L37 = 10 * L37 + L36
+ JMP CF /GO DO IT AGAIN
+COP, JMS I PUTCH
+ CLA CLL /PROCESS THIS NUMBER
+ TAD FPSW /IS IT AN INTEGER
+ SZA CLA
+ JMP CH /NO, MUST BE FLOATING POINT
+/ INTEGER IS IN ACC
+ TAD L30 /YESS
+ SNA /MAKE SURE INTEGER IS VALID
+ TAD L31
+ SZA CLA
+ JMP ERR12
+ TAD L32
+ SPA CLA
+ERR12, JMS I LUNCH /TOO BIG
+ JMP I .+1 /TAKE INTEGER RETURN WITH INTEGER IN 32
+ XIRET
+CH, TAD L37 /WAS THIS AN E-CONVERSION NUMBER
+ ISZ ESIGN /EXPONENT POSITIVE?
+ CIA /YES
+ TAD COUNT2 /ADD POST-DECIMAL COUNTER
+ CLL
+ SNA
+ JMP CM /NOTHING TO DO
+ SMA /DETERMINE WHETHER TO
+ CML CIA /MULTIPLY OR DIVIDE
+ DCA COUNT2
+ RAL
+ TAD CJ
+ DCA CK
+ JMS XFLOAT /SET UP THE NUMBER
+CK, HLT /JMP I (MULT OR JMP I (DIVIDE
+ ISZ COUNT2
+ JMP CK /LOOP ON COUNT
+ JMP I LPOLIS /FINISH UP
+
+CM, JMS XFLOAT
+ JMP I LPOLIS
+CJ, JMS I .+1
+ MULT
+ DIVIDE
+
+/ THIS ROUTINE CONVERTS THE NUMBER TO FLOATING POINT
+XFLOAT, 0
+ CLA CLL
+ TAD L32 /CHECK IF THE ACCUMULATED NUMBER IS ZERO
+ SNA
+ TAD L31
+ SNA
+ TAD L30
+ SNA CLA
+ JMP I LFRET /IT WAS ZERO SEND A FLOATING POINT ZERO BACK--
+ TAD C2440 /IT IS NOT ZERO--SET THE EXPON TO 36 BASE 10
+ DCA L37
+ JMS NORMAL /GO TO THE NORMALIZE ROUTINE
+ JMP I XFLOAT /AT THIS POINT THE MANTISA AND EXPON ARE SEPERA
+/ ALSO NOTICE THAT WE HAVE 36 BINARY DIGITS I E THE WHOLE 3 WORDS ARE U
+/ NORMAL IZATION OF A F P NUMBER
+NORMAL, 0
+DA, TAD L30 /WE MUST SHIFT UNTIL THE HIGH ORDER WORD GOES N
+ SPA CLA
+ JMP I NORMAL /IT IS NEG., ALL DONE
+ JMS I LLSHIF /GO DO A TRIPLE PRECISION LEFT SHIFT
+ TAD L37 /AND SUBTRACT ONE FROM THE EXPONENT
+ TAD C7770 /NOTE-- THE 3 LOW ORDER BITS ARE NOT USED
+ SPA /IF THIS DOESNT SKIP WE HAVE F P OVERFLOW
+ JMP ERR12 /BY-BY NUMBER TOO LARGE FOR THE MACHINE
+ DCA L37
+ JMP DA
+/ THE FOLLOWING ROUTINE SAVES THE ACC IN THE MQ
+C7773, 7773
+X7725, 7725
+X17, 17
+C7770, 7770
+LPOLIS, POLISH
+LFRET, FRET
+C2440, 2440
+LLSHIF, LSHIFT
+
+SCODE, CDF 10 /SHIFT S-CODE 2 COLS. LEFT
+ TAD I (TEM1
+ CDF 0
+ DCA SLOC1
+ TAD SLOC1
+ IAC
+ DCA SLOC2
+ ISZ L61 /SET COMMENT FLAG
+SCODL, TAD I SLOC2
+ DCA I SLOC1
+ TAD I SLOC2
+ AND C77
+ SNA CLA /END OF LINE?
+ JMP I (STORSL+2
+ ISZ SLOC1
+ ISZ SLOC2
+ JMP SCODL /AND CONTINUE PROCESS
+
+SLOC1, 0
+SLOC2, 0
+\f *2000
+XSAVE, 0 /-- THE F.P. AC IS IN LOCS 30-32
+ TAD L30 /-- THE "MQ" IS IN LOCS 33-35
+ DCA L33 /---THE EXPONENT IS IN LOCS 37
+ TAD L31
+ DCA L34
+ TAD L32
+ DCA L35
+ JMP I XSAVE
+/ SHIFTS THE PSEUDO-ACC LEFT ONE PLACE
+LSHIFT, 0
+ CLA CLL
+ TAD L32
+ RAL
+ DCA L32
+ TAD L31
+ RAL
+ DCA L31
+ TAD L30
+ RAL
+ DCA L30
+ JMP I LSHIFT
+/ THE FOLLOWING ROUTINE ADDS THE MQ TO THE ACC
+ADD, 0
+ CLA CLL
+ TAD L32
+ TAD L35
+ DCA L32
+ RAL
+ TAD L31
+ TAD L34
+ DCA L31
+ RAL
+ TAD L30
+ TAD L33
+ DCA L30
+ JMP I ADD
+/ THE FOLLOWING ROUTINE SHIFTS THE ACC RIGHT ONE PLACE
+RSHIFT, 0
+ CLA CLL
+ TAD L30
+ RAR
+ DCA L30
+ TAD L31
+ RAR
+ DCA L31
+ TAD L32
+ RAR
+ DCA L32
+ JMP I RSHIFT
+/
+/
+MULT, 0 /ACCCACC*10 MQ
+ JMS RSHIFT
+ JMS XSAVE
+ JMS RSHIFT
+ JMS RSHIFT
+ JMS ADD /THIS FINISHES THE MULT BY 10
+ TAD L37 /NOW DIDDLE THE EXPONENT
+ TAD C40
+ SPA /OVERFLOW TEST
+ERR14, JMS I LUNCH /FLOATING POINT OVERFLOW
+ DCA L37
+ JMS I LNRMAL /MAKE SURE THE F P NUMBER IS STILL IN NORMAL FO
+ JMP I MULT
+DIVIDE, 0 /DIVIDE THE F P NUMBER BY 10
+ JMS RSHIFT /BASED ON THE FACT THAT .1 BASE 10 C .000110011
+ JMS XSAVE /THAT IS WE MULTIPLE BY ONE TENTH
+ TAD C7766 /THIS IS A COUNTER**********************
+ DCA ZCTR
+DB, JMS RSHIFT
+ JMS ADD
+ ISZ ZCTR
+ SKP
+ JMP DC
+ JMS RSHIFT
+ JMS RSHIFT
+ JMS RSHIFT
+ JMS ADD
+ JMP DB
+DC, TAD L37
+ TAD C7750 /********INSERT HERE THE CONSTANT************
+ DCA L37 /WE HAVE JUST DIDDLED THE EXPONENT BY THE PROP
+ JMS I LNRMAL /MAKE SURE IT IS STILL NORMALIZ D
+ JMP I DIVIDE
+ZCTR, 0
+MUL10, 0 /THIS MULTIPLIES THE TRIPLE PREC. INTEGER INT E
+ JMS LSHIFT /BY 10
+ JMS XSAVE
+ JMS LSHIFT
+ JMS LSHIFT
+ JMS ADD
+ TAD L36 /NOW CRAM THE DIGIT THAT WE WANT TO ADD INTO TH
+ DCA L35 /*
+ DCA L34
+ DCA L33
+ JMS ADD /AND ADD IT TO THE ACC
+ JMP I MUL10 /IN OTHER WORDS ACCCACC*10 DIGIT
+POLISH, CLA CLL /THIS TAKES THE SEPARATE MANTISSA AND EXP--ENT.
+ TAD C400 /AND PUTS THEM INTO 7090 FORM. THIS IS THE R-U
+ DCA L35 /27 DIGITS
+ DCA L34 /ROUND FACTOR IS CRAMED INTO THE MQ
+ DCA L33
+ JMS ADD /AND ADDED TO THE INTEGER IN THE ACC
+ SNL /IF THE LINK IS ON, WE OVERFLEW ON THE CARRY
+ JMP POLSH /WE DIDNT
+ TAD C4000 /SET THE ACC TO .1000000000 (THE REST OF IT IS
+ DCA L30
+ TAD L37 /DIDDLE THE EXPONENT BY ONE. THIS IS A FINKIE N
+ TAD J10
+ SNA
+ JMP ERR14 /EXPONENT OVERFLOW ...
+ DCA L37
+POLSH, TAD C7767 /NOW SHIFT THE ENTIRE ACC RIGHT 9 TIMES
+ DCA ZCTR /( THATS SO WE WILL HAVE ROOM TO STICK IN THE E
+HOOP, JMS RSHIFT
+ ISZ ZCTR
+ JMP HOOP
+ TAD L37 /CRAM THE EXP
+ TAD L30 /INTO THE ACC
+ DCA L30 /AND VOILA, WE ARE DONE. GO TAKE THE FPOINT EX
+ JMP I .+1
+ FRET
+LNRMAL, NORMAL
+C7766, 7766
+C7750, 7750
+C400, 400
+J10, 10
+C7767, 7767
+\f *2200
+/ THE FOLLOWING ROUTINE LOOKS FOR A STATEMENT NUMBER
+LSTMT, 0
+ JMS I CLEAR /CLEAR THE PSEUDO ACC AND MQ
+ TAD C7240 /DON'T LET LGTC GET ANOTHER LINE YET(CHK MUST BE NEG., BUT NOT 4000!!)
+ DCA CHK
+ IAC
+ DCA KOUNT
+LABEL, JMS I GTCL /GET A CHARACTER
+ SNA /IS THIS A CAR RET?
+ERR15, JMS I LUNCH /YES, INCOMPLETE STATEMENT
+ TAD CM40
+ SNA /SPACE?
+ JMP SPACE
+ TAD CM32
+ CLL
+ TAD C12
+ SNL / 260 <= CHAR < 272 ?
+ERR16, JMS I LUNCH
+ DCA L36 /SAVE THIS DIGIT...
+ JMS I MULT10 / ACC = 10 * ACC + L36
+SPACE, TAD KOUNT
+ TAD DM6
+ SPA CLA /END OF STMT NR FIELD?
+ JMP LABEL /NOT YET...
+ JMS I GTCL /SKIP OVER COL 6
+ SNA CLA /IS IT A CAR RET?
+ JMP ERR15
+ TAD L31 /SEE IF STMT NR IS LEGAL...
+ SZA
+ JMP ERR16
+ TAD L32
+ SPA CLA /IS STMT NR < 2048 ?
+ JMP ERR16 /NO, STMT NR TOO BIG
+ JMP I LSTMT
+CLEAR, LCLEAR
+GTCL, LGTC
+MULT10, MUL10
+CM32, -32
+DM6, -6
+C12, 12
+/
+/ SUBROUTINEE TO PRINT A SYMBOL
+/
+/ JMS I PRSYM
+/
+LPRSYM, 0 /THIS ROUTINE PRINTS SYMBOLS
+ DCA LCH
+ TAD LCH
+ SMA /IS IT AN INTEGER CONSTANT
+ JMP ICON /YES PROCESS IT
+ RTL /SHIFT THE NEXT BIT INTO THE LINK
+ SNL /IS IT A TEMPORARY
+ JMP TEMPO /ITS A TEMPORARY
+ RTR /RESTORE THE SYMBOL
+ CIA /SET IT NEGATIVE
+ TAD L47 /SUBTRACT THE BEGINNING OF THE XFCON TABLE
+ SPA CLA /DO WE HAVE AN FCON
+ JMP XFCON /YES PROCESS IT
+ TAD LCH
+ TAD C2 /ADD TWO TO THE SYMBOL TABLE POINTER
+ DCA LP2 /AND SAVE IT
+ TAD I LP2 /GET THE CONTROL BITS FOR THE SYMBOL
+ RAR /GET EXTERNAL SUBROUTINE BIT IN LINK
+ SZL CLA /IS THIS AN EXTERNAL SUBROUTINE
+ JMP SKPIT /YES...DONT PUT OUT THE BACK SLASH
+ TAD C34
+ JMS I PRINT
+SKPIT, TAD I LCH
+ JMS LP2 /PRINT THEM
+ ISZ LCH
+ TAD I LCH
+ JMS LP2 /AND PRINT THEM
+ ISZ LCH
+ TAD I LCH
+ AND X7700 /MASK SO WE DONT PUT OUT CONTROL BITS
+ JMS LP2 /AND PRINT IT
+ JMP I LPRSYM /NOW RETURN
+LP2, 0 /THIS IS THE ROUTINE THAT PRINTS TWO CHARACTERS
+ DCA UNCH /SAVE THE CHARS
+ TAD UNCH /GET THEM AGAIN
+ RTR /ROTAT FIRST CHAR INTO POSITION
+ RTR
+ RTR
+ AND C77 /MASK SECOND CHARACTER
+ SZA /IS IT AN ACTUAL CHARACTER
+ JMS I PRINT /YES PRINT IT
+ TAD UNCH /GET THE TWO CHARS AGAIN
+ AND C77 /MASK OUT FIRST CHARACTER
+ SZA /IS IT ACTUALLY A CHARACTER
+ JMS I PRINT /YES PRINT IT
+ JMP I LP2 /AND RETURN
+ICON, CLA /INTEGER CONSTANT, PUNCH A '('
+ TAD K50
+ JMS I PRINT
+ TAD LCH /AND THE NUMBER
+PROCT, JMS I PROTAC
+ JMP I LPRSYM /RETURN
+TEMPO, RTL
+ SPA CLA /SUBSCRIPT TEMPORARY?
+ JMP SBSCR
+ RTL
+ TAD D33 /PUNCH '[' FOR INTEGER AND ']' FOR FLOATING PT
+ JMS I PRINT /AND PRINT IT
+ TAD LCH
+ SPA /DO WE STILL HAVE A TEMPORARY
+ JMS I TEMPOR /YES GET THE TEMPORARY NUMBER
+ JMS I PRINT /AND PRINT IT
+ JMP I LPRSYM /RETURN
+SBSCR, TAD D33 /SUBSCRIPT TEMPORARY, PUNCH A '['
+ JMS I PRINT
+ TAD LCH
+ JMS I SUBTEM /AND 4 DIGITS
+ JMP PROCT
+XFCON, TAD C35 /FLOATING POINT CONSTANT...
+ JMS I PRINT /PUNCH A ']'
+ TAD LCH
+ CIA
+ TAD L50 /SUBTRACT FROM END OF TABLE
+ JMP PROCT
+D33, 33
+C35, 35
+K50, 50
+C34, 34
+X7700, 7700
+LCH, 0
+UNCH, 0
+SUBTEM, LSBTEM
+TEMPOR, LTMPOR
+\f *2400
+/
+/ SUBROUNTINE TO DO SYMBOL TABLE MANIPULATIONS
+/
+C300, 300
+C212, 212
+C215, 215
+SCOUNT, 0 /CURRENT NUMBER OF SYMBOLS
+XCTR, 0 /COUNTER
+FCOUNT, 0 /CURRENT NUMBER OF FCONS
+LSYMTB, 0
+ CLA /CLEAR THE AC
+LOOP1, TAD L56 /GET BEGINNING OF SYMBOL TABLE
+ DCA LSYMTM /AND SAVE IN TABLE
+ TAD SCOUNT /GET NUMBER OF SYMBOLS CURRENTLY
+ CMA
+ DCA XCTR /USE AS A COUNTER
+ TAD C7700 /GIVE SEARCH A MASK TO USE ON LAST SYMBOL
+ JMS SEARCH /LOOK FOR OCCURRENCE OF SYMBOL IN TABLE
+ JMP ZCHECK /SYMBOL IS IN TABLE CHECK IT
+ TAD L57 /TELL ENTER WHERE TO PUT THE SYMBOL
+ JMS ENTER /ENTER THE SYMBOL
+ TAD C3 /UPDATE THE POINTER
+ DCA L57 /AND SAVE IT
+ DCA L21 /ZERO SWITCH SINCE SYMBOL JUST LOADED
+ ISZ SCOUNT /UPDATE COUNT OF SYMBOLS
+ JMP LOOP1 /GO BACK AND CHECK IT
+ZCHECK, TAD L77 /GET POINTER INTO SYMBOL TABLE
+ TAD C2 /MOVE TO LAST WORD
+ DCA LSYMTM /SAVE IT
+ TAD I LSYMTM /GET THE CONTROL BITS
+ AND L21 /AND THE MASK
+ SZA CLA /ARE ANY ILLEGAL BITS ON
+ERR54, JMS I LUNCH /ERROR 54 ... PROBABLY IN EQUIVALENCING ...
+ TAD L32 /NOW OR IN NEW BITS
+ CMA
+ AND I LSYMTM
+ TAD L32
+ DCA I LSYMTM
+ JMP I LSYMTB /RETURN
+/ FLOATING CONSTANT IS IN 30 THRU 32
+LFCON, 0
+ CLA
+MLOOP, TAD L47 /GET BEGINNING OF FCON TABLE
+ TAD C3 /MOVE TO ACTUAL START OF TABLE
+ DCA LSYMTM /AND SAVE
+ TAD FCOUNT /GET NUMBER OF FCONS SO FAR
+ CMA
+ DCA XCTR /AND USE FOR A COUNTER
+ CMA /GIVE SEARCH A MASK FOR THE LAST WORD
+ JMS SEARCH /SEARCH THE TABLE FOR THE CURRENT FCON
+ JMP I LFCON /ITS ALREADY IN THERE JUST RETURN
+ TAD L47 /TELL ENTER WHERE TO PUT THE FCON
+ JMS ENTER /ENTER THE FCON
+ TAD CM3 /AND UPDATE IT
+ DCA L47 /AND SAVE
+ ISZ FCOUNT /UPDATE NUMBER OF FCONS
+ JMP MLOOP /GO BACK AND CHECK
+/ THIS IS THE ROUTINE THAT SEARCHES THE TABLES FOR
+/ OCCURRENCES OF THE CURRENT SYMBOL OR FCON
+SEARCH, 0
+ DCA ENTER /SAVE THE MASK
+MBACK, ISZ XCTR /SEE IF WE HAVE PROCESSED ALL SYMBOLS
+ SKP /NO GO ON
+ JMP QRET /YES
+ TAD I LSYMTM /GET FIRST WORD OF SYMBOL
+ CIA /NEGATE
+ TAD L30 /SUBTRACT FIRST WORD OF CURRENT SYMBOL
+ ISZ LSYMTM /INCREMENT POINTER
+ SZA CLA /DO THEY MATCH
+ JMP I1 /NO GO TO NEXT SYMBOL
+ TAD I LSYMTM /YES GET SECOND WORD OF SYMBOL
+ CIA
+ TAD L31 /SUBTRACT SECOND WORD OF CURRENT SYMBOL
+ ISZ LSYMTM /ADVANCE POINTER
+ SZA CLA /DO THEY MATCH
+ JMP I2 /NO GO TO NEXT SYMBOL
+ TAD I LSYMTM /SEE IF NEXT WORD MATCHES
+ AND ENTER /MASK OUT DESIRED PORTIONS
+ CIA
+ TAD L32 /SUBTRACT THIRD CURRENT WORD
+ AND ENTER /K AGAIN
+ ISZ LSYMTM /ADVANCE POINTER
+ SZA CLA /DO THEY MATCH
+ JMP MBACK /NO GO TO NEXT SYMBOL
+ TAD LSYMTM /YES
+ TAD CM3 /MOVE BACK POINTYER
+ DCA L77 /PUT POINTER IN PAGE ZERO
+ JMP I SEARCH /RETURN
+QRET, ISZ SEARCH /SET UP RETURN FOR NOT FOUND
+ JMP I SEARCH /RETURN
+I1, ISZ LSYMTM /ADVANCE POINTER
+I2, ISZ LSYMTM /ADVANCE PIINTER
+ JMP MBACK /GO TO NEXT SYMBOL
+/ THIS ROUTINE ENTERS THE CURRENT SYMBOL INTO THE TABLE SPECIFIED
+ENTER, 0
+ DCA LSYMTM /SAVE ADDRESS
+ TAD L47 /GET BEGINNING OF FCON TABLE
+ CMA
+ TAD L57 /SUBTRACT END OF SYMBOL TABLE
+C7700, SMA CLA /IS THERE ROOM FOR ANOTHER SYMBOL OR FCON
+ERR17, JMS I LUNCH /NO
+ TAD L30 /YES GEYT FIRST WORD
+ DCA I LSYMTM /STORE IT
+ TAD LSYMTM
+ DCA L11 /SET UP AUTO - XR
+ TAD L31
+ DCA I L11
+ TAD L32
+ DCA I L11
+ TAD LSYMTM /GET THE ADDRESS BACK INTO THE AC
+ JMP I ENTER /AND RETURN
+DUMPLN, DMPLIN
+LSYMTM=.
+LPRINT, 0 / CONVERTS FROM TRIMMED TO EIGHT BIT ASCII
+ DCA LFCON /SAVE THE CHARACTER
+ TAD L75 /S GET THE SUPPRESS PRINTING WITCH
+ SZA CLA
+ JMP I LPRINT
+ ISZ L24 /IS THIS A NEW LINE?
+ SKP /NO
+ JMS I DUMPLN /YES - DUMP THE OLD ONE FIRST
+ TAD LFCON /NO...GET THE CHARACTER
+ SNA /IS IT A CR
+ JMP CRLF /YES...PUT OUT CRLF
+ AND C40 /CHECK BIT SIX
+ CLL RAL
+ CIA /AC CONTAINS 0 OR -100
+ TAD C300 /NOW CONTAINS 300 OR 200
+ TAD LFCON /NOW ADD THE CHARACTER IN
+\fPRIT, DCA I L24 /AND STORE IT IN THE BUFFER
+ JMP I LPRINT
+CRLF, TAD C215 /GET AN EIGHT BIT CR
+ DCA I L24 /STORE IT IN THE BUFFER
+ ISZ L24
+ TAD C212
+ DCA I L24 /STORE A LINE FEED TOO
+ CLA CMA
+ DCA L24 /SET SWITCH TO DUMP LINE ON NEXT CHAR
+ JMP I .+1
+ PRIT+1
+\fLCOMON, CLA
+ JMS I LOOK /CHECK REST OF STATEMENT NAME
+ -2 /TWO CHARACTERS
+ -17 /O
+ -16 /N
+GETVAR, JMS I ENTITY /GET A VARIABLE
+ SKP /NOT A VARIZBLE
+ JMP VARI /WE GOT A VARIABLE
+ NOP
+B20, 20
+ERR18, JMS I LUNCH /ERROR
+VARI, TAD C40
+ TAD L32 /PUT IN COMMON BIT
+ DCA L32
+ TAD K37 /GET MASK FOR SYMBOL TABLE SWITCH
+ DCA L21 /PUT IN THE SWITCH
+ JMS I SYMTAB /PUT SYMBOL IN TABLE
+ JMS I ENTITY /LOOK FOR A COMMA
+ JMP START /THAT'S ALL GOT A CR-LF...
+K37, 37
+K27, 27
+ JMP .+3 /ERROR
+ TAD CM54 /CHECK FOR COMMA
+ SZA CLA /IS IT A COMMA
+ JMP ERR18 /NO...ERROR
+ JMP GETVAR /GET ANOTHER VARIABLE
+LDIMEN, JMS I LOOK /LOOK FOR REST OF STATEMENT
+ -5 /FIVE CHARS
+ -16 /N
+ -23 /S
+ -11 /I
+ -17 /O
+ -16 /N
+QAGAIN, CLA CMA /-U
+ DCA REDY /SET SWITH FOR VARIABLE
+QGET, JMS I ENTITY /GET WHATEVER IS NEXT IN LINE
+ JMP QDONE /IT EAS A CR
+ JMP .+4 /IT WAS A VARIABLE
+ JMP ASUBSC /IT WAS ONE OF THE SUBSCRIPTS
+ JMP ERR18 /WE BETTER NOT GET ANY FP NUMBERS
+ JMP QPUNC /IT WAS A PUNCTION
+ ISZ REDY
+ JMP ERR18 /WE WERENT READY FOR A VAR
+ TAD B20
+ TAD L32
+ DCA L32
+ TAD K27 /GET THE MASK FOR THE SYMBOL TABLE
+ DCA L21 /PUT IN THE SWITCH
+ JMS I SYMTAB /PUT SYMBOL IN TABLE
+ CMA CLA
+ TAD L47 /GET BEGINNING OF TABLE
+ DCA L16
+ TAD L77 /GET TABLE ADDRESS
+ DCA I L16
+ CLA CMA
+ DCA V /SET WITCH TO SAY WEVE GOTTEN A VAR
+ JMP QGET /GET NEXT THING
+QPUNC, TAD CM54
+ SNA /IS IT A COMMA
+ JMP COMMA /YES
+ TAD C3
+ SNA
+ JMP QRPAR /RIGHT PAREN
+ IAC
+ SNA /IS IT A LEFT PAREN
+ ISZ V /PRECEDED BY A VAR
+ JMP ERR18 /NO - ERROR
+ CLA CMA
+ DCA XLP /SET SWITCH TO SHOW LPAR
+ JMP QGET
+ASUBSC, ISZ XLP /DID WE JUST GET LPAR
+ JMP SECOND /NO...BETTER BE SECOND SUBSC
+ TAD L32 /GET INTEGER
+ DCA I L16 /PUT IN DIMTAB
+ CMA CLA
+ DCA QONE /SET SWITCH TO SHOW WE HAVE ONE SUBSC
+ JMP QGET
+COMMA, ISZ QONE /DOES THIS COMMA SEPARATE SUBSCS
+ JMP RIGHT /NO...LAST CHAR BETTER HAVE BEEN L RPAR
+ CMA CLA
+ DCA SEC /SET SWITCH TO EXPECT SECOND SUBSCRIPT
+ JMP QGET
+SECOND, ISZ SEC /IS THIS SECOND SUBSCRIPT
+ JMP ERR18 /NO...ERROR
+ TAD 32 /GET INTEGER
+ DCA I L16
+ CMA CLA
+ DCA R /SET SWITCH FOR RPAR
+ JMP QGET
+QRPAR, ISZ QONE /HAVE WE GOTTEN ONE SUBSC
+ JMP QTWO /NO...CHECK FOR TWO
+ IAC /ONLY ONE SO USE 1 AS SECOND
+ DCA I L16
+QBACK, CMA CLA
+ DCA RIG
+ TAD L47 /GET BEGINNING OF TABLE
+ DCA L50 /SAVE IN LOW CORE
+ TAD L47
+ TAD CM3 /SUBTRACT THREE FROM ADDRESS
+ DCA L47 /AND SAVE
+ JMP QGET /WE EXPECT COMMA OR CR
+QTWO, ISZ R /HAVE WE GOTTEN TWO
+ JMP ERR18 /NO...ERROR
+ JMP QBACK
+RIGHT, ISZ RIG /DID WE JUST GET RPAR
+ JMP ERR18 /NO...ERROR
+ JMP QAGAIN
+QDONE, ISZ RIG
+ JMP ERR18
+ JMP START
+QONE, 0
+RIG, 0
+R, 0
+REDY, 0
+V, 0
+XLP, 0
+SEC, 0
+\f *3000
+LGOTO, TAD L74
+ DCA L16 /USE AUTO INDEXING
+ DCA L76
+ JMS I ENTITY
+ NOP
+ SKP
+ JMP ALAB /WE HAVE A LABEL
+ JMP I ASSIGN
+ TAD CM50 /IF PUNCT...CHECK FOR LEFT PAREN
+ SZA CLA /IS IT (
+ JMP I ASSIGN
+ANEXT, JMS I ENTITY
+ NOP
+ SKP
+ JMP THERE /WE HAVE A LABEL
+ NOP
+ERR28, JMS I LUNCH
+THERE, TAD L32 /GET THE LABEL
+ DCA I L16 /PUT IN LIST
+ ISZ L76
+ JMS I GNB
+ TAD CM54 /CHECK FOR BEING A COMMA
+ SNA /IS IT A COMMA
+ JMP ANEXT /YES GET ANOTHER LABEL
+ TAD C3 /CHECK FOR BEING A RIGHT PAREN
+ SZA CLA /IS IT A )
+ JMP I ASSIGN
+ JMS I GNB
+ TAD CM54 /CHECK FOR ANOTHER COMMA
+ SZA /IS IT ANOTHER
+ JMS I PUTCH /IGNORE ANYTHING ELSE ...
+ JMS I ENTITY /GET THE CONTROL VARIABLE
+ SKP
+ JMP .+4 /WE GOT IT
+ NOP
+ NOP
+ERR29, JMS I LUNCH
+ DCA L21 /ZERO THE SYMBOL TABLE SWITCH
+ JMS I SYMTAB /PUT VARIABLE IN SYMBOL TABLE
+ TAD L77 /GET ADD RESS OF SYMBOL
+ JMS I MODE /CHECK THE MODE OF THE VAIABLE
+ERR30, JMS I LUNCH /ITS FLOATING POINT
+ JMS I ZZZ /PUT OUT STMT LABEL
+ JMS LXTAD /LOAD VARIABLE WITH TAD OR TAD*
+ JMS I PROP /PUT OUT OP CODE
+Q6066, 6066 /OP CODE IS TAD
+ JMS I CREATE /GET THE NEXT CREATED LABEL
+ JMS I PRCRL /PRINT THE CREATED LABEL
+ JMS I PRINT /PUT OUT CR LF
+ JMS I PROP /PUT OUT OP CODE
+ 6071 /OP CODE IS DCA
+ TAD GO7
+ JMS I PROTAC
+ JMS I PRINT /PUT OUT CRLF
+ JMS I PROP /PUNCH 'TAD I 7'
+ OPTADI
+ TAD GO7
+ JMS I PROTAC
+ JMS I PRINT
+ JMS I PROP /PUNCH 'DCA 7'
+ OPDCA
+ TAD GO7
+ JMS I PROTAC
+ JMS I PRINT
+ JMS I PROP /PUNCH 'JMP I 7'
+ OPJMPI
+ TAD GO7
+ JMS I PROTAC
+ JMS I PRINT
+ TAD L76 /PUNCH 'CPAGE <N+1>'
+ IAC
+ JMS I PIFF
+ TAD L53 /PUNCH '<CR.LABEL2>, <CR.LABEL2>'
+ JMS I CLAB
+ TAD L53
+ JMS I PRCRL
+ JMS I PRINT
+ TAD L76 /NOW PUNCH THE LABELS
+ CIA /SET NEGATIVE
+ DCA L76
+ TAD L74
+ DCA L16 /USE AUTO INDEXING AGAIN
+ TAD I L16 /GET THE NEXT LABEL
+ JMS I PLAB /PRINT THE LABEL
+ JMS I PRINT /PUT OUT CRLF
+ ISZ L76
+ JMP .-4 /NO
+ JMP START
+/ THE FOLLOWING SECTION IS TO TREAT REGULAR GOTO S
+ALAB, JMS I ZZZ
+ TAD L32
+ JMS PRJUMP /PUT OUT A JUMP TO THE LABEL IN "L32"
+ JMP START
+
+LXTAD, 0
+ TAD L77 /GET ADDRESS AGAIN
+ JMS I DUMARG
+ TAD CM3
+ TAD Q6066 /TAD OR TAD*
+ DCA OP /USE AS OPERATOR
+ JMS I PROP /PUT OUT OP CODE
+OP, 0
+ TAD L77 /GET ADDRESS AGAIN
+ JMS I PRSYM /PRINT THE SYMBOL
+ JMS I PRINT /PUT OUT A CR LF
+ JMP I LXTAD
+
+LLEAD, 0 /PUNCH SOME LEADER...
+ DCA L7
+ JMS I PUNCH
+ ISZ L7
+ JMP .-2
+ JMP I LLEAD
+GO7, 7
+
+PRJUMP, 0 /SUBROUTINE TO PUT OUT A JUMP
+ DCA LLEAD /STORE THE LABEL
+ JMS I PROP
+ 6044 /JMP
+ TAD LLEAD
+ JMS I PLAB /PUT OUT THE LABEL
+ JMS I PRINT /PUT OUT A CRLF
+ TAD LLEAD
+ DCA L12 /SET CONTENTS OF LAST LINE TO LABEL
+ JMP I PRJUMP
+\f *3200
+/ THE FOLLOWING ROUTINE PUNCHES OCTAL NUMBERS
+
+LPRTAC, 0
+ DCA TMP /SAVE THE NUMBER
+ DCA TM
+ TAD CM4 /PUT OUT FOUR CHARACTERS
+ DCA DCTR /CHARACTER COUNTER
+BK, TAD TMP /GET THE NUMBER
+ RAL /ROTATE IT LEFT ONE
+ RTL /ROTATE TWO LEFT...THAT MAKES ONE OCTAL DIGIT
+ DCA TMP /SAVE THE ROTATED NUMBER
+ TAD TMP /GET IT IN ACCUMULATOR
+ AND C3
+ RAL /GET THE DIGIT INTO THE LOW-ORDER AC
+ ISZ DCTR /IS THIS THE LAST DIGIT?
+ JMP .+4 /NO, CONTINUE
+ TAD C60 /MAKE IT LOOK LIKE A TRIMMED ASCII DIGIT
+ JMS I PRINT /PRINT THE DIGIT
+ JMP I LPRTAC
+ SZA /DO WE HAVE A ZERO DIGIT?
+ JMP .+4
+ TAD TM
+ SNA CLA /YES, IS IT A LEADING ZERO?
+ JMP BK /YES, IGNORE IT
+ TAD C60
+ JMS I PRINT
+ ISZ TM /DON'T SUPPRESS ZEROS ANY MORE
+ JMP BK /NOW...PUT OUT ANOTHER
+TMP, 0
+TM, 0
+CM4, -4
+C60, 60
+LIF, TAD CM4
+ DCA COUNT1 /SET UP COUNTER
+ JMS I GNB
+ TAD CM50 /CHECK FOR LEFT PAREN
+ SZA CLA /IS IT A (
+ JMP I ASSIGN
+ JMS I PUTCH /YES...PUT IT BACK FOR GENER
+ JMS I ZZZ
+ ISZ L52 /SET BALANCED PARENS SWITCH FOR GENER
+ ISZ L44 /SET SWITCH FOR RIGHT SIDE OF EQUALS SIGN
+ JMS I GENER /NOW CALL GENER AND PROCESS EXPRESSION
+ TAD I L41
+ JMS I MODE /WHAT IS ITS MODE
+ JMS I GETHI /GET HI ORDER P.P. AC
+ TAD CDCA41
+ DCA LIFDCA /SET UP INSTRUCTION TO STORE LABELS
+LABL, JMS I ENTITY /GET A LABEL
+D34, 34
+ SKP
+ JMP INTEG /WE GO A LABEL
+C46, 46
+ERR31, JMS I LUNCH /DIDNT GET A LABEL
+INTEG, TAD L32 /GET THE LABEL
+ ISZ LIFDCA
+LIFDCA, .-. /STORE LABELS IN L42 THROUGH L44
+ DCTR=LIFDCA
+ ISZ COUNT1 /HAVE WE GOTTEN TOO MANY LABELS
+ SKP /NO
+ JMP ERR31 /YES
+ JMS I GNB
+ SNA /SEE IF ITS A CR
+ JMP .+5 /ITS A CR
+ TAD CM54 /CHECK FOR COMMA
+ SZA CLA /IS IT A COMMA
+ JMP ERR31
+ JMP LABL /YES
+ ISZ COUNT1 /DID WE GET THE RIGHT NUMBER OF LABELS
+ JMP ERR31 /NO
+ TAD L42
+ CIA
+ TAD L44
+ SNA CLA /IF THE JUMPS FOR AC<0 AND AC>0 ARE EQUAL
+ JMP ISPECL /WE CAN SAVE SOME CODE
+ TAD L43
+ CIA
+ TAD L44
+ SNA CLA /IF THE JUMPS FOR AC=0 AND AC>0 ARE EQUAL
+ JMP SPCONL /WE CAN ALSO SAVE SOME CODE
+ JMS I PROP /PUT OUT OP CODE
+ 6105 /OP CODE IS SNA
+ JMS I PRINT /PUT OUT CRLF
+ TAD L43
+ JMS I PRJMP /OUTPUT THE ZERO BRANCH
+SPCONL, JMS I PROP /PUT OUT OP CODE
+ 6110 /OP CODE IS P SPA CLA
+ JMS I PRINT /PUT OUT CRLF
+ TAD L42 /OUTPUT THE NEGATIVE BRANCH
+IFCOMN, JMS I PRJMP
+ TAD L44
+ JMS I PRJMP /OUTPUT THE POSITIVE (>0) BRANCH
+ DCA L46 /ZERO AC
+ JMP START /GO GET NEXT STATEMENT
+ISPECL, JMS I PROP /PUNCH 'SNA CLA'
+ OPSNA
+ JMS I PROP
+ OPCLA
+ JMS I PRINT
+ TAD L43
+ JMP IFCOMN /OUTPUT THE ZERO AND POSITIVE BRANCHES
+PRJMP, PRJUMP
+COUNT1, 0
+LCREAT, 0
+ ISZ L53 /INCREMENT BY ONE...
+ TAD L53
+ AND C77
+ TAD CM33
+ SMA CLA /HAVE WE BEEN HERE 26 TIMES?
+ TAD C46 /YES, BUMP THE HIGH ORDER DIGIT
+ TAD L53
+ DCA L53 /AND SAVE
+ TAD L53 /NOW RETURN IT IN AC
+ JMP I LCREAT /RETURN
+LPLAB, 0 /THIS PRINTS REGULAR LABELS
+ DCA TMP /FIRST SAVE LABEL
+ TAD D34 /NOW PUNCH A '\'
+ JMS I PRINT
+ TAD TMP /GET LABEL
+ JMS I DECOUT /AND PRINT IT
+ JMP I LPLAB /RETURN
+GETHI, LGETHI
+CDCA41, DCA L41
+CM33, -33
+DECOUT, LDCOUT
+
+/TELETYPE OUTPUT ROUTINE FOR ERROR MESSAGES
+LTTYPE, 0
+ TSF
+ JMP .-1
+ TLS
+ CLA
+ JMP I LTTYPE
+
+\f *3400
+DORET, JMP I XDO
+ISZDO, JMS I PROP
+ 6170 /ISZ
+ TAD L30
+ JMS I PRSYM
+ JMS I PRINT
+ JMP DOSUBT /GO GENERATE THE LIMIT TEST
+NUMB, 0
+SWIT, 0
+DM5, -5
+CM24, -24
+C5001, 5001
+LEQI, EQI
+
+LDO, JMS I ZZZ
+ JMS I ENTITY /LOOK FOR THE SCOPE LABEL
+C55, 55
+ SKP
+ JMP SLAB /WE GOT THE SCOPE LABEL
+E53, 53
+ JMP I ASSIGN
+SLAB, TAD L32 /GET THE INTEGER
+ JMS XDO /PUT OUT DO-LOOP CODE
+ JMP START /NORMAL EXIT
+ JMP ERR35 /IMPLIED DO EXIT - ERROR
+
+XDO, 0 /DO LOOP SUBROUTINE - ENTERED WITH
+ /TARGET LABEL IN AC
+ DCA I L15 /PUT IN DO END PUSH DOWN LIST
+ TAD L74
+ DCA L16 /SET UP LIST OF DO ENDS
+ DCA L21 /ZERO THE SYMBOL TABLE SWITCH
+ CMA CLA
+ DCA SWIT /SET SWITCH FOR CONTROL VARIABLE
+ TAD DM5
+ DCA NUMB /SET COUNTER OF NUMBER OF PARAMETERS
+GETMOR, JMS I ENTITY /LOOK FOR A PARAMETER
+ JMP .+3 /ERR
+ JMP CVAR /GOT A VARIABLE
+ JMP DPAR /GOT AN INTEGER
+C21, 21
+ JMP ERR35
+CVAR, JMS I SYMTAB /PUT SYMBOL IN TABLE
+ TAD L77 /GET ADDRESS
+ JMS I MODE /DETERMINE MODE OF SYMBOL
+ JMP ERR35
+ TAD L77 /GET ADDRESS AGAIN
+DOSTOR, DCA I L16 /SAVE
+ ISZ NUMB /HAVE WE GOTTEN TOO MANY PARAMS
+ SKP /NO
+ERR35, JMS I LUNCH /YES, DO ERROR ...
+ JMS I GNB
+ SNA /IS IT CR
+ JMP ALLDNE+1 /YES WERE DONE
+ TAD CM51
+ SNA /IS IT A RIGHT PAREN?
+ JMP ALLDNE /YES-FINISH UP AND TAKE IMPLIED DO EXIT
+ TAD CM24
+ SZA /IS IT =
+ JMP MCOM /NO
+ ISZ SWIT /IS SWITCH SET FOR IT
+ JMP ERR35 /NO
+ JMP GETMOR /YESS...GO BACK FOR ANOTHER PARAMETER
+MCOM, TAD C21 /CHECK FOR COMMA
+ ISZ SWIT /IF NO EQUAL SIGN YET
+ SZA /OR IF THIS ISN'T A COMMA
+ JMP ERR35 /THEN ITS AN ERROR
+ JMP GETMOR /GET ANOTHER
+DPAR, TAD L32 /GET THE INTEGER
+ ISZ SWIT /HAVE WE SEEN AN EQUAL SIGN?
+ JMP DOSTOR /YES - SAVE THE INTEGER AND PROCEED
+ JMP ERR35 /NO
+ALLDNE, ISZ XDO /BUMP RETURN POINTER IF TERMINATOR WAS RPAR
+ CLA IAC
+ DCA I L16 /STORE A ONE IN THE FOURTH (OR FIFTH) ARGUMENT
+ TAD C2
+ TAD NUMB
+ SPA CLA /DID WE GET AT LEAST THREE ARGS?
+ JMP ERR35 /NO
+ ISZ L44
+ TAD L74 /GET ERASABLE LOCATIONS
+ DCA L16 /USE THE AUTO INDEX REGISTERS
+ TAD I L16 /GET CONTROL VARIABLE
+ DCA L30 /AND PUT IN THIRTY
+ TAD I L16 /GET INITIAL VALUE
+ DCA L31 /AND SAVE IT
+ TAD I L16 /GET FINAL VALUE
+ DCA L32 /AND SAVE IT
+ TAD I L16 /GET INCREMENT
+ DCA L33 /AND SAVE IT
+ TAD L74 /GET ADDR OF ERASABLE AGAIN
+ IAC /INCREMENT ONCE
+ DCA L41 /TELL TRIPL WHERE TO FIND THE DUMMY TRIPLES
+ TAD L74 /GET IT AGAIN
+ DCA L16 /USE AUTO INDEX TO STORE TRIPLE
+ DCA L46 /ZERO THE AC
+ TAD C5001 /SET UP INITIAL TRIPLE NUMBER
+ DCA L40
+ TAD L33
+ CIA
+ TAD L31
+ SNA CLA /IF INITIAL VALUE = STEP SIZE
+ JMP STCTLV /NO NEED TO COMPUTE THE DIFFERENCE
+ TAD L33 /GET STEP SIZE
+ DCA I L16 /PUT IN TRIPLE
+ TAD C55 /PUT IN A MINUS SIGN
+ DCA I L16
+ TAD L31 /GET INITIAL VALUE
+ DCA I L16
+ JMS I TRIPL /PROCESS THE TRIPLE
+STCTLV, JMS I LEQI /STORE ANSWER IN CONTROL VARIABLE
+ JMS I CLAB /PUT A CDREATED LABVEL ON THE NEXT STATEMENT
+ TAD L53 /GET THE CREATED LABEL
+ DCA I L15 /AND PUT IN DO END LIST
+ TAD L74
+ DCA L16
+ TAD L33 /GET STEP SIZE
+ CLL RAR
+ SNA /IF STEP SIZE=1 THEN
+ JMP ISZDO /WE CAN USE AN ISZ TO INCREMENT
+ RAL
+ DCA I L16
+ TAD E53 /WERE GOING TO ADD
+ DCA I L16
+/ L30 IS IN THE THIRD POSITION SINCE WE CALLED "EQI"
+ JMS I TRIPL /ADD STEP SIZE TO CONTROL VARIABLE
+ JMS I LEQI /STORE ANSWER IN CONTROL VARIABLE
+DOSUBT, TAD L74
+ DCA L16
+ TAD L30 /GET THE CONTROL VARIABLE
+ DCA I L16
+ TAD C55 /WERE GOING TO SUBTRACT
+ DCA I L16
+ TAD L32 /GET FINAL VALUE
+ DCA I L16
+ JMS I TRIPL /SUBTRACT CONTROL VARIABLE FROM FINAL VALUE
+\f DCA L46 /CLEAR THE AC FLAG
+ JMS I PROP
+ 6110 /SPA CLA
+ JMS I PRINT
+ JMS I PROP
+ 6044 /PUT OUT A JMP
+ JMS I CREATE /TO A CREATED LABEL
+ DCA I L15 /PUT CREATED LABEL IN DO END LIST
+ TAD L53 /GET LABEL
+ JMS I PRCRL /AND PRINT IT
+ JMS I PRINT /CRLF
+ ISZ L55 /INCREMENT UNENDED DO COUNTER
+ SKP
+ERR38, JMS I LUNCH /TOOO MANY UNENDED DOS
+ JMP I .+1
+ DORET /RETURN FROM SUBROUTINE "XDO"
+
+EQI, 0
+ TAD L74
+ DCA L16
+ TAD L46 /GET RESULT OF PREVIOUS COMPUTATION
+ DCA I L16
+ TAD E75 /GET EQUALS SIGN
+ DCA I L16
+ TAD L30 /GET CONTROL VARAIBLE
+ DCA I L16
+ JMS I TRIPL /PROCESS
+ DCA L46 /WIPE AC SWITCH
+ JMP I EQI /RETURN
+LFUNCT, 0
+ DCA ARGCNT
+ TAD L46 /GET AC
+ SZA CLA /IS IT ZERO
+ JMS I STORE /NO...STORE THE AC
+ TAD L53 /GET CURRENT CREATED LABEL
+ DCA L73 /AND SAVE
+ CLA CMA /AC IS MINUS ONE
+ TAD L41 /PUSH LIST POINTER
+ DCA L42 /PUSH LIST POINTER MINUS ONE
+CKFNCT, ISZ L42 /INCREMENT POINTER
+ ISZ L42 /AGAIN
+ TAD I L42 /GET THE OPERATOR
+ TAD CM4047 /SUBTRACT THE FUNCTION OPERATOR
+ SZA /IS THIS THE FUNCTION OPERATOR
+ JMP CKSBSC /NO
+ CLA IAC /YES...THE FUNCTION NAME IS IN THE NEXT LOCATIO
+ TAD L42 /THIS POINTS TO IT
+ DCA SAVE /AND SAVE
+ TAD I SAVE
+ TAD C2
+ DCA EQI
+ TAD I EQI
+ AND CM2
+ IAC
+ DCA I EQI
+MOR, CLA CMA /NOW EXAM THE ARGUMENTS
+ TAD L42 /WERE POINTING TO THE FIRST ARGUMENT
+ DCA L42 /SAVE THE POINTER
+ ISZ ARGCNT
+ JMS I LCHNG /CHECK L42 FOR ZERO OR DUMMY ARG
+ DCA I L42 /REPLACE IT BY UPDATED VALUE
+ TAD L42 /IT WASNT...SEE IF IT WAS THE LAST ARGUMENT
+ CIA
+ TAD L41 /SUBTRACT THE END OF ARGUMENT LIST
+ SNA CLA /IS IT ZERO
+ JMP OUT /YES...WE'VE COMPLETED THIS PHASE
+ CLA CMA /NO...MOVE THE POINTER BACK ONE
+ TAD L42
+ DCA L42 /AND SAVE
+ JMP MOR /NOW CHECK THE NEXT ARGUMENT
+OUT, TAD SAVE /GET THE POINTER TO THE FUMCTION NAME AGAIN
+ DCA L42 /AND PUT IN 42
+ TAD I L42 /GET THE ARGUMENT
+ DCA FUNOP /USE FPROP TO PUT OUT THE CALL TO THE FUNCTION
+ TAD ARGCNT /GIVE FPROP THE NUMBER OF ARGUMENTS
+ JMS I FPROP /PUT OUT THE CALL TO THE FUNCTION
+FUNOP, 0
+ TAD L73 /NOW RESTORE THE CREATED LABEL LOCATION
+ DCA L53
+MNEXT, TAD L42 /GET THE POINTER
+ TAD CM2 /MOVE POINTER TO ARGUMENT
+ DCA L42 /AND SAVE
+ TAD I L42 /GET NEXT ARGUMENT
+ JMS I PSYMOT /GENERATE AN "ARG" FOR THE ARGUMENT
+ TAD L42 /GET THE POINTER
+ CIA /SET IT NEGATIVE
+ TAD L41 /ADD
+ SZA CLA /ARE THEY EQUAL
+ JMP MNEXT /NO THERE ARE MORE ARGS
+ TAD I SAVE /YES...GET THE FUNCTION NAME
+ JMS I MODE /WHAT MODE IS IT
+ TAD E400 /ITS FLOATING POINT
+ TAD L40 /ITS INTEGER
+ DCA L46 /PUT THE TRIPLE NUMBER IN THE AC SWITCH
+ TAD SAVE /YES...CHANGE PUSH LIST POINTER
+ DCA L41 /STORE POINTER TO NAME IN PUSH LIST POINTER
+ TAD L46 /GET CURRENT TRIPLE NUMBER
+ DCA I L41 /AND PUT IT IN THE PUSH LIST
+ JMP I LFUNCT /RETURN
+CKSBSC, IAC
+ SZA CLA /IS IT THE SUBSCRIPT OPERATOR?
+ JMP I CKF /NO - KEEP LOOKING
+ JMP I .+1
+ ERR39
+PSYMOT, SYMOUT
+SAVE, 0
+ARGCNT, 0
+E75, 75
+CM4047, -4047
+E400, 400
+
+ TAD C47
+ JMS I PPACK
+LQUOTE, JMS I PGTC /GET A CHARACTER
+ SNA
+ERR37, JMS I LUNCH /CARRIAGE RETURN - ERROR
+ TAD CM47
+ SZA
+ JMP LQUOTE-2 /IF NOT A QUOTE, STORE IT
+ JMP I .+1
+ FRET
+C47, 47
+CM47, -47
+PGTC, LGTC
+PPACK, PACK
+CKF, CKFND
+\f *4000
+LCONT, JMS I LOOK /CHECK REST OF LINE
+ -4 /LOOK FOR FOUR CHARACTERS
+ -11 /I
+ -16 /N
+ -25 /U
+ -5 /E
+ JMS I ZZZ
+ JMS I PROP /PUNCH 'NOP'
+ 6047
+ JMS I PRINT /PUT OUT A CRLF
+ JMP START /GO GET NEXT STATEMENT
+
+LPAUSE, JMS I LOOK /CHECK REST OF STATEMENT TYPE
+ -1 /JUST ONE CHARACTER
+ -5 /E
+ CLA CMA
+LSTOP, DCA SW /SET SWITCH FOR STOP OR PAUSE
+ DCA L32
+ JMS I ENTITY /LOOK FOR THE OPTIONAL INTEGER
+ JMP MCR /WE GOT A CR
+ SKP /ERR
+ JMP .+3 /WE GOT AN INTEGER
+ NOP /ERR
+ JMP I ASSIGN
+
+MCR, JMS I ZZZ
+ ISZ SW /PAUSE OR STOP?
+ JMP STOP
+ JMS I FPROP /PUNCH 'CALL 0,CKIO'
+ 6116
+ JMS I PROP /PRINT OP CODE
+ 6066 /OPCODE IS TAD
+ TAD L32 /GET THE INTEGER
+ JMS I PRSYM /PRINT IT
+ JMS I PRINT /CR
+ JMS I PROP
+ 6121
+ JMS I PRINT
+ JMS I PROP
+ 6124
+ JMS I PRINT /PUT OUT CRLF
+ JMP START /GO GET NEXT STATEMENT
+
+STOP, JMS OSTOP
+ JMP START
+
+OSTOP, 0 /PUNCH 'CALL 0,CKIO'
+ JMS I FPROP
+ 6116
+ JMS I CLAB /PUNCH '<LAB>, HLT'
+ JMS I PROP
+ 6121
+ JMS I PRINT
+ JMS I PROP /PUNCH 'JMP <LAB>'
+ 6044
+ TAD L53
+ JMS I PRCRL
+ JMS I PRINT
+ JMP I OSTOP
+
+SW, 0
+LFRMAT, JMS I LOOK /CHECK REST OF STATEMENT TYPE
+ -2 /TWO CHARACTERS
+ -1 /A
+ -24 /T
+ ISZ OSTOP
+ TAD L74
+ DCA L10
+ DCA L76
+ JMS I PROP
+ 6044
+ JMS I CREATE
+ JMS I PRCRL
+ JMS I PRINT
+ JMS I GNB /READ UNTIL A PAREN IS GOTTEN
+ TAD CM50 /SUBTRACT A (
+ SZA CLA /IS IT A (
+ERR39, JMS I LUNCH /NO...ILLEGAL CHARACTER
+ TAD C50 /GET A LEFT PAREN
+ JMP PAREN /AND GO START COUNTING PARENS
+AGAIN, JMS I GTC
+ SNA /IS IT A CR
+ JMS I PUTCH
+PAREN, RTL CLL /SHIF CHAR LEFT
+ RTL
+ RTL
+ DCA L32 /SAVE THE CHAR
+ JMS I GTC
+ SNA /IS IT A CR
+ DCA OSTOP
+ TAD L32 /PACK THE TWO CHARS (SOME DONE AT FRMTCK)
+ JMP I FRMTCK /GO CHECK IF FORMAT STMT. TOO BIG
+FRMT, TAD OSTOP /GET BALANCED PAREN SWITCH
+ SZA CLA /ARE THEY BALANCED
+ JMP AGAIN /NO GET SOME MORE CHARS
+ TAD L76
+ JMS I PIFF
+ TAD L74
+ DCA L10
+ TAD L76
+ CIA
+ DCA L76
+ JMS I ZZZ
+ TAD I L10
+ JMS I PROTAC
+ JMS I PRINT
+ ISZ L76
+ JMP .-4
+ TAD L53 /PUNCH '<LABEL>,'
+ JMS I CLAB
+ JMS I PRINT
+ JMP START
+GTC, LGTC
+PXSUBR, XXSUBR
+C50, 50
+
+LPIFF, 0 /PUNCH 'IFF <N>'
+ DCA LZZZ /ENTER WITH N IN THE AC
+ JMS I PROP
+ 6102
+ TAD LZZZ
+ JMS I PROTAC
+ JMS I PRINT
+ JMP I LPIFF
+
+LZZZ, 0 /PUNCH THE CURRENT LABEL, IF ANY
+ TAD L54
+ SNA /IS THERE A LABEL?
+ JMP ZZZRET /NO
+ JMS I PLAB /PUNCH '<LABEL>, '
+ TAD C7240
+ JMS I P2
+ZZZRET, DCA I PXSUBR /MAKE SUBROUTINES AND FUNCTIONS ILLEGAL
+ JMP I LZZZ
+FRMTCK, CKFRMT
+\f *4200
+LTRIPL, 0
+ JMS I XZQL /FIRST CHECK IF A TRIPLE IS LEGAL HERE
+ TAD L41 /GET PUSH LIST POINTER
+ IAC /INCREMENT TO POINT TO OPERATOR
+ DCA L42 /OPERATOR POINTER
+ TAD L42 /GET IT AGAIN
+ IAC /INCREMENT IT
+ DCA L43 /OPERAND TWO POINTER
+ TAD I L42 /GET OPERATOR
+ AND C77 /MASK GARBAGE BITS
+ TAD CM41 /SUBTRACT AN ADD INDIRECT OPERATOR
+ SNA CLA /IS OPERATOR <DOLLAR>
+ JMP I LADDIN /YES PROCESS IT
+ TAD I L43 /NO...GET OPERAND TWO
+ JMS I DUMARG /SEE IF ITS A DUMMY ARGUMENT
+ SKP /YES IT IS
+ JMP CK2 /NO ..CHECK THE OTHER ARGUMENT
+ TAD I L42 /YES GET THE OPERATOR
+ AND C77 /MASK GARBAGE BITS
+ TAD EM75 /IS IT AN EQUALS SIGN
+ SNA /IS OP C
+ JMP LEQUIN /YES USE C*
+ IAC /SEE IF ITS ALREADY EQUALS INDIRECT
+ SZA CLA /IS OP C*
+ JMS I LDUMTW /YES TWO IS DUMMY ARG
+CK2, CLA
+ TAD I L41 /NO IS OPND ONE A SYMBOL
+ JMS I DUMARG /SEE IF ITS A DUMMY ARGUMENT
+ JMS I LDUMON /IT IS
+ CLA CLL /NOW LETS SEE WHAT THE OPERATOR IS
+ TAD I L42 /GET THE OPERATOR
+ AND C77 /MASK OUT GARBAGE BITS
+ TAD CM53
+ SNA /IS IT
+ JMP I LAADD /YES
+ IAC
+ SNA /IS IT *
+ JMP I LMUL /YES
+ TAD CM3
+ SNA /IS IT -
+ JMP I LASUB /YES
+ TAD CM2
+ SNA /IS IT /
+ JMP I LDIV /YES
+ TAD CM16
+ SNA /IS IT C
+ JMP I LEQU /YES
+ IAC
+ SNA /IS IT C*
+ JMP I LEIND /YES
+ TAD J27
+ SNA /IS IT **
+ JMP I LEXP /YES
+ TAD C2
+ SNA /IS IT A UNARY MINUS
+ JMP I LUMIN /YES
+ERR40, JMS I LUNCH /NO BETTER COP OUT
+LDMARG, 0
+ SMA /IS HIGH ORDER BIT ON
+ JMP INC /NO...ITS NEITHER A SYMBOL OR A TRIPLE NUMBER
+ RAL /GET NEXT BIT
+ SMA /IS IT ON
+ JMP MAYBE /NO...WE MIGHT HAVE A SUBSCRIPT THOUGH
+ RAR /YES...RESTOR THE PARAMETER
+ CIA /SET IT NEGATIVE
+ TAD L47 /SUBTRACT IT FROMTHE START OF THE FCON TABLE
+ SPA /IS THE RELULT POSITIVE
+ JMP INC /NO...ITS AN FCON NOT A SYMBOL
+ CIA /YESS...RESTORE ORIGINAL PARAMETER
+ TAD L47
+ TAD C2 /YES MOVE POINTER TO CONTROL BITS
+ DCA L23 /SAVE
+ TAD I L23 /GET THE CONTROL BITS
+ AND C10 /MASK ALL BUT DUMMY ARG BIT OUT
+INC1, SNA CLA /IS THIS SYMBOL. A DUMMY ARG
+INC, ISZ LDMARG /NO...INCREMENT THE RETURN
+ CLA /CLEAR THE ACCUMULATOR
+ JMP I LDMARG /AND RETURN
+MAYBE, AND F400 /MASK THE SUBSCRIPT BIT OF THE TRIPLE NUMBER
+ JMP INC1 /AND CHECK BECAUSE WE TREAT SUBSCS AS DUMMY ARG
+ARET, JMP I LTRIPL /THIS IS THE RETURN FROM TRIPLE
+
+LEQUIN, TAD C74
+ DCA I L42 /SET OP TO =*
+ JMP CK2
+C74, 74
+/
+/ THIS ROUTINE CHECKS THE REST OF THE CHARS FOR A STATEMENT
+LLOOK, 0
+ JMS GLOOK /GET CHARACTER COUNT
+ DCA LTRIPL
+ABACK, JMS I GNB
+ JMS GLOOK /ADD IN THE TEST CHAR
+ SZA CLA /WERE THEY EQUAL
+ JMP I ASSIGN /NO...IT MUST BE AN ASSIGNMENT STATEMENT
+ ISZ LTRIPL /THEY MATCH...ARE WE DONE
+ JMP ABACK /NO
+ JMP I LLOOK /RETURN
+
+GLOOK, 0
+ CDF 10
+ TAD I LLOOK
+ ISZ LLOOK
+ CDF 00
+ JMP I GLOOK
+/
+LAADD, AADD
+LADDIN, ADDIND
+LASUB, ASUB
+LEQU, EQU
+LEIND, EIND
+LEXP, EXP
+LUMIN, UMIN
+CM41, -41
+EM75, -75
+LDUMTW, DUMTWO
+CM16, -16
+C10, 10
+F400, 400
+LDUMON, DUMONE
+CM53, -53
+LMUL, MUL
+LDIV, DIV
+XZQL, LXZQ
+J27, 27
+
+CKFND, TAD L42 /SEE IF POINTER IS INTO SYMB. TABLE
+ TAD K2000 /(IT HAS HAPPENED!)
+ SZA CLA
+ JMP I CKFNCP
+ JMP I .+1 /YES-ERROR
+ ERR39
+CKFNCP, CKFNCT
+K2000, 2000
+\f *4400
+ / FIGURE OUT WHATS IN AC
+LCHECK, 0
+ TAD L46 /GET WHATS IN THE AC
+ CIA /SET NEGATIVE
+ TAD I L41 /SUBTRACT
+ SNA CLA /ARE THEY EQUAL
+ JMP ONE /YES
+ TAD L46 /GET AC AGAIN
+ CIA /SET NEGATIVE
+ TAD I L43 /SUBTRACT TWO
+ SNA CLA /ARE THEY EQUAL
+ JMP TWO /YES
+ TAD L46 /GET THE AC
+ SNA CLA /IS IT ZERO
+ JMP NONE /NO YES YES YES
+ JMP SOME /JUST SIMETHING IN AC
+ONE, ISZ LCHECK
+NONE, ISZ LCHECK
+SOME, ISZ LCHECK
+TWO, JMP I LCHECK
+
+/ FINDS TEMPORARY THAT TRIPLE NUMBER IS ASSIGNED TO
+
+LTMPOR, 0
+ DCA LFPROP /SAVE TRIPLE NUMBER
+ TAD LFPROP
+ JMS I MODE /DETERMINE ITS MODE
+ TAD C30 /FLOATING POINT
+ TAD TTAB /INTEGER
+ DCA LCHECK
+ TAD CM30
+ DCA FOP /SET UP COUNT FOR SEARCH
+LTLP1, TAD I LCHECK
+ CIA
+ TAD LFPROP
+ SNA CLA /IS THIS THE ONE?
+ JMP ZEROIT /YES - ZERO IT OUT AND RETURN IT
+ ISZ LCHECK
+ ISZ FOP
+ JMP LTLP1 /LOOP OVER ENTIRE TABLE
+ TAD LCHECK /NOT FOUND - WE HAVE TO ASSIGN IT
+ TAD CM30
+ DCA LCHECK /RESET POINTERS FOR ZERO SEARCH
+ TAD CM30
+ DCA FOP
+LTLP2, TAD I LCHECK
+ SNA CLA /IS THIS TEMPORARY FREE?
+ JMP TEMPTY /YES
+ ISZ LCHECK
+ ISZ FOP
+ JMP LTLP2 /CHECK THEM ALL
+ERR41, JMS I LUNCH /OUT OF TEMPORARIES
+TEMPTY, TAD LCHECK
+ CIA
+ TAD L45
+ SNA CLA /ADJUST THE NUMBER OF FLOATING POINT TEMPS
+ ISZ L45
+ TAD LCHECK
+ CIA
+ TAD L51
+ SNA CLA /ADJUST THE NUMBER OF INTEGER TEMPS
+ ISZ L51
+ TAD LFPROP /STORE TRIPLE NUMBER IN THIS TEMPORARY SLOT
+ZEROIT, DCA I LCHECK
+ TAD FOP
+ TAD C31 /GET POSITIVE NUMBER FROM TABLE COUNTER
+ JMP I LTMPOR /RETURN
+C31, 31
+
+LFPROP, 0 /THIS ROUTINE PUNCHES SUBROUTINE CALLS
+ DCA FOP /SAVE THE NUMBER OF ARGUMENTS
+ JMS I PROP
+ 6113 /PUT OUT THE CALL
+ TAD FOP /GET THE NUMBER OF ARGUMENTS
+ JMS I PROTAC /PRINT IT
+ TAD C54 /GET A COMMA
+ JMS I PRINT /PRINT IT
+ CDF 10
+ TAD I LFPROP
+ CDF 00
+ JMS I PRSYM
+ JMS I PRINT
+ ISZ LFPROP /INCREMENT RETURN
+ JMP I LFPROP /RETURN
+FOP, 0
+/ COME HERE IF OP IS -
+ASUB, JMS I SMODE /MAKE SURE THAT BOTH ARGS ARE OF SAME MODE
+ TAD I L43 /GET OPERAND TWO
+ JMS I MODE
+ JMP FSUB /ITS FLOATING POINT
+ JMS LCHECK /ITS INTEGER...CHECK WHATS IN THE AC
+ JMP STWO /TWO IS IN THE AC
+ JMS I STORE /SMETHING IS IN THE AC
+ JMS I LADDON /NOTHING IS IN THE AC...ADD ONE TO IT
+ASBCMN, JMS I LCOMP /ONE IS IN AC...COMPLEMENT IT
+ JMS I LADDTW /ADD TWO TO IT
+ JMP I LRETUR /AND RETURN
+STWO, JMS I LCOMP /TWO IS IN AC...COMPLEMENT IT
+ JMS I LADDON /ADD ONE TO IT
+ JMS I LCOMP /AND COMPLEMENT IT AGAIN
+ JMP I LRETUR /AND RETURN
+FSUB, JMS LCHECK /FLOATING POINT...CHECK THE AC
+ JMP FS /TWO IS IN AC
+ JMS I STORE /SOMETHING IN AC...STORE IT
+ JMP FAS /NOTHING IN AC
+ JMP ASBCMN /ONE IS IN AC - COMPLEMENT AND ADD TWO
+FAS, JMS I LADDTW /NOTHING IN AC...ADD TWO IN
+FS, IAC /WE HAVE ONE ARG
+ JMS I FPROP
+ 6011
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ TAD I L41 /GET ARGUMENT ONE
+IRET, JMS I PRSYM /AND PUT IT OUT
+ JMS I PRINT /PUT OUT CRLF
+ JMP I LRETUR
+TTAB, ITTAB /THIS IS THE STARTING ADDRESS OF THE TEMP TABLE
+LCOMP, COMP
+LADDON, ADDONE
+C30, 30
+CM30, -30
+LRETUR, RETURN
+LADDTW, ADDTWO
+
+/CHECK SIZE OF FORMAT STMT.
+/
+CKFRMT, DCA I L10 /CONTINUE PACK ROUTINE
+ ISZ L76
+ TAD L76
+ TAD M174 /IS IT TOO BIG
+ SMA CLA
+ JMP I ILCON /YES-GIVE IT ILLEGAL CONT. MESSAGE
+ JMP I LFRMT /NO-GO BACK
+LFRMT, FRMT
+M174, -174
+ILCON, ERR1 /ILLEGAL CONTINUATION MESSAGE
+\f *4600
+/ PROCESS *
+ADDIND, JMS I CHECK /CHECK WHATS IN THE AC
+ NOP /TWO IS IN AC
+ SKP /N SOMETHING IS IN AC
+ SKP /NOTHING IS IN AC
+ JMS I STORE /STORE WHATEVER IS IN AC
+ TAD I L41 /GET OPERAND ONE
+ JMS I MODE /WHAT MODE IS IT
+ JMP FLOT /YES IT FLOATING POINT
+ JMS I PROP /IST INTEGER...
+ 6063 /PUT OUT A TAD*
+LOOP6, TAD I L41 /GET THE FIRST OPERAND AGAIN
+ JMP I LIRET /GO TO THE RETURN ROUTINE
+FLOT, IAC /WE ONLY HAVE ONE ARG
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+ 6132 /PUT OUT A CALL TO FLOATING INDIRECT ADD
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ JMP LOOP6 /AND JUMP BACK
+/ THIS PUTS OUT OPCODES FOR AN ADD
+ADDL, 0
+ CLL RAR
+ SNA /TEST FOR 0 OR 1
+ JMP ADSPCL
+ RAL /NOT 0 OR 1, TREAT NORMALLY
+ JMS I MODE /WHAT MODE ARE WE IN
+ JMP LOOP7 /YES
+ JMS I PROP /PUT OUT A TAD
+ 6066
+ JMP I ADDL /RETURN
+LOOP7, IAC /WE ONLY HAVE ONE ARGUMENT
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+ 6003 /PUT OUT A FLOATING ADD
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ JMP I ADDL /AND RETURN
+ADSPCL, ISZ ADDL
+ ISZ ADDL /BUMP RETURN POINT PAST ARGUMENT TO "TAD"
+ SNL /0?
+ JMP I ADDL /YUP - DON'T PUT OUT NUTTIN
+ JMS I PROP
+ OPIAC /PUT OUT "IAC"
+ JMP I ADDL
+
+/ STORES CONTENTS OF AC IN TEMPORARY
+/ PUT OUT DCA OR CALL STO
+/ FOLLOWED BY THE TEMPORARY LOC
+LSTORE, 0
+ TAD L46 /GET THE AC
+ JMS I MODE /WHAT MODE IS IT
+ JMP FSTO /ITS FLOATING POINT
+ JMS I PROP
+ 6071 /ITS INTEGER...PUT OUT A DCA
+STORET, TAD L46 /GET THE AC AGAIN
+ JMS I PRSYM /PRINT WHATEVER IS IN IT
+ JMS I PRINT /PUT OUT A CRLF
+ DCA L46 /ZERO THE AC
+ JMP I LSTORE /AND RETURN
+FSTO, IAC /WE ONLY HAVE ONE ARG
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+ 6006 /PUT OUT A CALL TOFLOATING STORE
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ JMP STORET /AND JMP BACK
+COMP, 0
+ TAD L46 /GET THE AC
+ JMS I MODE /WHAT MODE IS IT
+ JMP FCOM /ITS FLOATING POINT
+ JMS I PROP /ITS INYTEGER
+ 6135 /PUT OUT A CIA
+ JMS I PRINT /PUT OUT A CRLF
+ JMP I COMP /AND RETURN
+FCOM, JMS I FPROP
+ 6140 /TO FLOATING CHANGE SIGN
+ JMP I COMP
+/ COME HERE IF OP IS *
+MUL, JMS I SMODE /CHECK FOR SAME MODE
+ JMS I CHECK /CHECK WHATS IN THE AC
+ JMP TMUL /TWO IS IN THE AC
+ JMS I STORE /SOMETHING IS IN AC...STORE IT
+ JMS I KADDON /NOTHING IS IN AC..GET ONE IN AC
+AMUL, TAD I L43 /GET OPERND TWO
+ JMS I MODE /WHAT MODE IS IT
+ TAD EM6
+ TAD C6022
+ DCA FML /SAVE OPCODE
+ IAC
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+FML, 0
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ TAD I L43 /GET OPERAND TWO
+ JMP I LIRET /AND GO TO THE RETURN ROUTINE
+TMUL, TAD I L41 /GET OPERAND ONE AND REPLACE OPERAND TWO
+ DCA I L43
+ JMP AMUL /AND JUMP BACK
+KADDON, ADDONE
+LIRET, IRET
+EM6, -6
+C6022, 6022
+
+LSUB, JMS I LOOK /CHECK REST OF STATEMENT
+ -6 /
+ -17 /O
+ -25 /U
+ -24 /T
+ -11 /I
+ -16 /N
+ -5 /E
+ JMP I .+1
+ TART
+
+LCLEAR, 0 /CLEAR THE PSEUDO ACC AND MQ
+ DCA L30
+ DCA L31
+ DCA L32
+ DCA L33
+ DCA L34
+ DCA L35
+ JMP I LCLEAR
+ *5000
+/ THIS ROUTINE TAKES CARE OF TWO BEING DUMMY ARG
+DUMTWO, 0
+ TAD I L41 /GET OPND ONE
+ DCA FDV /AND SAVE
+ TAD I L43 /GET OPND TWO
+ DCA I L41 /ZERO OPND ONE
+ JMS DUMONE /PROCESS DUMMY ARGUMENT
+ TAD FDV /GET SAVED OPERAND
+ DCA I L41 /AND USE AS OPERAND
+ TAD L46 /GET TRIPLE NUMBER
+ DCA I L43 /AND REPLACE
+ JMP I DUMTWO /RETURN
+/ TAKES CARE OF ONE BIING DUMMY ARG
+DUMONE, 0
+ TAD I L42 /GET OPERATOR
+ DCA ASTOP /AND SAVE
+ TAD E41 /GET ADD INDIRECT OPERATOR
+ DCA I L42 /AND REPLACE OPERATOR
+ CDF 10
+ TAD I TRIPL
+ CDF 00
+ DCA FEX /AND SAVE RETURN
+ JMS I TRIPL /CALL TRIPL
+ TAD L46 /GET TRIPLE NUMBER
+ DCA I L41 /AND REPLACE OPERAND
+ TAD ASTOP /RESTORE OPERATOR
+ DCA I L42
+ ISZ L40 /ADVANCE TRIPLE
+ TAD FEX /RESTORE RETURN
+ CDF 10
+ DCA I TRIPL
+ CDF 00
+ JMP I DUMONE /RETURN
+/ COME HERE IF OP IS /
+DIV, JMS I SMODE /CHECK FOR SAME MODE
+ JMS I CHECK /CHECK WHATS IN THE AC
+ JMP DIVE /TWO IS IN AC
+\f JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
+ SKP /NOTHING IS IN AC
+ JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
+ JMS I MADDTW /GET TWO INTO THE AC
+DIVE, TAD I L41 /GET OPERAND ONE
+ JMS I MODE /WHAT MODE IS IT
+ TAD FM6
+ TAD C6025
+ DCA FDV /SAVE OERATOR
+ IAC
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+FDV, 0
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ TAD I L41 /GET OPERAND ONE
+ JMP I MIRET /JUMP TO RETURN ROUTINE
+/ COME HERE IF OP IS **
+EXP, JMS I CHECK /CHECK WHATS IN THE AC
+ JMP FEXP /TWO IS IN AC
+ JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
+ SKP /NOW NOTHING IS IN AC
+ JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
+ JMS I MADDTW /GET TWO IN AC
+FEXP, TAD I L41
+ JMS I MODE
+ TAD C6
+ DCA FDV
+ TAD I L43 /GET OPERAND TWO
+ JMS I MODE /WHAT IS ITS MODE
+ TAD C3 /FLOATING POINT
+ TAD C6207 /INTEGER
+ TAD FDV
+ DCA FEX /SAVE REOUTINE POINTER
+ IAC
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+FEX, 0
+ TAD I L41 /GET OPERAND ONE
+ DCA I L43 /SAVE IN OPERAND TWO
+ TAD FEX /GET THE OP CODE JUST PUT OUT
+ TAD CM6207 /SUBTRACT THE INTEGER TO INTEGER CASE
+ SZA CLA /WAS THIS THE INTEGER INTEGER CASE
+ TAD L50 /NO, GET A FLOATING POINT POINTER
+ DCA I L41 /AND SUBSTITUTE IT FOR OPERAND ONE
+ JMS I ARG /PUT OUT THE PSEUDO OP ARG
+\f TAD I L43 /GET THE REAL OPERAND ONE IN THE AC
+ JMP I MIRET /JUMP TO THE RETURN ROUTINE
+/COMES HERE IF THE VARIABLE TO THE LEFT OF THE '=' IS SUBSCRIPTED
+EIND, TAD C132 /GET AN ASTERISK
+ DCA L60 /PUT IT IN SIXTY
+/COMES HERE IF THE OPERATOR IS AN '='
+EQU, JMS I CHECK /CHECK WHATS IN THE AC
+ NOP /TWO IS IN THE AC
+ JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
+ JMS I TADDON /NOTHING IS IN AC...ADD ONE TO IT
+ TAD I L43 /GET OPERA ND TWO
+ JMS I MODE /WHAT IS ITS MODE
+ JMP FEQU /ITS FLOATING POINT
+ TAD L46 /GET THE AC
+ JMS I MODE /WHAT MODE IS IT
+ JMP I LFIX /ITS FLOATING POINT
+EFIX, TAD L60 /GET EQUALS INDIRECT LOCATION
+ TAD C6071 /ADD A DCA
+ DCA ASTOP /AND SAVE OPCODE
+ JMS I PROP /POT OUT THE OPCODE
+ASTOP, 3
+EQRET, DCA L46 /ZERO THE AC
+ TAD I L43 /GET OPERAND TWO
+ JMS I PRSYM /PRINT IT
+ JMS I PRINT /PUT OUT A CRLF
+ DCA L60 /ZERO SIXTY
+ JMP I .+1 /AND RETURN
+ ARET
+FEQU, TAD L46 /GET THE AC
+ JMS I MODE /WHAT MODE IS IT
+ SKP /ITS FLOATING POINT
+ JMS I LFLOAT /ITS INTEGER...FLOAT IT
+ JMP I .+1
+ XXX
+
+LARG, 0
+ JMS I PROP
+ 6201
+ JMP I LARG
+
+TADDON, ADDONE
+E41, 41
+MADDTW, ADDTWO
+FM6, -6
+C6025, 6025
+MIRET, IRET
+C6, 6
+C6207, 6207
+LFIX, FIX
+C6071, 6071
+LFLOAT, FLOAT
+CM6207, -6207
+C132, 132
+\f *5200
+XXX, TAD L60 /GET THE INDIRECT EQUALS SWITCH
+ SNA CLA /IS THE SWITCH ON
+ TAD CM140 /NO, FLOATING POINT STORE
+ TAD C6146 /YES...ISTO
+ DCA FSTOP /SAVE OPCODE
+ IAC /WE ONLY HAVE ONE ARG
+ JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+FSTOP, 6146
+ JMS I ARG /PUT OUT THE ARG PSEUDO OP
+ JMP I .+1 /JUMP BACK
+ EQRET
+/ THIS ADDS OPERAND ONE TO THE AC
+ADDONE, 0
+ TAD I L41 /GET OPERAND ONE
+ JMS I LADDL /PUT OUT OPCODES FOR AN ADD
+ TAD I L41 /GET FIRST OPERAND
+ JMS I PRSYM /PUT OUT SYMBOL
+ JMS I PRINT /PUT OUT CR LF
+ TAD I L41 /GET OPERAND ONE
+ DCA L46 /PUTN THE AC
+ JMP I ADDONE /RETURN
+UMIN, JMS I CHECK /CHECK WHATSN THE AC
+ NOP /TWOSN AC
+ JMS I STORE /THERES SOMETHINGN THE AC...STORET
+ JMS ADDONE /NOTHINGSN AC NOW...PUT ONEN AC
+ JMS I MCOMP /AND COMPLEMENTT
+ JMP RETURN /AND RETURN
+AADD, JMS I SMODE
+ JMS I CHECK /CHECK WHATSN THE AC
+ JMP AONE /TWOSN AC
+ JMS I STORE /THERES SOMETHINGN THE AC...STORET
+ JMS ADDONE /GET ONEN AC
+ JMS ADDTWO /ONESN AC
+ JMP RETURN /RETURN
+AONE, JMS ADDONE /ADD ONE TO TWO
+ JMP RETURN /AND RETURN
+LPROP, 0
+ CDF 10
+ TAD I LPROP
+ CDF 00
+ JMS I PRSYM /AND PRINT THE SYMBOL
+ TAD C40 /GET A SPACE
+ JMS I PRINT /PUT OUT
+ ISZ LPROP /INCREMENT RETURN
+ JMP I LPROP /AND RETURN
+/ THIS ADDS OPERAND TWO TO THE AC
+ADDTWO, 0
+ TAD I L43 /GET OPERAND TWO
+ JMS I LADDL /PUT OUT OPCODES FOR AN ADD
+ TAD I L43 /GET SECOND OPERAND
+ JMS I PRSYM /PRINT THE SYMBOL
+ JMS I PRINT /PUT OUT CR LF
+ TAD I L43 /GET OPERAND TWO
+ DCA L46 /AND PUTN AC
+ JMP I ADDTWO /RETURN
+LXZQ, 0 /CHECK FOR EXPRESSION LEFT OF =
+ CLA
+ TAD L22 /GET SUBSCRIPT NESTING DEPTH
+ TAD L44 /GET EQUALS SIGN SWITCH
+ SNA CLA /ARE THEY BOTH ZERO
+ERR42, JMS I LUNCH /N YES ...THATS AN ERROR
+ JMP I LXZQ /RETURN
+RETURN, TAD I L41 /THISS THE RETURN...GET OPERAND ONE
+ JMS I MODE /WHAT MODEST
+ TAD G400 /ITS FLOATING POINT...TURN F.P. BIT ON
+ TAD L40 /ADD CURRENT TRIPLE NUMBER
+ DCA L46 /PUTN AC SW
+ JMP I NARET /AND NOW RETURN FROM THE ROUTINE
+FLOAT, 0
+ JMS I FPROP /PUT OUT A CAL TO THE FLOAT ROUTINE
+ 6127
+ JMP I FLOAT /AND RETURN
+FIX, JMS I FPROP /PUT OUT A CAL
+ 6143 /TO THE FIX ROUTINE
+ JMP I .+1 /AND JUMP BACKLADDL, ADDL
+ EFIX
+C6146, 6146
+LADDL, ADDL
+MCOMP, COMP
+G400, 400
+NARET, ARET
+LSMODE, 0
+ TAD I L43 /GET FIRST OPERAND
+ JMS I MODE /FIND WHAT ITS MODE IS
+ JMP IBM /ITS FLOATING POINT
+ TAD I L41 /GET OPERAND TWO
+ JMS I MODE /THIS BETTER BE INTEGER TOO
+ JMP .+5 /ITS NOT, LUNCH
+ JMP I LSMODE /GREAT, RETURN
+IBM, TAD I L41 /GET OPERAND TWO
+ JMS I MODE /THIS BETTER BE F.P. TOO
+ JMP I LSMODE /IT IS RETURN
+ERR43, JMS I LUNCH /ERROR
+LPUNCH, 0
+ PSF /IS PUNCH READY
+ JMP .-1 /NO, TRY AGAIN
+ PLS /YES, PUNCH THE CHARACTER
+ CLA /CLEAR THE ACCUMULATOR
+ JMP I LPUNCH /AND RETURN
+CM140, -140
+
+LFINI, 0 /FINAL CLEANUP AT END OF COMPILATION
+ JMS I FPROP /PUNCH 'CALL 0,OPEN'
+ OPEN
+ JMS I PROP /PUNCH A 'PAUSE'
+ 6060
+ JMS I PRINT
+ JMS I PRINT /FORCE LAST LINE OUT
+ TAD CM100
+ JMS I LEADR /PUNCH SOME LEADER
+ CDF 10
+XFINI, HLT /JMP I LFINI, FOR DISK SYSTEM ...
+ CIF 0
+ JMP I D1000 /BEGIN NEXT COMPILATION
+D1000, 1000
+CM100, -100
+LEADR, LLEAD
+
+FORST, JMS I PRINT /FORTRAN STARTING POINT
+ JMS I (LIST
+ DCA .-1
+ TAD (LPUNCH
+ DCA PUNCH
+ TAD CM50
+ JMS I LEADR
+ JMS I PROP
+ FORTR
+ JMS I PRINT
+ JMP I .+1
+ START1
+
+PAGE
+\f *5400
+LLAST, TAD C4000 /END OF COMPILATION, SET CHK SO THAT
+ DCA CHK /LGTC WILL NOT READ ANOTHER LINE...
+ JMS I GNB
+ SZA
+ JMP I ASSIGN
+ JMS I (OSTOP /PUNCH A 'HLT' ETC.
+ TAD L55
+ TAD C25
+ SZA CLA /IS DO LIST EMPTY?
+ERR44, JMS I LUNCH /NO, COMPLAIN...
+MORDUM, TAD L56 /GET POINTER INTO SYMBOL TABLE
+ TAD C2 /ADD TWO TO IT FOR CONTROL BITS
+ DCA L72 /SAVE ADDRESS OF CONTROL BITS
+ TAD I L72 /GET THE CONTROL BITS
+ AND E10 /MASK ALL BUT THE DUMMY ARG BIT
+ SNA CLA /IS THE DUMMY ARG BIT ON
+ JMP LEDOUT /NO, PUT OUT DUMMY SUBSCRIPT DEFNS
+ JMS I DEFN /YES, PUT OUT THE VARIABLE NAME
+ JMS I PROP /PUT OUT THE OP CODE
+ 6154 /WHICH IS BSS
+ TAD C2 /RESERVE TWO LOCATIONS
+ JMS I PROTAC /PRINT THE TWO
+ JMS I PRINT
+ ISZ L56 /ADVANCE THE POINTER
+ ISZ L56
+ ISZ L56
+ JMP MORDUM /GO BACK AND DO THE NEXT ONE
+LEDOUT, DCA L72 /ZERO LOCATION 72
+LEDOT1, TAD L25 /GET THE NUMBER OF SUBSCRIPT TEMPS
+ CMA
+ TAD L72 /SUBTRACT FROM THE NUMBER WEVE DEFINED
+ SNA CLA /HAVE WE DEFINED THEM ALL YET
+ JMP GOOON /YES, NOW PUT OUT THE END
+ TAD K5200 /GET SUBSCRIPT DESIGNATOR
+ TAD L72 /GET WHICH SUBSCRIPT
+ JMS I PRSYM /AND PRINT IT
+ TAD C7240 /GET THE TERMINATOR
+ JMS I P2 /PRINT IT
+ JMS I PROP /PRINT THE OP CODE
+ 6154 /WHICH IS BSS
+ TAD C2 /RESERVE TWO LOCATIONS
+ JMS I PROTAC
+ JMS I PRINT /CRLF
+ ISZ L72 /GO ON TO THE NEXT ONE
+ JMP LEDOT1
+GOOON, JMS I PROP
+ 6157 /PUT OUT AN END
+ JMS I PRINT /PUT OUT A CRLF
+ DCA L65 /ZERO THE PSEUDO LOCATION COUNTER
+ TAD START /CLA = -600
+ JMS I LEAD /PUT OUT LOTS OF LEADER CODE
+ JMS I PROP
+ 6162 /PUT OUT A LAP
+ JMS I PRINT
+SYM, TAD L57
+ CIA
+ TAD L56
+ SZA CLA /ARE THERE ANY SYMBOLS
+ JMP SYM1
+ TAD MIKE8
+ SZA CLA /NO, IS THERE ANY EQUIVALENCING?
+ JMP I LPTEMP
+ JMP I .+1
+ PTEMP
+SYM1, TAD L56
+ TAD C2
+ DCA L72
+ TAD I L72 /GET THE CONTROL BITS
+ DCA L72 /SAVE THEN
+ TAD L72 /GET THE BITS
+ AND E7 /MASK
+ SZA CLA /ARE THEY FUNCT NAME,
+ JMP UP /YES
+ JMS I DEFN /PUT IT OUT
+ TAD L72
+ AND E20 /MASK ALL BUT THE DIMEN
+ SNA CLA /IS EITHER ONE ON
+ JMP NORM /NO
+ TAD L56
+ JMS I DIM
+ DCA L26
+ TAD I L14 /GET THE SECOND DIMENSION
+ CLL CIA /AND NEGATE
+ DCA L73 /SAVE
+ SZL
+ERR36, JMS I LUNCH
+ TAD L26
+ ISZ L73
+ JMP .-4
+ACK, DCA L26
+ TAD L56
+ JMS I MODE /DETERMINE MODE OF SYMBOL
+ TAD L26
+ RAL CLL
+ TAD L26
+ SZL
+ JMP ERR36
+ DCA L26
+ TAD L72
+ AND C40
+ SZA CLA
+ JMP COM
+ JMS I BSS
+UP, ISZ L56
+ ISZ L56
+ ISZ L56
+ JMP SYM
+NORM, IAC
+ JMP ACK
+C25, 25
+E7, 7
+K5200, 5200
+DEFN, LDEFN
+E20, 20
+E10, 10
+LPTEMP, EEK
+LEAD, LLEAD
+COM, JMS I PROP
+ 6165
+ TAD L26
+ JMS I PROTAC
+ JMS I PRINT
+ JMP UP
+\f *5600
+C7600, 7600
+C177, 177
+LBSS, 0
+ TAD L65 /GET THE LOCATION COUNTER
+ TAD L26 /ADD THE CURRENT AMOUNT TO IT
+ AND C7600 /MASK ALL BUT THE PAGE BITS
+ DCA L64 /SAVE THE NUMBER OF PAGES
+ TAD L65 /GET THE LOCATION COUNTER AGAIN
+ TAD L26 /ADD THE CURRENT DISPLACEMENT AGAIN
+ AND C177 /NOW GET THE NUMBER OF LOCATIONS OVER A PAGE
+ DCA L65 /AND SAVE
+L, TAD L64 /GET THE NUMBER OF PAGES TO BE RESERVED
+ SNA /ARE THERE ANY TO BE RESERVED
+ JMP CRAM /NO...JUST PUT OUT STRAIGHT NUMBER OF LOCATIONS
+ TAD C7600 /YES...SUBTRACT ONE FROM THE PAGE COUNT
+ DCA L64 /AND SAVE IT
+ TAD L65 /GET THE NUMBER OF EXTRA LOCATIONS
+ DCA L26 /AND PUT IN THE DISPLACEMENT LOCATION
+ JMS I PROTAC /PUT OUT A ZERO
+ JMS I PRINT /PUT OUT A CRLF
+ JMS I PROP /PUT OUT THE OPCODE
+ 6151 /WHICH IS THE PAGE PSEUDO OP
+ JMS I PRINT /PUT OUT A CRLF
+ JMP L /NOW SEE IF WE HAVE PUT OUT ENOUGH PAGES
+CRAM, JMS I PROP /NOW PUNCH 'BLOCK <N>'
+ BLCK
+ TAD L26
+ JMS I PROTAC
+ JMS I PRINT
+ JMP I LBSS
+LDEFN, 0
+ TAD L56 /GET THE POINTER TO THE SYMBOL
+ JMS I PRSYM /PRINT THE SYMBOL
+ TAD C7240 /GET THE TERMINATOR
+ JMS I P2 /PRINT IT
+ JMP I LDEFN /AND RETURN
+AFCON, TAD L47 /GET START OF FCON TABLE
+ TAD C3 /UPDATE IT
+ DCA L56 /SAVE UPDATED ADDRESS
+FLOOP, TAD L50 /GET END OF FCON TABLE
+ CIA
+ TAD L56 /SUBTRACT FROM CURRENT POINTER
+ SNA CLA /ARE WE DONE
+ JMP ALTHRU /YES
+ TAD CM3 /NO, GET MINUS THREE
+ DCA L63 /TO USE AS A COUNTER
+ JMS LDEFN /DEFINE IT
+ TAD I L56 /GET THE FIRST WORD
+ ISZ L56 /ADVANCE THE POINTER TO THE NEXT WORD
+ JMS I PROTAC /PRINT THE WORD
+ JMS I PRINT /PUT OUT A CRLF
+ ISZ L63 /HAVE WE PUT OUT ALL THREE WORDS
+ JMP .-5 /NO...PUT OUT ANOTHER
+ JMP FLOOP /YES...GET THE NEXT CONSTANT
+PTEMP, TAD K561
+ DCA L56
+FTLOOP, TAD L45
+ CMA
+ TAD L56
+ SNA CLA
+ JMP ITEMP
+ TAD C3
+ DCA L26
+ TAD K5400 /GET F.P. DESIGNATOR
+ JMS LDEFN /PRINT THE SYMBOL
+ JMS I BSS /RESERVE THE LOCATIONS FOR IT
+ ISZ L56 /INCREMENT THE POINTER
+ JMP FTLOOP
+ITEMP, TAD K531
+ DCA L56
+ILOOP, TAD L51
+ CMA
+ TAD L56
+ SNA CLA
+ JMP SUBOUT
+ IAC
+ DCA L26
+ TAD K5000 /GET THE INTEGER TEMP DESIGNATOR
+ JMS LDEFN /PRINT IT
+ JMS I BSS /RESERVE LOCATIONS FOR IT
+ ISZ L56 /INCREMENT THE POINTER
+ JMP ILOOP
+ALTHRU, TAD D6 /PUNCH AN 'IFF 6'
+ JMS I PIFF /SO THAT ENTRY WILL NOT BE AT END OF THE PAGE
+ JMS I PROP
+ 6055 /PUT OUT AN EAP
+ JMS I PRINT
+ TAD L70 /GET THE SUBROUTINE FUNCTION POINTER
+ SZA CLA /IS IT ZERO
+ JMP THRU /NO...WE MUST BE IN A SUBR OR A FUNC
+ JMS I PROP /YES ...WERE IN A MAIN PROGRAM
+ 6052 /PUT OUT ENT
+ TAD C6000 /POINTER TO THE SYMBOL MAIN
+ JMS I PRSYM /PRINT THE SYMBOL
+ JMS I PRINT /PUT OUT A CRLF
+ TAD C6000 /GET THE POINTER TO MAIN AGAIN
+ JMS I PRSYM /PRINT IT
+ TAD C7240 /GET A COLON
+ JMS I P2 /PRINT THEM
+ JMS I PROP
+ 6047
+ JMS I PRINT /PUT OUT A CRLF
+THRU, JMS I FINI
+ 6201 /CDF FIELD 0
+ JMP I C7600 /AND RETURN TO THE MONITOR ...
+C6000, 6000
+SUBOUT, DCA L56
+SUBOT1, TAD L25
+ CMA
+ TAD L56
+ SNA CLA
+ JMP AFCON
+ JMS I PROP /PUT OUT THE OP CODE
+ 6176 /WHICH IS DUMMY
+ TAD X5200 /GET SUBSCRIPT DESIGNATOR
+ TAD L56 /GET THE POINTER
+ JMS I PRSYM /PRINT THE SYMBOL
+ JMS I PRINT /CRLF
+ ISZ L56
+ JMP SUBOT1
+K5000, 5000-ITTAB
+K5400, 5400-FTTAB
+K531, ITTAB+1
+K561, FTTAB+1
+X5200, 5200
+FINI, LFINI
+D6, 6
+\f *6000
+/FUNCTION AND SUBROUTINE STATEMENT PROCESSOR
+LFUNC, JMS I LOOK /CHECK REST OF STATEMENT
+MFOUR, -4 /
+ -24 /T
+ -11 /I
+ -17 /O
+ -16 /N
+ CLA IAC /SET SWITCH
+TART, DCA L67 /THIS IS THE SWITCH
+ TAD FIRSTF
+ SNA CLA /INSURE SUBR. OR FUNCT. IS FIRST STMT.
+ERR47, JMS I LUNCH
+ JMS SUBB
+ CLA CMA
+ TAD C6275 /THIS IS THE PLACE TO STORE FUNCTION NAME
+ DCA L11 /USE AUTO INDEXING TO STORE THE NAME
+ TAD L30 /GET THE FIRST WORD
+ DCA I L11 /PUT IT IN THE SYMBOL TABLE
+ TAD L31 /GET THE SECOND WORD
+ DCA I L11 /PUT IT IN THE TABLE
+ TAD L32 /GET THE THIRD WORD
+ IAC /TURN THE EXTERNAL SYMBOL BIT ON
+ DCA I L11 /AND PUT IT IN THE TABLE
+ TAD C6275 /GET THE POINTER
+ DCA L70 /AND PUT IT IN LOC 70
+ JMS I PROP
+ 6052 /PUT OUT AN ENT
+ TAD L70 /GET THE SUBROUTINE NAME
+ JMS I PRSYM /PRINT IT
+ JMS I PRINT /PUT OUT A CRLF
+ CLA CMA
+ DCA READY /SET SWITCH
+ TAD L70 /GET THE SUB NAME
+ JMS I PRSYM /PUT IT OUT
+ TAD C7240
+ JMS I P2 /PUT IT OUT
+ JMS I PROP /PUT OUT THE OP CODE 'BLOCK 2'
+ BLCK
+ TAD C2
+ JMS I PROTAC
+ JMS I PRINT
+ DCA WHICH /ZERO THE SWITCH WHICH TELLS WHICH WORD
+MORE, JMS I GNB
+ SNA /CHECK FOR END OF CARD
+ JMP CKCR
+ TAD CM50 /CHECK FOR LEFT PAREN
+ SNA /IS IT A LPAR
+ JMP GET1 /YES
+ TAD MFOUR
+ SNA /IS IT A COMMA
+ JMP XGET /YES
+ TAD C3
+ SNA CLA /IS IT A LPAR
+ JMP START /YES
+ JMP ERR48 /NO
+GET1, ISZ READY /WERE WE READY FOR LPAR
+ JMP ERR48 /NO, ERROR ...
+XGET, JMS SUBB
+ TAD L32
+ TAD TEN
+ DCA L32
+ TAD C77 /GET MASK FOR SYMBOL TABLE
+ DCA L21 /AND PUT INTO THE SWITCH
+ JMS I SYMTAB /AND PUT IN SYMBOL TABLE
+ JMS I PROP
+ DUMMY
+ TAD L77
+ JMS I PRSYM
+ JMS I PRINT
+DLOOP, JMS I PROP
+ 6063 /PUT OUT A TAD*
+ TAD L70 /GET THE FUNCTION NAME
+ JMS I PRSYM /AND PRINT IT
+ JMS I PRINT /PUT OUT A CRLF
+ JMS I PROP
+ 6071 /PUT OUT A DCA
+ TAD L77 /GET ADDRESS OF SYMBOL
+ JMS I PRSYM /PRINT IT
+ TAD WHICH /GET THE WHICH SWITCH
+ RAR /GET THE LOW BIT INTO THE LINK
+ SNL CLA /IS THE WHICH SWITCH BIT SWITCHED
+ JMP NEXT /NO...THAT MEANS WERE ON THE FIRST WORD
+ TAD E43 /YES...WERE ON SECOND WORD...GET A "#"
+ JMS I PRINT /PRINT IT
+NEXT, JMS I PRINT
+ JMS I PROP /PUT OUT AN INC (ISZ WHICH DOES NOT SKIP)
+ 6237
+ TAD L70 /GET THE FUNCTION NAME
+ JMS I PRSYM /AND PRINT IT
+ TAD E43
+ JMS I PRINT
+ JMS I PRINT /PUT OUT A CRLF
+ ISZ WHICH /INCREMENT THE SHICH SWITCH
+ TAD WHICH /GET THE SWITCH
+ RAR /GET LOW BIT IN THE LINK
+ SZL CLA /IS THE LOW BIT ON
+ JMP DLOOP /YES...WORK ON THE SECOND WORD
+ JMP MORE /GO GET SOME MORE
+READY, 0
+SUBB, 0
+ JMS I ENTITY
+ SKP
+ JMP I SUBB
+E43, 43
+TEN, 10
+ JMP ERR48
+WHICH, 0
+C6275, 6275 /SUBROUTINE OR FUNCTION NAME POINTER
+CKCR, ISZ READY
+ERR48, JMS I LUNCH
+ JMP START
+
+IOEQL, CLA CMA /ROUTINE TO TERMINATE IMPLIED DO LOOPS
+ TAD IMPDO
+ DCA IMPDO /REDUCE THE DEPTH BY 1
+ JMS I DONEXT /GENERATE END-OF-LOOP CODE
+ JMS I GNB
+ TAD CM51
+ SZA CLA /SKIP TO A RIGHT PAREN
+ JMP .-3
+ JMP I .+1
+ IOH0
+DONEXT, LDNEXT
+\f *6172
+C6030, 6030
+LWRIT, JMS I LOOK /LOOK FOR REST OF STATEMENT
+ -1
+ -5
+ TAD C3
+LREAD, TAD C6030 /GET THE POINTER TO READ AND WRITE
+ DCA IOP /USE AS A PARAMETER WITH FPROP
+ JMS I GNB
+ TAD CM50
+ SZA CLA /IS THIS A LEFT PAREN?
+ JMP I ASSIGN
+ JMS SUBA
+ JMS I ZZZ
+ TAD C2
+ JMS I FPROP
+IOP, 0
+ JMS I ARG
+ TAD L32
+ JMS I PRSYM
+ JMS I PRINT
+ JMS I ARG
+ JMS I GNB
+ TAD CM54 /IS IT A COMMA
+ SZA CLA
+ JMP ERR50 /NO, ERROR ...
+ JMS SUBA
+ TAD L32 /GET FORMAT
+ SMA
+ JMS I PLAB
+ SPA
+ JMS I PRSYM
+ JMS I GNB
+ TAD CM51 /CHECK FOR A RIGHT PAREN
+ SZA CLA /IS IT?
+ERR50, JMS I LUNCH
+ JMS I PRINT
+IOH0, JMS I GNB
+ SNA
+ JMP IOH2
+ TAD CM54
+ SNA CLA /IS IT A COMMA
+ JMP IOH3 /YES ...
+IOH1, JMS I PUTCH /NO...PUT IT BACK
+ JMS I GNB /THIS STMT IS TRANSFERRED TO!
+ TAD CM50
+ SNA CLA
+ JMP I IOPEN /OPEN PAREN - MAY BE IMPLIED DO-LOOP
+IOH1BK, JMS I PUTCH
+ DCA L52 /SET SWITCHES FOR GENER
+ DCA L46
+ ISZ L44
+ JMS I GENER /START PROCESSING THE IO LIST
+ TAD L41
+ DCA L42
+ TAD L53
+ DCA L73 /SAVE CREATED LABEL LOC
+ DCA L23 /ZERO TEMPORARY FOR "DUMARG"
+ JMS I LCHNG /TEST FOR 0 OR DUMMY ARG
+ DCA I L41
+ TAD L23 /GET TEMPORARY FROM "DUMARG"
+ SZA CLA /ZERO MEANS NON-VARIABLE NAME
+ TAD I L23 /NON-ZERO POINTS TO FLAG WORD OF VAR
+ AND Q20
+ SNA CLA /DO WE HAVE AN ARRAY NAME?
+ JMP NOSYMB /NO
+ JMS I PROP
+ OPCMA /PUT OUT A "CMA" TO DISTINGUISH THIS CALL
+ JMS I PRINT /FROM A REGULAR CALL TO "IOH"
+ TAD C2
+ JMS I FPROP
+ 6036 /OUTPUT A "CALL 2,IOH"
+ JMS I ARG
+ TAD L23
+ TAD CM2
+ JMS I DIM /GET THE DIMENSIONS
+ DCA IOP
+ TAD I L14
+ CIA
+ DCA L44
+ TAD L23
+ TAD CM2
+ JMS I MODE /GET THE MODE OF THE ARRAY
+ TAD C4000 /FLOATING POINT - ADD 4000 TO AC
+ TAD IOP
+ ISZ L44
+ JMP .-2 /COMPUTE PRODUCT OF DIMENSIONS PLUS MODE BIT
+ JMS I PROTAC /PRINT IT
+ JMS I PRINT
+ JMP IOHRSM /GO PRINT ARRAY NAME
+NOSYMB, TAD L46
+ SZA CLA
+ JMS I STORE
+ IAC /THERE WILL BE ONE ARGUMENT
+ JMS I FPROP /PUT OUT THE CALL TO IOH
+ 6036
+IOHRSM, TAD L73
+ DCA L53 /RESTORE CREATED LABEL LOC
+ TAD I L41
+ JMS I QSYMOT
+ TAD L63 /GET TERMINATING CHAR
+ SNA CLA /WAS IT A <CR>?
+ JMP IOH2 /YES
+IOH3, JMS I GNB /GENTLY LOOK AHEAD ...
+ SNA CLA /DO WE HAVE A ',<CR>' ?
+ JMP START /YES, DO NOT TERMINATE YET ...
+ JMP IOH1 /NO, PUSH IT BACK & PROCESS NEXT ITEM
+IOH2, IAC /THERE WILL BE ONE ARGUMENT
+ JMS I FPROP /PUT OUT A CALL TO IOH
+ 6036
+ JMS I ARG /PUT OUT THE PSEUDO OP ARG
+ JMS I PROTAC
+ JMS I PRINT
+ JMP START
+SUBA, 0
+ JMS I ENTITY
+ JMP ERR51 /ITS A CR
+ JMP ERR51+1 /ITS A VARIABLE
+ JMP I SUBA
+Q20, 20
+ERR51, JMS I LUNCH
+ DCA L21 /ZERO THE SYMBOL TABLE SWITCH
+ JMS I SYMTAB
+ TAD L77
+ JMS I MODE
+ JMP ERR51
+ TAD L77
+ DCA L32
+ TAD L32
+ JMS I DUMARG
+ JMP ERR51
+ JMP I SUBA
+IOPEN, IOOPEN
+QSYMOT, SYMOUT
+\f *6400
+LRET, JMS I LOOK /CHECK REST OF STATEMENT
+ -2
+ -22
+ -16
+ JMS I ZZZ
+ TAD L70
+ SNA CLA /ARE WE COMPILING MAIN PROGRAM?
+ERR60, JMS I LUNCH /YES
+ TAD L67
+ SNA CLA
+ JMP INT /ITS A SUBROUTINE
+ TAD L70 /GET HE NAME OF THE FUNCTION
+ JMS I MODE /IS IT FP OR INTEGER
+ JMP .+4 /ITS FP
+ JMS I PROP
+ 6066 /OPCODE IS TAD
+ JMP .+5 /PUT OUT THE SYMBOL
+ IAC /THERE IS ONE ARGUMENT
+ JMS I FPROP
+ 6003
+ JMS I ARG
+ TAD F34 /GET A BACK SLASH
+ JMS I PRINT
+ TAD L70 /GET THE NAME OF THE FUNCTION
+ JMS I PRSYM /PRINT THE NAME
+ JMS I PRINT /PUT OUT A CRLF
+INT, JMS I PROP
+ 6077 /OPCODE IS RTN
+ TAD L70 /GET THE FUNCTION NAME
+ JMS I PRSYM /PRINT IT
+ JMS I PRINT /PUT OUT A CRLF
+ JMP START /WERE DONE
+
+LGETHI, 0 /PUNCH 'TAD ACH'
+ JMS I PROP
+ 6066
+ JMS I PROP /PRINT THE OP CODE
+ 6226 /WHICH IS ACH (HIGH ORDER AC)
+ JMS I PRINT
+ JMS I FPROP /PUNCH 'CALL 0,CLEAR'
+ 6204
+ JMP I LGETHI
+LDIM, 0 /GETS THE 1ST DIMENSION OF THIS VARIABLE
+ DCA LGETHI /SYMBOL TABLE ADDRESS IS IN THE AC
+ CMA
+ TAD L50
+ DCA L14
+LK, TAD I L14 /SEARCH THE DIMENSION TABLE
+ CIA
+ TAD LGETHI
+ SNA CLA
+ JMP .+4
+ ISZ L14
+ ISZ L14
+ JMP LK
+ TAD I L14 /EXIT WITH DIMENSION IN THE AC
+ JMP I LDIM
+/ THIS PROCESSES SUBSCRIPTS
+SUBRET, JMP I LSUBSC /RETURN FROM SUBSC
+LSBTEM, 0 /THIS ROUTINE MAKES AN ENTRY
+ DCA TRIP /IN SUBSCRIPT TEMPORARY TABLE
+ TAD FBASE
+ DCA POINT
+ TAD CM40
+ DCA PCTR
+LOOP, TAD I POINT /LOOK FOR CURRENT TRIPLE NR
+ SNA /OR END OF TABLE...
+ JMP YES
+ CIA
+ TAD TRIP
+ SNA CLA
+ JMP GOT
+ ISZ POINT
+ ISZ PCTR
+ JMP LOOP
+ERR53, JMS I LUNCH
+YES, TAD TRIP
+ DCA I POINT
+GOT, TAD FBASE
+ CIA
+ TAD POINT
+ DCA POINT
+ TAD POINT
+ CIA
+ TAD L25
+ SPA CLA /IF TEMPORARY NR > L25
+ ISZ L25 /BUMP L25
+ TAD POINT
+ JMP I LSBTEM
+LWIPE, 0 /ZERO THE SUBSCRIPT TEMP. TABLE
+ TAD FBASE
+ DCA POINT
+ TAD CM40
+ DCA PCTR
+LOOP2, DCA I POINT
+ ISZ POINT
+ ISZ PCTR
+ JMP LOOP2
+ JMP I LWIPE
+LZER, 0
+ ISZ LZER /INCREMANT
+ JMS I PROTAC /PUT OUT A ZERO
+ JMP I LZER /AND REUTURN
+LCLAB, 0
+ SNA /IF NO LABEL IN AC,
+ JMS I CREATE /CREATE A LABEL
+ JMS I PRCRL /AND PRINT IT
+ TAD C7240 /PUT OUT A COLON AND SPACE
+ JMS I P2
+ JMP I LCLAB /RETURN
+FBASE, 4600
+POINT, 0
+PCTR, 0
+TRIP, 0
+F34, 34
+LSUBSC, 0
+ TAD L46
+ SZA /IS THERE ANYTHING IN THE AC?
+CHANGE, SKP CLA /********************************
+/ TRY CHANGING THIS LOCATION TO A "JMS I MODE"
+/ TO LIMIT THE CHECK TO THE INTEGER AC!
+/ COULD SAVE UP TO 30% IN HEAVILY SUBSCRIPTED F.P.
+/ EXPRESSIONS! (IMPORTANT - TEST WITH F.P. SUBSCRIPTS)
+ SKP /NOTHING IN THE AC
+ JMS I STORE /YES - STORE IT
+ IAC
+ DCA L63
+ TAD L53
+ DCA L73
+ TAD L41
+ DCA L42
+ ISZ L41
+ TAD I L41
+ TAD CM4046
+ SNA CLA /WAS IT A PRIME
+ JMP BACK
+ JMS I LCHNG
+ DCA L63
+ ISZ L41
+ ISZ L41
+ ISZ L42
+\f ISZ L42
+ IAC
+BACK, ISZ L41
+ DCA SYMOUT
+ JMS CHNG
+ DCA L65
+ ISZ L42
+ ISZ L42
+ JMS CHNG
+ DCA LDUM /SAVE ARRAY POINTER (OR 0 IF DUMMY)
+ TAD L73 /NOW RESTORE THE CREATED LABEL LOC
+ DCA L53
+ TAD SYMOUT
+ SNA CLA /HOW MANY SUBSCRIPTS?
+ JMP .+7 /ONE - SKIP OUTPUTTING "TAD"
+ JMS I PROP
+ 6066
+ TAD I L41
+ JMS I DIM
+ JMS I PRSYM
+ JMS I PRINT
+ TAD I L41
+ JMS I MODE
+ JMP FP
+CASUB, TAD H200
+ TAD L40
+ DCA I L41 /STORE TRIPLE NUMBER WITH MODE BITS IN PD STACK
+ TAD SYMOUT /GET NUMBER OF ARGUMENTS (2 OR 3)
+ TAD C2
+ JMS I FPROP /PUT OUT A CALL TO THE SUBSCRIPTING ROUTINE
+ 6173 /TO THE SUBSCRIPTING ROUTINE
+ TAD SYMOUT
+ SNA CLA /ONLY ONE ARG?
+ JMP .+3 /YES - DON'T OUTPUT FIRST SUBSCRIPT
+ TAD L63
+ JMS SYMOUT
+ TAD L65
+ JMS SYMOUT
+ TAD LDUM /GET THE ARRAY NAME
+ JMS SYMOUT /OUTPUT IT AS AN ARGUMENT
+ TAD I L41
+ JMS I PRSYM /OUTPUT THE DESTINATION TEMPORARY
+ JMS I PRINT
+ TAD I L41
+ DCA L12 /MARK IT AS THE CONTENTS OF THE LAST LINE
+ JMP I FSUBSC /RETURN
+FP, JMS I PROP
+ OPCMA /OPCODE IS CMA
+ JMS I PRINT
+ TAD H400 /SET MODE TO FLOATING POINT
+ JMP CASUB
+SYMOUT, 0
+ DCA CHNG
+ TAD CHNG
+ SNA CLA
+ JMS I CLAB /CREATE LABEL IF DUMMY ARG
+ JMS I ARG
+ TAD CHNG
+ SNA /IS IT ZERO
+ JMS I ZER /YES PUT OUT A ZERO
+ JMS I PRSYM /OTHERWISE PUT OUT SUBSCRIPT
+ JMS I PRINT /PUT OUT A CRLF
+ JMP I SYMOUT
+
+LDSPCL, DCA L24
+ JMS I CREATE
+ JMS I PRCRL /CHANGE LAST LINE TO STORE IN NEW DESTINATION
+ DCA L12 /MARK LAST LINE USELESS FOR OPTOMIZATION
+ JMP LDMRET
+LDUM, 0
+ ISZ LDUM /INCREMENT RETURN
+ TAD I L42 /GET THE THING WHICH IS DUMMY
+ CIA
+ TAD L12 /DID WE JUST PUT THIS OUT AS A SUBSCRIPT
+ SNA CLA /DESTINATION??
+ JMP LDSPCL /YES - SAVE OODLES OF CODE
+ JMS I PROP
+ 6066 /PUT OUT A TAD
+ TAD I L42
+ JMS I PRSYM /PUT IT OUT
+ JMS I PRINT /PUT OUT A CRLF
+ JMS I PROP
+ 6071 /PUT OUT A DCA
+ JMS I CREATE /CREATE A LABEL
+ JMS I PRCRL /AND PRINT IT
+ JMS I PRINT /PUT OUT A CRLF
+ JMS I PROP
+ 6066
+ TAD I L42
+ JMS I PRSYM
+ TAD H43
+ JMS I PRINT
+ JMS I PRINT
+ JMS I PROP
+ 6071
+ TAD L53
+ JMS I PRCRL
+ TAD H43
+ JMS I PRINT
+LDMRET, JMS I PRINT
+ JMP I LDUM /RETURN
+CHNG, 0
+ TAD I L42 /NO...THERES TWO SUBSCRIPTS
+ SNA
+ TAD H6041
+ DCA I L42
+ TAD I L42
+ JMS I DUMARG /SEE IF SECOND SUBSC IS A DUMMY ARG
+ JMS I DUM /YES IT IS A DUMMY ARG
+ TAD I L42 /GET THE SECOND SUBSC
+ JMP I CHNG
+
+H400, 400
+H200, 200
+H43, 43
+FSUBSC, SUBRET
+H6041, 6041
+\f *7000
+IOHTMP,MCHAR, 0
+NPOINT,LLUNCH, 0
+ CLA
+ DCA L75
+ DCA L24 /ZERO "BUFFER WAITING TO PRINT" FLAG
+ DCA IMPDO /ZERO IMPLIED DO LOOP FLAG
+ TAD TTYPE /CHANGE TO TTY OUTPUT
+ DCA PUNCH
+ JMS I LLIST /TYPE THE CURRENT LINE
+ CLL CMA RAL
+ TAD KOUNT /USE THE BUFFER POINTER AS AN INDEX
+ SMA
+ CMA
+ DCA L7
+ TAD C40 /NOW PUT OUT SOME SPACES...
+ JMS I PRINT
+ ISZ L7
+ JMP .-3
+ TAD D36 /AND AN '^'
+ JMS I PRINT
+ JMS I PRINT
+ TAD LELIST /NOW TYPE THE ERROR MESSAGE
+ DCA L10
+UNCH1, TAD I L10
+ SZA /END OF TABLE?
+ TAD LLUNCH
+ SNA CLA /IS THIS THE MSG WE WANT?
+ JMP UNCH2
+ ISZ L10 /NO
+ JMP UNCH1
+UNCH2, TAD BASE
+ CIA
+ TAD I L10
+ JMS I LLIST /FAKE LISTER INTO PRINTING ERROR MESG
+ JMS I PRINT /FORCE BUFFER
+ TAD EPNCH /BACK TO PUNCH OUTPUT
+ DCA PUNCH
+ ISZ L75 /SET THE NON-PRINT SWITCH
+ TAD CHK /IF ERROR OCCURED WHILE PROCESSING END STMT.
+ TAD C4000 /CHK WILL BE 4000-WANT TO ABORT IMMEDIATELY
+ SZA CLA /WAS IT END STMT?
+ JMP START /NO-GO PROCESS NEXT STMT.
+ JMP I (THRU /YES-CLEAN UP AND ABORT
+LLIST, LIST
+D36, 36
+LELIST, ELIST-1 /ERROR LIST ...
+TTYPE, LTTYPE
+EPNCH, LPUNCH
+CTR, 0
+TEM, 0
+/ THIS ROUTINE PRINTS THE CONTENTS OF THE AC IN DECIMAL
+PARCT,LDCOUT, 0
+ DCA TEM /SAVE THE AC
+ TAD CM3 /WE WILL PUT OUT FOUR CHARACTERS
+ DCA CTR
+ TAD ASE /THIS IS THE ASE OF THE CONVERSION TABLE
+ DCA NPOINT /SAVE IT IN THE POINTER
+ DCA FLAG
+LOP, DCA MCHAR /ZERO OUT THE CHARACTER
+ TAD TEM /GET THE NUMBER AGAIN
+ TAD I NPOINT /TO GET THE ITEM IN THE TABLE
+ SPA /IS THE RESULT POSITIVE
+ JMP LOPRST /NO...RESTORE THE NUMBER
+ DCA TEM /AND SAVE THIS VALUE
+ TAD D60
+ DCA FLAG /SET FLAG TO SHOW THAT WE HAVE SOMETHING
+ ISZ MCHAR /YES...INCREMENT THE OUTPUT CHARACTER
+ JMP LOP+1 /TRY THE SEQUENCE AGAIN
+LOPRST, CLA
+ TAD MCHAR
+ TAD FLAG
+ SZA /DO WE HAVE A SIGNIFICANT DIGIT?
+ JMS I PRINT /YES - PRINT IT
+ ISZ NPOINT
+ ISZ CTR
+ JMP LOP /AND GET THE NEXT DIGIT
+ TAD TEM /GET THE CHARACTER TO OUTPUT
+ TAD D60 /PUT IT IN TRIMMED ASCII FORM
+ JMS I PRINT /PRINT IT
+ JMP I LDCOUT /YES...RETURN TO CALLING PROGRAM
+ASE, THOU
+FLAG, 0
+
+
+IOOPEN, TAD KOUNT
+ DCA IOHTMP /SAVE POINTER TO LEFT PAREN +1
+ CLA CMA
+ DCA PARCT /INITIALIZE PAREN COUNTER
+ TAD KOUNT
+ DCA TEM /TEM POINTS TO ENTITY (OR PREV ONE IF A VAR)
+IOPENL, JMS I ENTITY /GET SOMETHING
+ERR52, JMS I LUNCH /END OF STMT - BAD
+ JMP IOPENL /VARIABLE - DON'T UPDATE TEM
+D60, 60
+ JMP IOPENL-2 /CONSTANT - UPDATE TEM
+ TAD CM51 /PUNCTUATION - TEST FOR RIGHT PAREN
+ SNA
+ JMP IORPAR /YES
+ IAC
+ SNA /LEFT PAREN?
+ JMP IOLPAR
+ TAD CM25
+ SNA CLA /IF CHAR IS AN EQUAL SIGL
+ TAD PARCT
+ IAC
+ SZA CLA /AND WE ARE ON THE TOP LEVEL OF PARENTHESES
+ JMP IOPENL-2
+ TAD TEM /THEN WE HAVE AN IMPLIED DO
+ DCA KOUNT
+ JMS I DO /GENERATE DO LOOP CODE
+ JMP ERR52 /NOT TERMINATED WITH RPAR - ERROR
+ ISZ IMPDO /BUMP IMPLIED DO COUNT
+ TAD IOHTMP
+ DCA KOUNT /RESTORE CHAR PTR TO BEGINNING OF LOOP
+ JMP I .+1
+ IOH1+1 /COMPILE INNARDS OF LOOP
+
+IOLPAR, CLA CMA
+ TAD PARCT
+ JMP IOPENL-3 /BUMP PAREN COUNT UP AND LOOP
+
+IORPAR, ISZ PARCT /BUMP PAREN COUNT DOWN
+ JMP IOPENL-2 /LOOP IF NOT BALANCED
+ TAD IOHTMP
+ DCA KOUNT /BALANCED - NOT AN IMPLIED DO
+ JMP I .+1
+ IOH1BK /COMPILE NORMALLY
+CM25, -25
+DO, XDO
+\f *7200
+EQUI, JMS I LOOK /CHECK REST OF STATEMENT TYPE
+ -7 /THERE ARE 7 MORE CHARACTERS
+ -26 /V
+ -1 /-A
+ -14 /-L
+ -5 /-E
+ -16 /-N
+ -3 /-C
+ -5 /-E
+RETA, ISZ SNUM /INCREMENT THE STRING NUMBER
+ JMS CCCC /GET AND CHECK THE NEXT NON-BLANK CHARACTER
+ SKP /ONLY LEGAL CHAR HERE IS A "("
+ JMP RETB /WE GOT THE "("
+ NOP
+ JMP ERR59
+RETB, JMS I ENTITY /LOOK FOR A VARIABLE
+ SKP
+ JMP LA /GOT IT, ANYTHING ELSE IS AN ERROR
+ NOP
+ NOP
+ JMP ERR59
+LA, ISZ L32 /TURN EQUIVALENCE BIT ON
+ ISZ L32
+ TAD K57 /GET MASK FOR SYMBOL TABLE
+ DCA L21 /PUT IN THE SYMBOL TABLE SWITCH
+ JMS I SYMTAB /PUT IN SYMBOL TABLE
+ TAD L77 /GET THE POINTER
+ ISZ MIKE4 /AND PUT IN EQUIVALENCE TABLE
+ DCA I MIKE4
+ TAD SNUM /GET THE CURRENT STRING NUMBER
+ ISZ MIKE4 /AND PUT IT IN THE EQUIVALENCE TABLE
+ DCA I MIKE4
+ ISZ MIKE8 /INCREMENT NUMBER OF ENTRIES
+ JMS CCCC /GET NEXT PUNCTUATION
+ JMP ERR59 /C/R, THAT'S AN ERROR ...
+ JMP .+3 /LEFT PAREN, VARIABLE IS SUBSCRIPTED
+ JMP LB /COMMA, NOT SUBSCRIPTED, STRING CONTINUES
+ JMP LC /RIGHT PAREN, NOT SUBSCRIPTED, END OF STRING
+ JMS I ENTITY /LOOK FOR SUBSCRIPT
+ NOP
+ SKP
+ JMP LD /GOT IT, ANYTHING ELSE IS ERROR
+ NOP
+ JMP ERR59
+LD, CLA CMA /SUBTRACT ONE FROM
+ TAD L32 /FIRST SUBSCRIPT
+ DCA INTA /AND SAVE
+ JMS CCCC /GET NEXT PUNCTUATION
+ NOP /CR IS ILLEGAL HERE
+ JMP RETB-1 /SO IS LEFT PAREN
+ SKP /COMMA, DOUBLY SUBSCRIPTED
+ JMP LF /RIGHT PAREN, SINGLY SUBSCRIPTED
+ JMS I ENTITY /GET OTHER SUBSCRIPT
+ NOP
+ SKP
+ JMP LG /GOT IT
+ NOP
+ JMP LD-1
+LG, TAD L32 /SET IT NEGATIVE
+ CIA
+ DCA INTB /AND SAVE IT
+ JMS CCCC /GET NEXT PUNCTUATION
+ NOP
+ NOP
+ERR59, JMS I LUNCH
+ TAD L77 /RIGHT PAREN IS ONLY LEGAL CHARACTER
+ JMS I DIM /GET DIMENSION INFORMATION
+ DCA CCCC /AND SAVE
+ SKP /GO TO TEST PART OF LOOP
+ TAD CCCC /THIS LOOP IS A MAKESHIFT MULTIPLY
+ ISZ INTB /ARE WE DONE
+ JMP .-2 /NO
+ TAD INTA /YES, ADD FIRST SUBSCRIPT
+ DCA INTA /AND SAVE
+LF, TAD L77 /GET POINTER TO VARIABLE
+ JMS I MODE /WHAT MODE IS IT
+ TAD INTA /F.P., MULTIPLY BY THREE
+ RAL CLL /INTEGER
+ TAD INTA
+ IAC /ADD ONE TO ANSWER
+ ISZ MIKE4 /AND PUT IN EQUIVALENCE TABLE
+ DCA I MIKE4
+ JMS CCCC /GET NEXT PUNCTUATION
+ NOP
+ JMP RETB-1 /CR AND "(" ARE ILLEGAL HERE
+ JMP RETB /COMMA MEANS STRING NOT FINISHED
+ JMP LI /")" MEANS STRING FINISHED
+LC, CLA IAC /HERE WE CRAM A ONE INTO EQUIVALENCE
+ ISZ MIKE4
+ DCA I MIKE4
+LI, JMS CCCC /WE FINISHED A STRING, ARE THERE MORE
+ JMP START /NO
+ SKP
+ JMP RETA /YES
+ JMP RETB-1 /"(" AND ")" ARE ILLEGAL HERE
+LB, CLA IAC /CRAM A ONE INTO TABLE
+ ISZ MIKE4
+ DCA I MIKE4
+ JMP RETB /AND GO BACK
+/
+/ THIS"ROUTINE GETS AND CHECKS THE NEXT NON-BLANK CHAR
+/
+CCCC, 0
+ JMS I GNB
+ SNA /PUNCTUATION IS WHAT WE WANT
+ JMP I CCCC /ITS A CR
+ TAD CM54
+ SNA /IS IT A COMMA
+ JMP XCOMMA /YES
+ TAD C3
+ SNA /IS IT A ")"
+ JMP XRPAR /YES
+ IAC
+ SNA /IS IT A "("
+ JMP XLPAR /YES
+ JMP RETB-1 /NONE OF THE ABOVE
+XRPAR, ISZ CCCC
+XCOMMA, ISZ CCCC
+XLPAR, ISZ CCCC
+ JMP I CCCC
+K57, 57
+
+LFIN, JMS I GNB
+ SZA CLA
+ JMP I ASSIGN
+ JMS I ZZZ /PRINT LABEL ON "FINI"
+ JMP I .+1
+ IOH2
+
+/THE FOLLOWING CODE IS TO PROCESS THE EQUIVALENCE TABLE
+/AT THE END OF A COMPILATION
+\f *7376
+EEK, ISZ MIKE4
+ ISZ MIKE4
+ DCA I MIKE4 /SET END OF LIST
+ JMS INIT /INITIALIZE POINTERS
+AAB, TAD MA /SET POINTERS TO STRING NUMBERS
+ TAD C3
+ DCA MB
+ ISZ MA
+ ISZ MA
+AAC, ISZ MB
+AA, ISZ MB
+ TAD I MA /GET FIRST STRING NUMBER
+ CIA
+ TAD I MB /SUBTRACT FROM SECOND
+ SZA CLA /ARE THEY THE SAME
+ JMP KICK1 /NO, ADVANCE POINTERS
+ ISZ MA /YES, MOVE TO LINEAR SUBSCRIPT
+ ISZ MB
+ TAD I MA /GET FIRST SUBSC
+ CIA
+ TAD I MB /SUBTRACT FROM SECOND
+ SPA CLA SNA /IS FIRST ONE SMALLER
+ JMP KICK2 /NO, JUST ADVANCE POINTERS
+ TAD MA /YES, SWITCH PLACES
+ TAD CM2
+ DCA MA
+ TAD MB
+ TAD CM2
+ DCA MB
+ TAD CM3
+ DCA INIT
+RAUCH, TAD I MA
+ DCA L76
+ TAD I MB
+ DCA I MA
+ TAD L76
+ DCA I MB
+ ISZ MA
+ ISZ MB
+ ISZ INIT
+ JMP RAUCH
+ TAD MA
+ TAD CM2
+ DCA MA
+ JMP AA /NOW THEYRE SWITCHED, CHECK AGAIN
+KICK2, CLA CMA /MOVE BACK FIRST POINTER
+ TAD MA
+ DCA MA
+ JMP AAC
+KICK1, ISZ MA /MOVE UP FIRST POINTER
+ ISZ MIKE7 /ARE WE OUT OF ENTRIES
+ JMP AAB /NO
+/
+/ NOW THE SORTING IS DONE
+/
+ JMS INIT /INITIALIZE POINTERS
+ DCA TOTAL /ZERO OUT TOTAL
+MIKE2, ISZ MA
+ TAD I MA
+ JMS I PRSYM /PUT OUT THE SYMBOL
+ TAD C7240
+ JMS I P2 /PUT OUT THE TERMINATOR
+ IAC
+ TAD I MA
+ DCA L14
+ TAD I L14 /GET CONTROL BITS FROM SYMBOL TABLE
+ AND P20
+ SNA CLA /IS IT DIMENSIONED
+ JMP MIKE5 /NO
+ TAD I MA /YES, COMPUTE THE TOTAL LENGTH
+ JMS I DIM
+ DCA L26
+ TAD I L14
+ CIA
+ DCA L73
+ TAD L26
+ ISZ L73
+ JMP .-2
+ SKP /GOT IT
+MIKE5, IAC /IF NOT DIMENSIONED, USE ONE A LENGTH
+ DCA MB /SAVE LENGTH
+ TAD I MA
+ JMS I MODE /WHAT IS THE MODE OF THE SYMBOL
+ TAD MB /FP, MULTIPLY BY THREE
+ RAL CLL
+ TAD MB
+ DCA INIT /SAVE IT
+ TAD TOTAL /GET TOTAL REMAINING LENGTH OF STRING
+ CIA
+ TAD INIT /SUBTRACT CURRENT LENGTH FROM IT
+ SPA CLA /WHICH IS BIGGER
+ JMP .+3 /REMAINING PORTION IS BIGGER
+ TAD INIT /CURRENT PORTION IS BIGGER, REPLACE REMAINING PORTION
+ DCA TOTAL
+ ISZ MA
+ TAD MA
+ TAD C3
+ DCA MB
+ TAD I MB /GET NEXT ENTRY STRING NUMBER
+ CIA
+ TAD I MA /SUBTRACT CURRENT STRING NUMBER
+ SZA CLA /ARE THEY EQUAL
+ JMP MIKE1 /NO
+ ISZ MA /YES, GET THE DIFFERENCE
+ ISZ MB
+ TAD I MB
+ CIA
+ TAD I MA
+ DCA MB /AND SAVE
+ TAD MB /SUBTRACT DIFFERENCE FROM TOTAL REMAINING
+ CIA
+ TAD TOTAL
+MIKE6, DCA TOTAL /SAVE
+ TAD MB /GET THE DIFFERENCE
+ DCA L26
+ JMS I BSS /RESERVE THAT MANY LOCATIONS
+ ISZ MIKE7 /ARE WE DONE
+ JMP MIKE2 /NO
+ JMP I ROGER /YES
+MIKE1, TAD TOTAL /SWITCH TOTAL TO THE CURRENT LOCATION
+ DCA MB
+ ISZ MA /EQUALIZE POINTERS
+ JMP MIKE6
+/
+INIT, 0
+ TAD MIKE8 /GET ENTRY COUNT
+ CIA /SET NEGATIVE
+ DCA MIKE7 /SAVE
+ TAD POINTZ /GET TABLE POINTER
+ DCA MA /SAVE
+ JMP I INIT
+/
+ROGER, PTEMP
+P20, 20
+$
+
+\f
projects / pdp8.git / blobdiff