File: FORT.PA of Tape: OS8/OS8-Latest/new-11
(Source file text)
/OS8 FORTRAN II COMPILER V40
/
/
/
/
/
/
/ 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
/
/ .VERSION 40 WVDM
/
/ .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
/ 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/
ITTAB=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
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
C40, 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
*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
*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
*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
*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
*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
*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
*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
*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
*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
*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
PRIT, 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
LCOMON, 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
*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
*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
*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
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
*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
*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
*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
*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
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
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
*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
*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
*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
*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
*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
*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
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
*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
*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
*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
$