1 /OS8 FORTRAN II COMPILER V5
14 /COPYRIGHT (C) 1971,1974,1975
15 /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
19 /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
20 /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
21 /SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER
22 /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
23 /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
24 /AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
25 /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
28 /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
29 /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
30 /EQUIPMRNT COROPATION.
32 /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
33 /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
41 / SYMBOL TABLE FOR FORTRAN COMPILER (8K- PDP-8)
42 / FOR USE WITH DISK/DECTAPE MONITOR SYSTEM
43 / CHANGE LOCATION 'XFINI' TO A 'JMP I LFINI' THEN
48 / .LO FORT.BN$FPATCH.BN$
56 INBUF, TEXT /PDP-8 FORTRAN DEC-08-A2B1-5A/
59 BEGIN, PLS /INITIALIZATION ROUTINE
63 TAD CM1300 /SET SYMBOL TABLE TO ZEROS (6300-7577 FIELD 1)
74 DCA I TPTT /ZERO OUT TEMPORARY TABLES IN FIELD 0
78 TAD MIN104 /ZERO EVERYTHING FROM ZERO TO 107
85 TAD TPT /MOVE DATA FROM TABLE TO FIELD 0
89 SNA /END OF FIELD 0 INITIALIZATION?
96 DN, TAD I TPTT /MOVE DATA FROM TABLE TO FIELD 1
97 SNA /END FIELD 1 INITIALIZATION
112 BSYMP, BSYM-1 /BOTTOM OF TEMPORARY SYMBOL TABLE
113 STRT, FORST /STARTING POINT AFTER INITIALIZATION
167 0 /THIS TERMINATES FIELD ZERO INITIALIZATION
176 \f/ ERROR MESSAGE TABLE AND TEXT
178 ELIST, -ERR1-1; EMSG1 /ILLEGAL CONTINUATION
179 -ERR2-1; IE /ILLEGAL ARITHMETIC EXPRESSION
189 -ERR18-1; SE /SYNTAX ERROR
192 -ERR30-1; EMSG8 /ILLEGAL VARIABLE
197 -ERR38-1; EMSG9 /ILLEGAL DO NESTING
200 -ERR41-1; EMSG10 /EXPRESSION TOO BIG
202 -ERR43-1; EMSG11 /MIXED MODE
204 -ERR47-1; SF /SUBR. OR FUNCT. STMT. NOT FIRST
209 -ERR53-1; EMSG12 /ILLEGAL SUBSCRIPT
210 -ERR54-1; EMSG13 /ILLEGAL EQUIVALENCING
213 0; EMSG14 /COMPILER MALFUNCTION
215 EMSG1, TEXT /ILLEGAL CONTINUATION/
216 IE, TEXT /ILLEGAL ARITHMETIC EXPRESSION/
217 EMSG3, TEXT /ILLEGAL STATEMENT/
218 EMSG4, TEXT /ILLEGAL CONSTANT/
219 EMSG5, TEXT /ILLEGAL STATEMENT NUMBER/
220 EMSG6, TEXT /SYMBOL TABLE EXCEEDED/
221 SE, TEXT /SYNTAX ERROR/
222 EMSG8, TEXT /ILLEGAL VARIABLE/
223 EMSG9, TEXT /ILLEGAL OR EXCESSIVE DO NESTING/
224 EMSG10, TEXT /ARITHMETIC EXPRESSION TOO COMPLEX/
225 EMSG11, TEXT /MIXED MODE EXPRESSION/
226 EMSG12, TEXT /EXCESSIVE SUBSCRIPTS/
227 EMSG13, TEXT /ILLEGAL EQUIVALENCING/
228 EMSG14, TEXT /COMPILER MALFUNCTION/
229 CE, TEXT /UNBALANCED QUOTES/
230 SF, TEXT /SUBR. OR FUNCT. STMT. NOT FIRST/
231 EMSG36, TEXT /ARRAY TOO LARGE/
238 / THE STATEMENT TYPE TABLE FOLLOWS
295 0000 /THIS IS THE END OF LIST
299 / THE PRECEDENCE TABLE FOLLOWS, NON-ZERO PREC. OPERATORS APPEAR
300 -45 / PREC('%') = 7 NOTE: '%' REPLACES '**'
312 -74 / PREC('<') = 1 NOTE: '<' IMPLIES SUBSCRIPTED ASSIGNMENT
314 1 /THIS IS THE END OF THE TABLE
320 / THE PERMANENT SYMBOL TABLE BEGINS HERE
503 L12, 0 /LAST LINE'S CONTENTS FOR OPTOMIZATION
506 L15, 2377 /POINTER INTO DOEND LIST
509 L20, 0 /FLAG, NON-ZERO IF '=' SEEN
511 L22, 0 /SUBSCRIPT NESTING LEVEL
512 L23, 0 /USED BY "DUMARG" AND "IOHAR" PATCH
514 L25, 0 /HIGHEST SUBSCRIPT TEMP USED
515 L26, 0 /USED FOR DIMENSION INFORMATION
517 L30, 0 /FOLLOWING EIGHT LOCS ARE USED BY ENTITY
525 L40, 0 /CONTAINS THE CURRENT TRIPLE NUMBER
526 L41, 0 /THIS IS THE POINTER INTO THE PUSH DOWN LIST
527 L42, 0 /THESE TWO LOCATIONS ARE USED BY THE TRIPLE PROCESSOR
529 L44, 0 /CONTAINS ONE FOR RIGHT OF EQUALS, ZERO FOR LEFT
530 L45, FTTAB /CONTAINS LARFEST FLOATING POINT TEMPORARY NUMBER USED
531 L46, 0 /CONTAINS NUMBER OF THE TRIPLE CURRENTLY IN THE AC
532 L47, 7575 /CONTAINS THREE LESS THAN START OF FCON TABLE
533 L50, 7600 /CONTAINS START OF DIMENSION TABLE
534 L51, ITTAB /CONTAINS LARGEST INTEGER TEMPORARY NUMBER USED
535 L52, 0 /CONTAINS ONE IF RETURN FROM GENER IS DESIRED FOR BALANCE
536 L53, 0 /CONTAINS THE LAST CREATED LABEL
537 L54, 0 /CONTAINS THE LABEL FOR THE CURRENT STATEMENT
538 L55, -25 /CONTAINS THE MAXIMUM ALLOWABLE NUMBER OF UNENDED DOS
539 L56, 6300 /CONTAINS BEGINNING OF SYMBOL TABLE
540 L57, 6300 /CONTAINS END OF SYMBOL TABLE
541 L60, 0 /"INDIRECT =" FLAG FOR S.S LEFT OF EQUALS SIGN
542 L61, 0 /NON-ZERO IF LAST STMT READ IS A COMMENT
543 L62, 0 /NEXT FOUR LOCATIONS USED BY GENER AND ENTITY
544 L63, 0 /CONTAINS THE CURRENT OPERATOR
545 L64, 0 /POINTS TO THE LAST OPERATOR IN THE STACK
546 L65, 0 /CONTAINS THE PRECEDENCE OF THE CURRENT OPERATOR
547 BPAREN, 0 /PARENTHESIS COUNTER
548 L67, 0 /ONE FOR FUNCTION AND ZERO FOR SUBROUTINE
549 L70, 0 /CONTAINS POINTER TO SUBPROGRAM NAME
550 L71, 5777 /BEGINNING OF PUSHDOWN LIST
551 L72, 0 /SET TO ONE IF SUBSCRIPT IS ENCOUNTERED
553 L74, 3000 /BEGINNING OF ERASABLE LOCATIONS USED FOR PARAMETERS
554 L75, 0 /SET TO ONE SUPPRESS /OUTPUT FROM COMPILER
556 L77, 0 /CONTAINS ADDRESS OF LAST ENTRY INTO FCON OR SYMBOL TABLE
557 /THE FOLLOWING THREE LOCS ARE USED BY THE
559 COUNT2, 0 /NUMBER OF DIGITS TO RIGHT OF DECIMAL POINT
560 ESIGN, 0 /0 MEANS POSITIVE EXPONENT, 1 MEANS NEGATIVE
561 FPSW, 0 /0 MEANS INTEGER CONSTANT, 1 MEANS FLOATING POINT
569 IMPDO, 0 /"IMPLIED DO-LOOP IN PROGRESS" FLAG
571 ASSIGN, LASIGN /ROUTINE TO PROCESS ASSIGNMENT STATEMENTS
572 PUTCH, LPUTCH /ROUTINE TO PUT A CHARACTER BACK IN THE INPUT BUFFER
573 PROP, LPROP /PRINTS OPCODES
574 PRCRL, LPRCRL /PRINTS CREATED LABELS
575 PRINT, LPRINT /PRINTS ONE ASCII CHAR
576 P2, LP2 /PRINT TWO PACKED ASCII CHARS
577 GETCH, LGETCH /GETS ONE CHARACTER OUT OF THE INPUT BUFFER
578 LUNCH, LLUNCH /PRINTS ERROR COMMENTS
579 MODE, LMODE /DETERMINES THE MODE OF THE ARGUMENT
580 LOOK, LLOOK /CHECKS FOR THE REST OF THE INPUT STATEMENT
581 ZZZ, LZZZ /PRINTS OUT STATEMENT LABELS
582 ENTITY, LENTT /GETS THE NEXT LOGICAL INPUT PARAMETER
583 SYMTAB, LSYMTB /ENTERS SYMBOLS INTO THE SYMBOL TABLE
584 DUMARG, LDMARG /SEES IF PARAMETER IS A DUMMY ARG OR SUBSCRIPT
585 PRSYM, LPRSYM /PRINTS SYMBOLS
586 CREATE, LCREAT /CREATES LABELS
587 PROTAC, LPRTAC /PRINTS CONTENTS OF AC IN OCTAL
588 PLAB, LPLAB /PRINTS LABELS
589 PIFF, LPIFF /PUTS OUT AN IFF FOR THE CONTENTS OF THE AC
590 TRIPL, LTRIPL /PROCESSES THE TRIPLES GENERATED FROM AN EXPRESSION
591 GENER, LGENER /GENERATES THE TRIPLES
592 LCHNG, CHNG /TEST FOR DUMMY ARG AND REPLACE
593 CLAB, LCLAB /HANGS A CREATED LABEL ON THE NEXT LINE
594 STORE, LSTORE /STORES THE CONTENTS OF THE AC
595 FPROP, LFPROP /PUT OUT CALLS TO F.P. ROUTINES
597 DUM, LDUM /PROCESSES OCCURRANCES OF DUMMY ARGUMENTS IN LISTS
598 DIM, LDIM /LOOKS UP DIMENSION INFORMATION ON VARIABLES
599 PUNCH, LTTYPE /ADDRESS OF CURRENT OUTPUT ROUTINE
603 C7240, 5440 /THIS WAS COLON-SPACE NOW ITS COMMA-SPACE
622 START, CLA /COME HERE AT BEGINNING OF EACH STMT
626 JMP ERR1 /IF IMPDO<>0 THEN WE MUST HAVE SCREWED UP ON
627 /CONTINUATIONS (I THINK)
628 ISZ CHK /IS THERE A STMT IN THE BUFFER?
630 JMS I SWAP /YES, SWITCH BUFFER POINTERS
633 JMS I RCD /NO, READ THE NEXT LINE
636 DCA L16 /SET UP XR FOR DO TERMINATION TEST
640 SZA CLA /ARE WE TERMINATING A DO?
642 JMS LDNEXT /TERMINATE DO LOOP
643 JMP TEST /SEE IF THERE IS ANY MORE...
648 SZA CLA /ILLEGAL CONTINUATION?
650 JMS I STMT /GET THE STMT NR...
653 JMP .+4 /NO STMT NUMBER
656 SZA CLA /CAN WE OMIT A TERMINAL JMP?
659 FLST, JMS LIST /PUNCH SOURCE STMT
660 JMS I WIPE /ZERO THE SUBSCRIPT TEMP. TABLE
670 JMS I PUTCH /PUT CHARACTER BACK
678 JMS I PUTCH /PUT CHARACTER BACK
684 TAD SSTYP /COMPARE THESE CHARS WITH DISPATCH TABLE
687 SNA /END OF THE TABLE?
688 JMP I ASSIGN /YES, MUST BE ARITHMETIC STMT
696 TAD I L17 /FOUND A MATCH, GO TO PROPER HANDLER...
701 JMP TRY /DOESN'T MATCH, TRY AGAIN
704 TAD L15 /RESET THE DO END POINTER
713 JMS I PROP /PUNCH 'JMP <LABEL>'
718 TAD I L16 /PUNCH '<LABEL>,'
725 LIST, 0 /PUNCH THE SOURCE STATEMENT
726 TAD BASE /GET THE POINTER
728 TAD I PTEM /PUNCH A CHARACTER PAIR...
733 SZA CLA /END OF THE BUFFER?
735 JMS I PRINT /YES, PUNCH A CR-LF AND RETURN
738 CMNT, JMS I PRINT /WE HAVE A COMMENT
741 JMP START1 /ALLOW COMMENTS BEFORE SUBR. OR FUNCTION STMT.
747 SSTYP, STYPE-1 /POINTER TO STATMENT TABLE IN FIELD 1
752 / THE FOLLOWING ROUTINE IS ENTERED WITH THE BUFFER POINTER IN THE AC
753 / IT PUTS ONE LINE INTO THE BUFFER,
754 / CHECKS FOR COMMENTS AND COUTINUATION LINES, AND IF IT IS A
755 / CONTINUATION IT SETS KOUNT TO THE PROPER COLUMN
758 DCA TEM1 /SAVE THE BUFFER POINTER
760 DCA CHK /ZERO CONTINUATION FLAG
761 DCA L20 /ZERO THE EQUALS FLAG
762 DCA L61 /ZERO THE COMMENT FLAG
763 TAD CM111 /BUFFER LIMIT IS 72 CHARACTERS
768 SZA /LEADER OR BLANK TAPE?
784 TAD C75 /CHAR OK... RESTORE IT & PUT IN BUFFER
785 JMS KRONK /PUT IT IN THE BUFFER...
786 JMP LRCDL /AND GET ANOTHER
788 LCAR, TAD IX /PROCESS A CAR RETURN...
791 SNA CLA /NULL STATEMENT?
792 JMP LRCDL /YES, IGNORE
793 JMS KRONK /PUT A ZERO IN THE BUFFER
799 SZA CLA /TEST FOR "S" IN COLUMN ONE
802 COMNT, ISZ L61 /SET COMMENT FLAG...
806 TINUE, TAD TEM1 /CHECK FOR CONTINUATION...
808 DCA P /SET THE POINTER TO COLS. 6 AND 7
810 AND C5700 /NON-ZERO OR NON BLANK IN COL 6
811 TAD C4000 /MAKES THIS A CONTINUATION...
814 LRCDX, TAD B7 /YES, MAKE IT START IN COL 7
816 ISZ CHK /INCREMENT THE CONTINUATION FLAG
818 STORSL, TAD C5700 /MAKE THIS INTO A COMMENT LINE
820 JMP I LRCD /THEN RETURN
822 LRCDA, TAD I P /NUMERIC AND NON-ZERO IN COL 7 MAKES
823 AND C77 /THIS A CONTINUATION...
826 JMP LRCDX+3 /NO, RETURN
827 IAC /YES, MAKE IT START IN COL 8
830 TAB, TAD C40 /PROCESS TAB CHARACTERS...
831 JMS KRONK /PUT SOME SPACES IN THE BUFFER
833 TAD C3 /MAKE 1ST TAB GO TO COL 7
834 SMA /ARE WE AT END OF THE BUFFER?
835 CLA /YES, FORCE TERMINATION
838 JMP TAB /NO, PUNCH SOME MORE SPACES
839 JMP LRCDL /YES, GET ANOTHER CHAR
841 KRONK, 0 /PUT A CHARACTER IN THE BUFFER...
844 TAD IX /FIRST COMPUTE BUFFER ADDRESS...
846 JMP I KRONK /YES-RETN.
851 TAD CAR /PICK UP THE CHARACTER
853 SZL /ZERO LINK SAYS WE WANT THE LEFT HALF
859 TAD I P /ADD IN THE LEFT 6 BITS
860 DCA I P /AND SALT THEM AWAY...
861 ISZ IX /BUFFER OVERFLOW?
864 LPTRIN, 0 /PAPER TAPE READER INPUT ROUTINE
870 CAR, 0 /TEMPORARY, HOLDS THE CURRENT CHARACTER
871 P, 0 /THIS IS THE BUFFER POINTER
872 TEM1, 0 /THIS CONTAINS THE CURRENT BUFFER ADDRESS
873 IX, 0 /THIS IS THE CHARACTER COUNTER
874 CM111, -111 /MINUS THE BUFFER LIMIT PLUS ONE
875 C111, 111 /THIS IS THE BUFFER LIMIT PLUS ONE
885 CAL, TAD KOUNT /SUBROUTINE CALL STMT PROCESSOR
897 SZA /MAYBE, IS THIS A '(' ?
899 JMS I ZZZ /YES, PUNCH STMT NR, IF ANY
904 DCA L52 /IF STATEMENT SWITCH
905 JMS I GENER /LET TRIPLE GENERATOR PROCESS IT
906 DCA L46 /ZERO AC AGAIN
907 JMP START /COMPLETE, GET NEXT STATEMENT
908 CR2, ISZ L32 /NO ARGUMENTS
912 JMS I ZZZ /PUNCH '<LABEL>, CALL 0,<NAME>'
927 SNA /IS IT A END OF CARD
928 JMP PUNC /YES ITS PUNTUATION
930 SPA SNA /IS IT ALPHABETIC
937 PUNC, ISZ LGETCH /PUNCTUATION
938 ALPHA, CLA /ALPHABETIC
941 / THIS ROUTINE DETERMINES WHETHER SYMBOL IS FP OR INTEBER
942 / ROUTINE SKIPS IF SYMBOL IS INTEGER
944 SMA /IF ITS PLUS WE HAVE AN INTEGER
945 JMP AINT /WE HAVE AN INTEGER
948 JMP FV /ITS EITHER A FCON OR VARIABLE
949 RTL /GET NEXT TWO BITS
950 SNL /IS IT AN OPERATOR
951 ERR2, JMS I LUNCH /YES
952 AFP, SMA CLA /CHECK THIS BIT
953 JMP AINT /ITS AN INTEGER
954 JMP I LMODE /SYMBOL WAS F P MODE
955 FV, RAR /RESTORE AC TO ORIGINAL CONTENTS
957 TAD L47 /ADD START OF FCON TABLE
960 CIA /NO /RESTORE AC AGAIN
962 DCA ATEM /SAVE THE RESTORED NUMBER
963 TAD I ATEM /GET THE POINTER TO THE VARIABLE
964 TAD CM1100 /SUBTRACT AN I
965 SPA /IS IT LESS THAN I
966 JMP AFP /YES ITS FLOATING POINT
967 TAD CON1 /NOW SUBTRACT AN N
968 SPA CLA /IS IT LESS THAN N
970 CON1, CLA /CLEAR THE AC FOR THE RETURN
975 LGTC, 0 /GET A CHARACTER FROM THE BUFFER
978 CLL RAR /LINK TELLS IF LEFT OR RIGHT HALF
991 SPA CLA /DO WE WANT A NEW LINE YET?
992 JMP I LGTC /NOT YET...
993 TAD BASE2 /YES, USE THE ALTERNATE BUFFER
996 SZA CLA /IS IT A CONTINUATION?
998 CMA /NO, SET FLAG AND RETURN W ZERO AC
1001 JMS LSWAP /YES, SWITCH BUFFERS AND CONTINUE
1006 LSWAP, 0 /SWITCH THE LINE BUFFER POINTERS
1015 / THE POINTER TO THE CURRENT LOCATION IN THE PUSH LIST IS
1016 / IN LOC 41, THE CURRENT TRIPLE NUMBER IS IN LOCATION 40
1017 / LOC 44 MUST BE SET TO 0 IF THERE IS AN '=' , TO 1 IF NOT.
1018 PBEGN, AREA2 /START OF THE PRECEDENCE LIST
1019 BINTEG, TAD L32 /HERE IF ENTITY SENT AN INTEGER
1020 JMP I BPUSH /PUSH IT INTO STACK
1021 FLPT, JMS I FCON /HERE IF ENTITY FOUND A FLOATING POINT CON
1022 SKP /ENTER IT INTO FPTABLE
1023 BLPHA, JMS I SYMTAB /HERE IF ENTITY FOUND A VARIABLE
1024 TAD L77 /PICK UP POINTER INTO SYM TAB OR FLPT TAB AN
1025 JMP I BPUSH /PUSH IT DOWN
1026 LABELX, JMP I LGENER
1027 LGENER, 0 /ENTRY POINT
1030 DCA L21 /ZERO THE SYMBOL TABLE SWITCH
1032 DCA L41 /SET PUSH DOWN POINTER
1034 DCA BPAREN /ZERO OUT THE PAREN SWITCH
1036 DCA I L41 /FIRST PUSH DOWN LEFT CLOSURE NAMELY 0
1037 BNEXT, JMS I ENTITY /THIS WILL GET THE NEXT DATUM TO BE PROCESSE
1038 JMP HOO /END OF STATEMENT RETURN,TREAT LIKE PUNCTION
1039 JMP BLPHA /VARIABLE RETURN
1040 JMP BINTEG /INTEGER RETURN
1041 JMP FLPT /FLOATING POINT RETURN
1042 HOO, TAD CM50 /PUNCTIOATION RETURN,
1048 TAD L44 /WE HAVE AN '=', IS IT LEGAL?
1052 SZA CLA /ARE WE IN AN IMPLIED DO LOOP?
1053 JMP I PIOEQL /YES - TERMINATE LOOP CODE
1058 TAD I L41 /CHECK FOR A UNARY OPERATOR
1061 SZA CLA /WAS IT AN OPERAATOR AT ALL
1062 JMP PREC /NO, STILL NOT UNARY OPERATOR
1066 JMP BNEXT /YES, IGNORE IT
1068 SZA CLA /IS IT A '-' ?
1070 TAD C4643 /THIS IS THE UNARY MINUS
1072 PREC, TAD PBEGN /HERE IS WHERE WE FIND THE PRECIDENCE
1076 RETUR, ISZ L17 /PICK UP NEXT OP CODE IN LIST
1077 TAD I L17 /TO GET THE NEXT LIST ITEM
1078 SMA SZA /IS THIS THE END OF THE LIST
1079 JMP BMORE /NO, THE ASSUMPTION IS THAT THE PRECIDENCE
1081 SZA CLA /IS THIS THE RIGHT TABLE ENTRY
1082 JMP RETUR /TRY AGAIN (IT WASN"T)
1083 TAD I L17 /TO GET THE PRECEDENCE
1085 BMORE, CLA IAC /HERE WE ARE GOING TO SEE IF THERE IS A PREC
1087 DCA L64 /L64 NOW POINTS TO THE PREVIOUS OPERATOR
1091 SZA /IS THERE A VALID OPERATOR ON THE STACK?
1092 JMP ERR3 /APPARENTLY NOT...
1093 TAD I L64 /IF THE PRECEDENCE OF THE PREVIOUS OPERATOR
1094 AND C700 /IS NON-ZERO, AND ITS PRECEDENCE IS GREATER
1095 SNA /THAN OR EQUAL TO THE PRECEDENCE OF THE
1096 JMP NO /CURRENT OPERATOR, THEN PROCESS THE PREVIOUS
1097 CIA /OPERATOR; IF NOT WE WILL PROBABLY PUT
1098 TAD L65 /THE CURRENT OPERATOR ON THE STACK AND GET
1099 SMA SZA CLA /ANOTHER ITEM FROM THE STATEMENT BUFFER...
1101 ISZ L40 /YES, INCREMENT THE TRIPLE NUMBER AND....
1102 JMS I TRIPL /PROCESS THE PREVIOUS OPERATOR
1103 ISZ L41 /*****NOTE WHAT IF IT WAS UNARY************
1105 TAD C3135 /THIS IS MINUS UNARY MINUS
1107 ISZ L41 /DELETE THE LAST 3 ITEMS AND REPLACE WITH TR
1110 JMP BMORE /TRY FOR ANOTHER TRIPLE
1112 SNA /IS IT A END OF STATEMENT MARK
1113 JMP I LCDONE /IT WAS--WE ARE ALL FINISHED, EXCEPT CHECKING
1121 SNA CLA /IS A COMMA LEGAL HERE?
1122 JMP I LCDONE /MAYBE...
1124 SNA CLA /IS IT AN EQUALS SIGN?
1125 ISZ L44 /YES - SET EQUALS SWITCH ON
1126 TAD L63 /PUT THE OPERATOR ON THE STACK
1127 TAD L65 /ADD THE PRECEDENCE
1148 TAD L41 /SPACE THE POINTER UP ONE
1152 JMP I LBNEXT /BACK TO BEGINING
1153 / THIS IS TO PROCESS SUBSCRIPTS OR FUNCTION CALLS---
1154 / IF ARITHMETIC, JUST DELETE BOTH ( AND )
1156 TAD C3730 /MINUS LEFT PAREN
1158 JMP BCON /NO-- CHECK SOME MORE
1159 TAD I L41 /DELETE PARENS
1161 ISZ L41 /UPDATE POINTER
1162 LAPP, ISZ BPAREN /DO PARENS BALENCE
1165 SNA CLA /SHOULD WE RETURN IF BALANCED
1172 JMS I XTAD /GENERATE TAD OR (TAD I)
1173 DCA I L41 /ZERO IS INTEGER
1178 ERR6, JMS I LUNCH /HA...YOU GOOFED
1182 BCON, IAC /IS IT FUNCTION
1186 IAC /NO-- NOW IS IT SUBSCRIPT
1191 JMP ERR6 /NO - BYE BYE CHARLIE
1195 TAD C3724 /IS IT A COMMA
1197 JMP BFOUT /FOUND TWO COMMAS,MUST BE FUNCTION
1200 JMP BFOUT /GOT A FUNCTION
1203 JMP ERR6 /SORRY, IT AIN'T NUTTIN
1204 SOUT, JMS I PLSBSC /PROCESS A SUBSCRIPT
1212 / THIS IS WHERE WE FIND OUT WHAT KIND OF LPAR
1218 AND B7000 /IS IT AN OPERAND
1220 JMP CUNT /NO , TRY SOME MORE
1223 CUNT, TAD I L41 /PICK UP TOP LIST ITEM
1224 TAD C2 /ADD TWO TO FIND THE DIMENSION INTO(INFO)
1227 AND C20 /JUST WANT ONLY THIS ONE BIT(DIMENSION)
1228 SNA CLA /IS IT DIMENSIONED
1229 JMP PRIME /NO ITS GOT TO BE A FUNCTION CALL
1233 JMP PUSH /GO PUSH A PRIME, IT IS THE FUNCTIONS LEFT PAREN
1251 LASIGN, TAD L20 /ARITHMETIC STATEMENT PROCESSOR
1252 SNA CLA /IS THERE AN '=' IN THE STMT?
1253 ERR9, JMS I LUNCH /NO, BETTER COMPLAIN...
1254 TAD D7 /SET POINTER TO COL 7
1256 JMS I ZZZ /PUNCH THE LABEL, IF ANY
1260 JMS I GENER /PROCESS IT...
1262 SZA CLA /WAS TERMINATOR A <CR/LF> ?
1263 JMP ERR9 /NO, ILLEGAL STATEMENT ERROR ...
1267 LPRCRL, 0 /SUBROUTINE PRINTS CREATED LABELS
1271 TAD LPRCTM /PUNCH THE LETTERS
1277 PRET, ISZ LENTT /PUNCTIONATION EXIT POINT
1278 FRET, ISZ LENTT /FLOATING POINT EXIT POINT
1279 XIRET, ISZ LENTT /INTEGER EXIT POINT
1280 XARET, ISZ LENTT /VARIABLE EXIT
1281 ERET, JMP I LENTT /CR END OF LINE EXIT
1282 LENTT, 0 /ENTRY POINT
1283 CLA /WIPE OUT PSEUDO ACCUMULATOR
1286 DCA COUNT2 /RESET ALL KINDS OF THINGS TO ZERO
1293 DCA L65 /SET UP FOR MAXIMUM OF 6 CHARS
1294 JMS I GETCH /GET THE FIRST INPUT CHARACTER
1295 JMP .+3 /ALPHA RETURN
1296 JMP PUNCT /PUNCTIONATION RETURN
1297 JMP DIG /DIGIT RETURN
1298 JMS PACK /STORE THIS CHARACTER
1299 JMS I GETCH /GET ANOTHER CHACTER
1300 JMP .-2 /ALPHA- IS OK
1302 JMP .-4 /DIGIT--IS OK PROCESS IT
1303 JMS I PUTCH /PUT THAT PUNCTUATION BACK IN THE BUFFER
1305 AND CC7700 /MAKE SURE NAME IS <= 5 CHARACTERS LONG
1307 JMP XARET /RETURN WITH VARIABLE
1309 PACK, 0 /THIS PACK CHARS INTO L30 L31 AND L32
1310 DCA L64 /SAVE THE CHAR...
1312 SNA /DO WE HAVE SIX CHARS ALREADY?
1313 JMP I PACK /YES - IGNORE
1321 SNL /DO WE HAVE LEFT OR RIGHT HALF?
1323 CLL RTL /MUST BE LEFT HALF...
1333 PUNCT, SNA /HERE TO PROCESS PUNCTION---IS IT A CARIAGE RET
1334 JMP ERET /YES, GO RIGHT BACKTO THE CALLER....BY-BY
1335 TAD C7722 /IS IT A PERIOD
1337 JMP CC /YES--WE ASSUME THAT THIS LENTT IS A FLOATING
1340 JMP I QUOTE /YES - CHARACTER LITERAL
1342 SZA /IS IT AN ASTERISK
1344 JMS I GETCH /YES- PEEK AT NEXT CHAR
1345 JMP NOASS /ALPHA-- PUT IT BACK
1346 JMP ASSCK /PUNCTUATION-- CHECK FOR AN ASTERISK
1347 NOASS, JMS I PUTCH /DIGIT---PUT IT BACK
1348 NAH, TAD X52 /RESTORE CHARACTER TO WHAT IT WAS
1349 JMP PRET /THATS ALL---IT WAS PUNCTIONATION
1350 ASSCK, TAD CM52 /ANOTHER PUNCTUATION--IS IT (*)
1352 JMP NOASS /NO---PUT IT BACK
1353 TAD C45 /IT WAS-- CHANGE ** TO PERCENT
1354 JMP PRET /---ALTERED PUNCTUATION
1355 DIG, AND C17 /FIRST CHAR WAS A DIGIT, DONT KNOW IS INTEGER O
1356 DCA L32 /AT ANY RATE SAVE IT IN THE PSEUDO ACCUMULATER
1357 CA, JMS I GETCH /GET ANOTHER CHACTER
1358 JMP I LTESTE /ALPHA--GO SEE IF IT IS AN -E-
1360 JMP BONT /DIGIT GO PROCESS IT
1361 TAD C7722 /PUNCTUATION HERE, IS IT A PERIOD
1363 JMP I LCOP / IT IS . WE HAVE A FLOATING POINT NUMBER
1366 ERR10, JMS I LUNCH /TOO MANY (.)
1369 JMP CA /GO BACK AND GET ANOTHER CHAR
1370 BONT, AND C17 /***COME HERE WITH ANOTHER DIGIT.
1373 JMS I LMUL10 / AC = AC * 10 + DIGIT
1374 JMP CA /GO GET ANOTHER CHAR
1388 DMPLIN, 0 /SUBROUTINE TO DUMP "LAST LINE" BUFFER
1390 TAD I L24 /GET NEXT CHAR
1391 JMS I PUNCH /PUNCH IT
1394 SZA CLA /IS CHAR A LINE FEED?
1397 DCA L24 /RESET POINTER
1398 DCA L12 /ZERO CONTENTS FLAG
1399 JMP I DMPLIN /RETURN
1403 TESTE, TAD C7773 /IS IT E
1405 JMP COP /NO, GO PUT IT BACK AND PROCESS
1406 / HERE IF EXPONENT FOLLOWES
1407 DCA L37 /IT WAS AN E
1408 / THIS ROUTINE IS TO PROCESS THE EXPONENT THAT FOLLOWES THE -E- THAT WE
1410 ISZ FPSW /MAKE SURE THE FLOATING POINT SWITCH WAS KICKED
1411 JMS I GETCH /GET ANOTHER CHAR
1412 JMP ERR12 /ALPHA , CANT BE-- SO LONG, ITS BEEN NICE
1414 JMP CD /DIGIT, GO PROCESS IT
1415 TAD X7725 /IS IT PULS SIGN
1417 JMP CF /YES, IGNOR IT
1420 JMP COP /NO, GO PROCESS THE FLOATING POINT NUMBER
1422 DCA ESIGN /YES- REMEMBER THAT THE EXPONENT WAS MINUS
1423 CF, JMS I GETCH /GET ANOTHER CHAR
1424 JMP COP /ALPHA, ALL READY TO PROCESS
1425 JMP COP /PUNCTUATION, READY TO PROCESS
1427 DCA L36 /SAVE IT IN 36 AND..
1428 TAD L37 /MULTIPLY THE - EXPONENT TO DATE- BY 10
1435 TAD L36 /AND ADD IN THIS DIGIT I.E. 37C10*
1436 DCA L37 / L37 = 10 * L37 + L36
1437 JMP CF /GO DO IT AGAIN
1439 CLA CLL /PROCESS THIS NUMBER
1440 TAD FPSW /IS IT AN INTEGER
1442 JMP CH /NO, MUST BE FLOATING POINT
1445 SNA /MAKE SURE INTEGER IS VALID
1451 ERR12, JMS I LUNCH /TOO BIG
1452 JMP I .+1 /TAKE INTEGER RETURN WITH INTEGER IN 32
1454 CH, TAD L37 /WAS THIS AN E-CONVERSION NUMBER
1455 ISZ ESIGN /EXPONENT POSITIVE?
1457 TAD COUNT2 /ADD POST-DECIMAL COUNTER
1460 JMP CM /NOTHING TO DO
1461 SMA /DETERMINE WHETHER TO
1462 CML CIA /MULTIPLY OR DIVIDE
1467 JMS XFLOAT /SET UP THE NUMBER
1468 CK, HLT /JMP I (MULT OR JMP I (DIVIDE
1470 JMP CK /LOOP ON COUNT
1471 JMP I LPOLIS /FINISH UP
1479 / THIS ROUTINE CONVERTS THE NUMBER TO FLOATING POINT
1482 TAD L32 /CHECK IF THE ACCUMULATED NUMBER IS ZERO
1488 JMP I LFRET /IT WAS ZERO SEND A FLOATING POINT ZERO BACK--
1489 TAD C2440 /IT IS NOT ZERO--SET THE EXPON TO 36 BASE 10
1491 JMS NORMAL /GO TO THE NORMALIZE ROUTINE
1492 JMP I XFLOAT /AT THIS POINT THE MANTISA AND EXPON ARE SEPERA
1493 / ALSO NOTICE THAT WE HAVE 36 BINARY DIGITS I E THE WHOLE 3 WORDS ARE U
1494 / NORMAL IZATION OF A F P NUMBER
1496 DA, TAD L30 /WE MUST SHIFT UNTIL THE HIGH ORDER WORD GOES N
1498 JMP I NORMAL /IT IS NEG., ALL DONE
1499 JMS I LLSHIF /GO DO A TRIPLE PRECISION LEFT SHIFT
1500 TAD L37 /AND SUBTRACT ONE FROM THE EXPONENT
1501 TAD C7770 /NOTE-- THE 3 LOW ORDER BITS ARE NOT USED
1502 SPA /IF THIS DOESNT SKIP WE HAVE F P OVERFLOW
1503 JMP ERR12 /BY-BY NUMBER TOO LARGE FOR THE MACHINE
1506 / THE FOLLOWING ROUTINE SAVES THE ACC IN THE MQ
1516 SCODE, CDF 10 /SHIFT S-CODE 2 COLS. LEFT
1523 ISZ L61 /SET COMMENT FLAG
1528 SNA CLA /END OF LINE?
1532 JMP SCODL /AND CONTINUE PROCESS
1537 XSAVE, 0 /-- THE F.P. AC IS IN LOCS 30-32
1538 TAD L30 /-- THE "MQ" IS IN LOCS 33-35
1539 DCA L33 /---THE EXPONENT IS IN LOCS 37
1545 / SHIFTS THE PSEUDO-ACC LEFT ONE PLACE
1558 / THE FOLLOWING ROUTINE ADDS THE MQ TO THE ACC
1573 / THE FOLLOWING ROUTINE SHIFTS THE ACC RIGHT ONE PLACE
1588 MULT, 0 /ACCCACC*10 MQ
1593 JMS ADD /THIS FINISHES THE MULT BY 10
1594 TAD L37 /NOW DIDDLE THE EXPONENT
1597 ERR14, JMS I LUNCH /FLOATING POINT OVERFLOW
1599 JMS I LNRMAL /MAKE SURE THE F P NUMBER IS STILL IN NORMAL FO
1601 DIVIDE, 0 /DIVIDE THE F P NUMBER BY 10
1602 JMS RSHIFT /BASED ON THE FACT THAT .1 BASE 10 C .000110011
1603 JMS XSAVE /THAT IS WE MULTIPLE BY ONE TENTH
1604 TAD C7766 /THIS IS A COUNTER**********************
1617 TAD C7750 /********INSERT HERE THE CONSTANT************
1618 DCA L37 /WE HAVE JUST DIDDLED THE EXPONENT BY THE PROP
1619 JMS I LNRMAL /MAKE SURE IT IS STILL NORMALIZ D
1622 MUL10, 0 /THIS MULTIPLIES THE TRIPLE PREC. INTEGER INT E
1628 TAD L36 /NOW CRAM THE DIGIT THAT WE WANT TO ADD INTO TH
1632 JMS ADD /AND ADD IT TO THE ACC
1633 JMP I MUL10 /IN OTHER WORDS ACCCACC*10 DIGIT
1634 POLISH, CLA CLL /THIS TAKES THE SEPARATE MANTISSA AND EXP--ENT.
1635 TAD C400 /AND PUTS THEM INTO 7090 FORM. THIS IS THE R-U
1637 DCA L34 /ROUND FACTOR IS CRAMED INTO THE MQ
1639 JMS ADD /AND ADDED TO THE INTEGER IN THE ACC
1640 SNL /IF THE LINK IS ON, WE OVERFLEW ON THE CARRY
1642 TAD C4000 /SET THE ACC TO .1000000000 (THE REST OF IT IS
1644 TAD L37 /DIDDLE THE EXPONENT BY ONE. THIS IS A FINKIE N
1647 JMP ERR14 /EXPONENT OVERFLOW ...
1649 POLSH, TAD C7767 /NOW SHIFT THE ENTIRE ACC RIGHT 9 TIMES
1650 DCA ZCTR /( THATS SO WE WILL HAVE ROOM TO STICK IN THE E
1654 TAD L37 /CRAM THE EXP
1655 TAD L30 /INTO THE ACC
1656 DCA L30 /AND VOILA, WE ARE DONE. GO TAKE THE FPOINT EX
1666 / THE FOLLOWING ROUTINE LOOKS FOR A STATEMENT NUMBER
1668 JMS I CLEAR /CLEAR THE PSEUDO ACC AND MQ
1669 TAD C7240 /DON'T LET LGTC GET ANOTHER LINE YET(CHK MUST BE NEG., BUT NOT 4000!!)
1673 LABEL, JMS I GTCL /GET A CHARACTER
1674 SNA /IS THIS A CAR RET?
1675 ERR15, JMS I LUNCH /YES, INCOMPLETE STATEMENT
1682 SNL / 260 <= CHAR < 272 ?
1684 DCA L36 /SAVE THIS DIGIT...
1685 JMS I MULT10 / ACC = 10 * ACC + L36
1688 SPA CLA /END OF STMT NR FIELD?
1689 JMP LABEL /NOT YET...
1690 JMS I GTCL /SKIP OVER COL 6
1691 SNA CLA /IS IT A CAR RET?
1693 TAD L31 /SEE IF STMT NR IS LEGAL...
1697 SPA CLA /IS STMT NR < 2048 ?
1698 JMP ERR16 /NO, STMT NR TOO BIG
1707 / SUBROUTINEE TO PRINT A SYMBOL
1711 LPRSYM, 0 /THIS ROUTINE PRINTS SYMBOLS
1714 SMA /IS IT AN INTEGER CONSTANT
1715 JMP ICON /YES PROCESS IT
1716 RTL /SHIFT THE NEXT BIT INTO THE LINK
1717 SNL /IS IT A TEMPORARY
1718 JMP TEMPO /ITS A TEMPORARY
1719 RTR /RESTORE THE SYMBOL
1720 CIA /SET IT NEGATIVE
1721 TAD L47 /SUBTRACT THE BEGINNING OF THE XFCON TABLE
1722 SPA CLA /DO WE HAVE AN FCON
1723 JMP XFCON /YES PROCESS IT
1725 TAD C2 /ADD TWO TO THE SYMBOL TABLE POINTER
1726 DCA LP2 /AND SAVE IT
1727 TAD I LP2 /GET THE CONTROL BITS FOR THE SYMBOL
1728 RAR /GET EXTERNAL SUBROUTINE BIT IN LINK
1729 SZL CLA /IS THIS AN EXTERNAL SUBROUTINE
1730 JMP SKPIT /YES...DONT PUT OUT THE BACK SLASH
1737 JMS LP2 /AND PRINT THEM
1740 AND X7700 /MASK SO WE DONT PUT OUT CONTROL BITS
1741 JMS LP2 /AND PRINT IT
1742 JMP I LPRSYM /NOW RETURN
1743 LP2, 0 /THIS IS THE ROUTINE THAT PRINTS TWO CHARACTERS
1744 DCA UNCH /SAVE THE CHARS
1745 TAD UNCH /GET THEM AGAIN
1746 RTR /ROTAT FIRST CHAR INTO POSITION
1749 AND C77 /MASK SECOND CHARACTER
1750 SZA /IS IT AN ACTUAL CHARACTER
1751 JMS I PRINT /YES PRINT IT
1752 TAD UNCH /GET THE TWO CHARS AGAIN
1753 AND C77 /MASK OUT FIRST CHARACTER
1754 SZA /IS IT ACTUALLY A CHARACTER
1755 JMS I PRINT /YES PRINT IT
1756 JMP I LP2 /AND RETURN
1757 ICON, CLA /INTEGER CONSTANT, PUNCH A '('
1760 TAD LCH /AND THE NUMBER
1762 JMP I LPRSYM /RETURN
1764 SPA CLA /SUBSCRIPT TEMPORARY?
1767 TAD D33 /PUNCH '[' FOR INTEGER AND ']' FOR FLOATING PT
1768 JMS I PRINT /AND PRINT IT
1770 SPA /DO WE STILL HAVE A TEMPORARY
1771 JMS I TEMPOR /YES GET THE TEMPORARY NUMBER
1772 JMS I PRINT /AND PRINT IT
1773 JMP I LPRSYM /RETURN
1774 SBSCR, TAD D33 /SUBSCRIPT TEMPORARY, PUNCH A '['
1777 JMS I SUBTEM /AND 4 DIGITS
1779 XFCON, TAD C35 /FLOATING POINT CONSTANT...
1780 JMS I PRINT /PUNCH A ']'
1783 TAD L50 /SUBTRACT FROM END OF TABLE
1796 / SUBROUNTINE TO DO SYMBOL TABLE MANIPULATIONS
1801 SCOUNT, 0 /CURRENT NUMBER OF SYMBOLS
1803 FCOUNT, 0 /CURRENT NUMBER OF FCONS
1806 LOOP1, TAD L56 /GET BEGINNING OF SYMBOL TABLE
1807 DCA LSYMTM /AND SAVE IN TABLE
1808 TAD SCOUNT /GET NUMBER OF SYMBOLS CURRENTLY
1810 DCA XCTR /USE AS A COUNTER
1811 TAD C7700 /GIVE SEARCH A MASK TO USE ON LAST SYMBOL
1812 JMS SEARCH /LOOK FOR OCCURRENCE OF SYMBOL IN TABLE
1813 JMP ZCHECK /SYMBOL IS IN TABLE CHECK IT
1814 TAD L57 /TELL ENTER WHERE TO PUT THE SYMBOL
1815 JMS ENTER /ENTER THE SYMBOL
1816 TAD C3 /UPDATE THE POINTER
1817 DCA L57 /AND SAVE IT
1818 DCA L21 /ZERO SWITCH SINCE SYMBOL JUST LOADED
1819 ISZ SCOUNT /UPDATE COUNT OF SYMBOLS
1820 JMP LOOP1 /GO BACK AND CHECK IT
1821 ZCHECK, TAD L77 /GET POINTER INTO SYMBOL TABLE
1822 TAD C2 /MOVE TO LAST WORD
1824 TAD I LSYMTM /GET THE CONTROL BITS
1825 AND L21 /AND THE MASK
1826 SZA CLA /ARE ANY ILLEGAL BITS ON
1827 ERR54, JMS I LUNCH /ERROR 54 ... PROBABLY IN EQUIVALENCING ...
1828 TAD L32 /NOW OR IN NEW BITS
1833 JMP I LSYMTB /RETURN
1834 / FLOATING CONSTANT IS IN 30 THRU 32
1837 MLOOP, TAD L47 /GET BEGINNING OF FCON TABLE
1838 TAD C3 /MOVE TO ACTUAL START OF TABLE
1839 DCA LSYMTM /AND SAVE
1840 TAD FCOUNT /GET NUMBER OF FCONS SO FAR
1842 DCA XCTR /AND USE FOR A COUNTER
1843 CMA /GIVE SEARCH A MASK FOR THE LAST WORD
1844 JMS SEARCH /SEARCH THE TABLE FOR THE CURRENT FCON
1845 JMP I LFCON /ITS ALREADY IN THERE JUST RETURN
1846 TAD L47 /TELL ENTER WHERE TO PUT THE FCON
1847 JMS ENTER /ENTER THE FCON
1848 TAD CM3 /AND UPDATE IT
1850 ISZ FCOUNT /UPDATE NUMBER OF FCONS
1851 JMP MLOOP /GO BACK AND CHECK
1852 / THIS IS THE ROUTINE THAT SEARCHES THE TABLES FOR
1853 / OCCURRENCES OF THE CURRENT SYMBOL OR FCON
1855 DCA ENTER /SAVE THE MASK
1856 MBACK, ISZ XCTR /SEE IF WE HAVE PROCESSED ALL SYMBOLS
1859 TAD I LSYMTM /GET FIRST WORD OF SYMBOL
1861 TAD L30 /SUBTRACT FIRST WORD OF CURRENT SYMBOL
1862 ISZ LSYMTM /INCREMENT POINTER
1863 SZA CLA /DO THEY MATCH
1864 JMP I1 /NO GO TO NEXT SYMBOL
1865 TAD I LSYMTM /YES GET SECOND WORD OF SYMBOL
1867 TAD L31 /SUBTRACT SECOND WORD OF CURRENT SYMBOL
1868 ISZ LSYMTM /ADVANCE POINTER
1869 SZA CLA /DO THEY MATCH
1870 JMP I2 /NO GO TO NEXT SYMBOL
1871 TAD I LSYMTM /SEE IF NEXT WORD MATCHES
1872 AND ENTER /MASK OUT DESIRED PORTIONS
1874 TAD L32 /SUBTRACT THIRD CURRENT WORD
1876 ISZ LSYMTM /ADVANCE POINTER
1877 SZA CLA /DO THEY MATCH
1878 JMP MBACK /NO GO TO NEXT SYMBOL
1880 TAD CM3 /MOVE BACK POINTYER
1881 DCA L77 /PUT POINTER IN PAGE ZERO
1882 JMP I SEARCH /RETURN
1883 QRET, ISZ SEARCH /SET UP RETURN FOR NOT FOUND
1884 JMP I SEARCH /RETURN
1885 I1, ISZ LSYMTM /ADVANCE POINTER
1886 I2, ISZ LSYMTM /ADVANCE PIINTER
1887 JMP MBACK /GO TO NEXT SYMBOL
1888 / THIS ROUTINE ENTERS THE CURRENT SYMBOL INTO THE TABLE SPECIFIED
1890 DCA LSYMTM /SAVE ADDRESS
1891 TAD L47 /GET BEGINNING OF FCON TABLE
1893 TAD L57 /SUBTRACT END OF SYMBOL TABLE
1894 C7700, SMA CLA /IS THERE ROOM FOR ANOTHER SYMBOL OR FCON
1895 ERR17, JMS I LUNCH /NO
1896 TAD L30 /YES GEYT FIRST WORD
1897 DCA I LSYMTM /STORE IT
1899 DCA L11 /SET UP AUTO - XR
1904 TAD LSYMTM /GET THE ADDRESS BACK INTO THE AC
1905 JMP I ENTER /AND RETURN
1908 LPRINT, 0 / CONVERTS FROM TRIMMED TO EIGHT BIT ASCII
1909 DCA LFCON /SAVE THE CHARACTER
1910 TAD L75 /S GET THE SUPPRESS PRINTING WITCH
1913 ISZ L24 /IS THIS A NEW LINE?
1915 JMS I DUMPLN /YES - DUMP THE OLD ONE FIRST
1916 TAD LFCON /NO...GET THE CHARACTER
1918 JMP CRLF /YES...PUT OUT CRLF
1919 AND C40 /CHECK BIT SIX
1921 CIA /AC CONTAINS 0 OR -100
1922 TAD C300 /NOW CONTAINS 300 OR 200
1923 TAD LFCON /NOW ADD THE CHARACTER IN
1924 \fPRIT, DCA I L24 /AND STORE IT IN THE BUFFER
1926 CRLF, TAD C215 /GET AN EIGHT BIT CR
1927 DCA I L24 /STORE IT IN THE BUFFER
1930 DCA I L24 /STORE A LINE FEED TOO
1932 DCA L24 /SET SWITCH TO DUMP LINE ON NEXT CHAR
1936 JMS I LOOK /CHECK REST OF STATEMENT NAME
1940 GETVAR, JMS I ENTITY /GET A VARIABLE
1942 JMP VARI /WE GOT A VARIABLE
1945 ERR18, JMS I LUNCH /ERROR
1947 TAD L32 /PUT IN COMMON BIT
1949 TAD K37 /GET MASK FOR SYMBOL TABLE SWITCH
1950 DCA L21 /PUT IN THE SWITCH
1951 JMS I SYMTAB /PUT SYMBOL IN TABLE
1952 JMS I ENTITY /LOOK FOR A COMMA
1953 JMP START /THAT'S ALL GOT A CR-LF...
1957 TAD CM54 /CHECK FOR COMMA
1958 SZA CLA /IS IT A COMMA
1959 JMP ERR18 /NO...ERROR
1960 JMP GETVAR /GET ANOTHER VARIABLE
1961 LDIMEN, JMS I LOOK /LOOK FOR REST OF STATEMENT
1969 DCA REDY /SET SWITH FOR VARIABLE
1970 QGET, JMS I ENTITY /GET WHATEVER IS NEXT IN LINE
1971 JMP QDONE /IT EAS A CR
1972 JMP .+4 /IT WAS A VARIABLE
1973 JMP ASUBSC /IT WAS ONE OF THE SUBSCRIPTS
1974 JMP ERR18 /WE BETTER NOT GET ANY FP NUMBERS
1975 JMP QPUNC /IT WAS A PUNCTION
1977 JMP ERR18 /WE WERENT READY FOR A VAR
1981 TAD K27 /GET THE MASK FOR THE SYMBOL TABLE
1982 DCA L21 /PUT IN THE SWITCH
1983 JMS I SYMTAB /PUT SYMBOL IN TABLE
1985 TAD L47 /GET BEGINNING OF TABLE
1987 TAD L77 /GET TABLE ADDRESS
1990 DCA V /SET WITCH TO SAY WEVE GOTTEN A VAR
1991 JMP QGET /GET NEXT THING
1997 JMP QRPAR /RIGHT PAREN
1999 SNA /IS IT A LEFT PAREN
2000 ISZ V /PRECEDED BY A VAR
2001 JMP ERR18 /NO - ERROR
2003 DCA XLP /SET SWITCH TO SHOW LPAR
2005 ASUBSC, ISZ XLP /DID WE JUST GET LPAR
2006 JMP SECOND /NO...BETTER BE SECOND SUBSC
2007 TAD L32 /GET INTEGER
2008 DCA I L16 /PUT IN DIMTAB
2010 DCA QONE /SET SWITCH TO SHOW WE HAVE ONE SUBSC
2012 COMMA, ISZ QONE /DOES THIS COMMA SEPARATE SUBSCS
2013 JMP RIGHT /NO...LAST CHAR BETTER HAVE BEEN L RPAR
2015 DCA SEC /SET SWITCH TO EXPECT SECOND SUBSCRIPT
2017 SECOND, ISZ SEC /IS THIS SECOND SUBSCRIPT
2018 JMP ERR18 /NO...ERROR
2022 DCA R /SET SWITCH FOR RPAR
2024 QRPAR, ISZ QONE /HAVE WE GOTTEN ONE SUBSC
2025 JMP QTWO /NO...CHECK FOR TWO
2026 IAC /ONLY ONE SO USE 1 AS SECOND
2030 TAD L47 /GET BEGINNING OF TABLE
2031 DCA L50 /SAVE IN LOW CORE
2033 TAD CM3 /SUBTRACT THREE FROM ADDRESS
2035 JMP QGET /WE EXPECT COMMA OR CR
2036 QTWO, ISZ R /HAVE WE GOTTEN TWO
2037 JMP ERR18 /NO...ERROR
2039 RIGHT, ISZ RIG /DID WE JUST GET RPAR
2040 JMP ERR18 /NO...ERROR
2054 DCA L16 /USE AUTO INDEXING
2059 JMP ALAB /WE HAVE A LABEL
2061 TAD CM50 /IF PUNCT...CHECK FOR LEFT PAREN
2067 JMP THERE /WE HAVE A LABEL
2070 THERE, TAD L32 /GET THE LABEL
2071 DCA I L16 /PUT IN LIST
2074 TAD CM54 /CHECK FOR BEING A COMMA
2076 JMP ANEXT /YES GET ANOTHER LABEL
2077 TAD C3 /CHECK FOR BEING A RIGHT PAREN
2081 TAD CM54 /CHECK FOR ANOTHER COMMA
2083 JMS I PUTCH /IGNORE ANYTHING ELSE ...
2084 JMS I ENTITY /GET THE CONTROL VARIABLE
2090 DCA L21 /ZERO THE SYMBOL TABLE SWITCH
2091 JMS I SYMTAB /PUT VARIABLE IN SYMBOL TABLE
2092 TAD L77 /GET ADD RESS OF SYMBOL
2093 JMS I MODE /CHECK THE MODE OF THE VAIABLE
2094 ERR30, JMS I LUNCH /ITS FLOATING POINT
2095 JMS I ZZZ /PUT OUT STMT LABEL
2096 JMS LXTAD /LOAD VARIABLE WITH TAD OR TAD*
2097 JMS I PROP /PUT OUT OP CODE
2098 Q6066, 6066 /OP CODE IS TAD
2099 JMS I CREATE /GET THE NEXT CREATED LABEL
2100 JMS I PRCRL /PRINT THE CREATED LABEL
2101 JMS I PRINT /PUT OUT CR LF
2102 JMS I PROP /PUT OUT OP CODE
2103 6071 /OP CODE IS DCA
2106 JMS I PRINT /PUT OUT CRLF
2107 JMS I PROP /PUNCH 'TAD I 7'
2112 JMS I PROP /PUNCH 'DCA 7'
2117 JMS I PROP /PUNCH 'JMP I 7'
2122 TAD L76 /PUNCH 'CPAGE <N+1>'
2125 TAD L53 /PUNCH '<CR.LABEL2>, <CR.LABEL2>'
2130 TAD L76 /NOW PUNCH THE LABELS
2134 DCA L16 /USE AUTO INDEXING AGAIN
2135 TAD I L16 /GET THE NEXT LABEL
2136 JMS I PLAB /PRINT THE LABEL
2137 JMS I PRINT /PUT OUT CRLF
2141 / THE FOLLOWING SECTION IS TO TREAT REGULAR GOTO S
2144 JMS PRJUMP /PUT OUT A JUMP TO THE LABEL IN "L32"
2148 TAD L77 /GET ADDRESS AGAIN
2151 TAD Q6066 /TAD OR TAD*
2152 DCA OP /USE AS OPERATOR
2153 JMS I PROP /PUT OUT OP CODE
2155 TAD L77 /GET ADDRESS AGAIN
2156 JMS I PRSYM /PRINT THE SYMBOL
2157 JMS I PRINT /PUT OUT A CR LF
2160 LLEAD, 0 /PUNCH SOME LEADER...
2168 PRJUMP, 0 /SUBROUTINE TO PUT OUT A JUMP
2169 DCA LLEAD /STORE THE LABEL
2173 JMS I PLAB /PUT OUT THE LABEL
2174 JMS I PRINT /PUT OUT A CRLF
2176 DCA L12 /SET CONTENTS OF LAST LINE TO LABEL
2179 / THE FOLLOWING ROUTINE PUNCHES OCTAL NUMBERS
2182 DCA TMP /SAVE THE NUMBER
2184 TAD CM4 /PUT OUT FOUR CHARACTERS
2185 DCA DCTR /CHARACTER COUNTER
2186 BK, TAD TMP /GET THE NUMBER
2187 RAL /ROTATE IT LEFT ONE
2188 RTL /ROTATE TWO LEFT...THAT MAKES ONE OCTAL DIGIT
2189 DCA TMP /SAVE THE ROTATED NUMBER
2190 TAD TMP /GET IT IN ACCUMULATOR
2192 RAL /GET THE DIGIT INTO THE LOW-ORDER AC
2193 ISZ DCTR /IS THIS THE LAST DIGIT?
2194 JMP .+4 /NO, CONTINUE
2195 TAD C60 /MAKE IT LOOK LIKE A TRIMMED ASCII DIGIT
2196 JMS I PRINT /PRINT THE DIGIT
2198 SZA /DO WE HAVE A ZERO DIGIT?
2201 SNA CLA /YES, IS IT A LEADING ZERO?
2202 JMP BK /YES, IGNORE IT
2205 ISZ TM /DON'T SUPPRESS ZEROS ANY MORE
2206 JMP BK /NOW...PUT OUT ANOTHER
2212 DCA COUNT1 /SET UP COUNTER
2214 TAD CM50 /CHECK FOR LEFT PAREN
2217 JMS I PUTCH /YES...PUT IT BACK FOR GENER
2219 ISZ L52 /SET BALANCED PARENS SWITCH FOR GENER
2220 ISZ L44 /SET SWITCH FOR RIGHT SIDE OF EQUALS SIGN
2221 JMS I GENER /NOW CALL GENER AND PROCESS EXPRESSION
2223 JMS I MODE /WHAT IS ITS MODE
2224 JMS I GETHI /GET HI ORDER P.P. AC
2226 DCA LIFDCA /SET UP INSTRUCTION TO STORE LABELS
2227 LABL, JMS I ENTITY /GET A LABEL
2230 JMP INTEG /WE GO A LABEL
2232 ERR31, JMS I LUNCH /DIDNT GET A LABEL
2233 INTEG, TAD L32 /GET THE LABEL
2235 LIFDCA, .-. /STORE LABELS IN L42 THROUGH L44
2237 ISZ COUNT1 /HAVE WE GOTTEN TOO MANY LABELS
2241 SNA /SEE IF ITS A CR
2243 TAD CM54 /CHECK FOR COMMA
2244 SZA CLA /IS IT A COMMA
2247 ISZ COUNT1 /DID WE GET THE RIGHT NUMBER OF LABELS
2252 SNA CLA /IF THE JUMPS FOR AC<0 AND AC>0 ARE EQUAL
2253 JMP ISPECL /WE CAN SAVE SOME CODE
2257 SNA CLA /IF THE JUMPS FOR AC=0 AND AC>0 ARE EQUAL
2258 JMP SPCONL /WE CAN ALSO SAVE SOME CODE
2259 JMS I PROP /PUT OUT OP CODE
2260 6105 /OP CODE IS SNA
2261 JMS I PRINT /PUT OUT CRLF
2263 JMS I PRJMP /OUTPUT THE ZERO BRANCH
2264 SPCONL, JMS I PROP /PUT OUT OP CODE
2265 6110 /OP CODE IS P SPA CLA
2266 JMS I PRINT /PUT OUT CRLF
2267 TAD L42 /OUTPUT THE NEGATIVE BRANCH
2270 JMS I PRJMP /OUTPUT THE POSITIVE (>0) BRANCH
2272 JMP START /GO GET NEXT STATEMENT
2273 ISPECL, JMS I PROP /PUNCH 'SNA CLA'
2279 JMP IFCOMN /OUTPUT THE ZERO AND POSITIVE BRANCHES
2283 ISZ L53 /INCREMENT BY ONE...
2287 SMA CLA /HAVE WE BEEN HERE 26 TIMES?
2288 TAD C46 /YES, BUMP THE HIGH ORDER DIGIT
2291 TAD L53 /NOW RETURN IT IN AC
2292 JMP I LCREAT /RETURN
2293 LPLAB, 0 /THIS PRINTS REGULAR LABELS
2294 DCA TMP /FIRST SAVE LABEL
2295 TAD D34 /NOW PUNCH A '\'
2298 JMS I DECOUT /AND PRINT IT
2305 /TELETYPE OUTPUT ROUTINE FOR ERROR MESSAGES
2320 JMP DOSUBT /GO GENERATE THE LIMIT TEST
2329 JMS I ENTITY /LOOK FOR THE SCOPE LABEL
2332 JMP SLAB /WE GOT THE SCOPE LABEL
2335 SLAB, TAD L32 /GET THE INTEGER
2336 JMS XDO /PUT OUT DO-LOOP CODE
2337 JMP START /NORMAL EXIT
2338 JMP ERR35 /IMPLIED DO EXIT - ERROR
2340 XDO, 0 /DO LOOP SUBROUTINE - ENTERED WITH
2342 DCA I L15 /PUT IN DO END PUSH DOWN LIST
2344 DCA L16 /SET UP LIST OF DO ENDS
2345 DCA L21 /ZERO THE SYMBOL TABLE SWITCH
2347 DCA SWIT /SET SWITCH FOR CONTROL VARIABLE
2349 DCA NUMB /SET COUNTER OF NUMBER OF PARAMETERS
2350 GETMOR, JMS I ENTITY /LOOK FOR A PARAMETER
2352 JMP CVAR /GOT A VARIABLE
2353 JMP DPAR /GOT AN INTEGER
2356 CVAR, JMS I SYMTAB /PUT SYMBOL IN TABLE
2357 TAD L77 /GET ADDRESS
2358 JMS I MODE /DETERMINE MODE OF SYMBOL
2360 TAD L77 /GET ADDRESS AGAIN
2361 DOSTOR, DCA I L16 /SAVE
2362 ISZ NUMB /HAVE WE GOTTEN TOO MANY PARAMS
2364 ERR35, JMS I LUNCH /YES, DO ERROR ...
2367 JMP ALLDNE+1 /YES WERE DONE
2369 SNA /IS IT A RIGHT PAREN?
2370 JMP ALLDNE /YES-FINISH UP AND TAKE IMPLIED DO EXIT
2374 ISZ SWIT /IS SWITCH SET FOR IT
2376 JMP GETMOR /YESS...GO BACK FOR ANOTHER PARAMETER
2377 MCOM, TAD C21 /CHECK FOR COMMA
2378 ISZ SWIT /IF NO EQUAL SIGN YET
2379 SZA /OR IF THIS ISN'T A COMMA
2380 JMP ERR35 /THEN ITS AN ERROR
2381 JMP GETMOR /GET ANOTHER
2382 DPAR, TAD L32 /GET THE INTEGER
2383 ISZ SWIT /HAVE WE SEEN AN EQUAL SIGN?
2384 JMP DOSTOR /YES - SAVE THE INTEGER AND PROCEED
2386 ALLDNE, ISZ XDO /BUMP RETURN POINTER IF TERMINATOR WAS RPAR
2388 DCA I L16 /STORE A ONE IN THE FOURTH (OR FIFTH) ARGUMENT
2391 SPA CLA /DID WE GET AT LEAST THREE ARGS?
2394 TAD L74 /GET ERASABLE LOCATIONS
2395 DCA L16 /USE THE AUTO INDEX REGISTERS
2396 TAD I L16 /GET CONTROL VARIABLE
2397 DCA L30 /AND PUT IN THIRTY
2398 TAD I L16 /GET INITIAL VALUE
2399 DCA L31 /AND SAVE IT
2400 TAD I L16 /GET FINAL VALUE
2401 DCA L32 /AND SAVE IT
2402 TAD I L16 /GET INCREMENT
2403 DCA L33 /AND SAVE IT
2404 TAD L74 /GET ADDR OF ERASABLE AGAIN
2406 DCA L41 /TELL TRIPL WHERE TO FIND THE DUMMY TRIPLES
2407 TAD L74 /GET IT AGAIN
2408 DCA L16 /USE AUTO INDEX TO STORE TRIPLE
2409 DCA L46 /ZERO THE AC
2410 TAD C5001 /SET UP INITIAL TRIPLE NUMBER
2415 SNA CLA /IF INITIAL VALUE = STEP SIZE
2416 JMP STCTLV /NO NEED TO COMPUTE THE DIFFERENCE
2417 TAD L33 /GET STEP SIZE
2418 DCA I L16 /PUT IN TRIPLE
2419 TAD C55 /PUT IN A MINUS SIGN
2421 TAD L31 /GET INITIAL VALUE
2423 JMS I TRIPL /PROCESS THE TRIPLE
2424 STCTLV, JMS I LEQI /STORE ANSWER IN CONTROL VARIABLE
2425 JMS I CLAB /PUT A CDREATED LABVEL ON THE NEXT STATEMENT
2426 TAD L53 /GET THE CREATED LABEL
2427 DCA I L15 /AND PUT IN DO END LIST
2430 TAD L33 /GET STEP SIZE
2432 SNA /IF STEP SIZE=1 THEN
2433 JMP ISZDO /WE CAN USE AN ISZ TO INCREMENT
2436 TAD E53 /WERE GOING TO ADD
2438 / L30 IS IN THE THIRD POSITION SINCE WE CALLED "EQI"
2439 JMS I TRIPL /ADD STEP SIZE TO CONTROL VARIABLE
2440 JMS I LEQI /STORE ANSWER IN CONTROL VARIABLE
2443 TAD L30 /GET THE CONTROL VARIABLE
2445 TAD C55 /WERE GOING TO SUBTRACT
2447 TAD L32 /GET FINAL VALUE
2449 JMS I TRIPL /SUBTRACT CONTROL VARIABLE FROM FINAL VALUE
2450 \f DCA L46 /CLEAR THE AC FLAG
2456 JMS I CREATE /TO A CREATED LABEL
2457 DCA I L15 /PUT CREATED LABEL IN DO END LIST
2459 JMS I PRCRL /AND PRINT IT
2461 ISZ L55 /INCREMENT UNENDED DO COUNTER
2463 ERR38, JMS I LUNCH /TOOO MANY UNENDED DOS
2465 DORET /RETURN FROM SUBROUTINE "XDO"
2470 TAD L46 /GET RESULT OF PREVIOUS COMPUTATION
2472 TAD E75 /GET EQUALS SIGN
2474 TAD L30 /GET CONTROL VARAIBLE
2476 JMS I TRIPL /PROCESS
2477 DCA L46 /WIPE AC SWITCH
2483 JMS I STORE /NO...STORE THE AC
2484 TAD L53 /GET CURRENT CREATED LABEL
2486 CLA CMA /AC IS MINUS ONE
2487 TAD L41 /PUSH LIST POINTER
2488 DCA L42 /PUSH LIST POINTER MINUS ONE
2489 CKFNCT, ISZ L42 /INCREMENT POINTER
2491 TAD I L42 /GET THE OPERATOR
2492 TAD CM4047 /SUBTRACT THE FUNCTION OPERATOR
2493 SZA /IS THIS THE FUNCTION OPERATOR
2495 CLA IAC /YES...THE FUNCTION NAME IS IN THE NEXT LOCATIO
2496 TAD L42 /THIS POINTS TO IT
2505 MOR, CLA CMA /NOW EXAM THE ARGUMENTS
2506 TAD L42 /WERE POINTING TO THE FIRST ARGUMENT
2507 DCA L42 /SAVE THE POINTER
2509 JMS I LCHNG /CHECK L42 FOR ZERO OR DUMMY ARG
2510 DCA I L42 /REPLACE IT BY UPDATED VALUE
2511 TAD L42 /IT WASNT...SEE IF IT WAS THE LAST ARGUMENT
2513 TAD L41 /SUBTRACT THE END OF ARGUMENT LIST
2515 JMP OUT /YES...WE'VE COMPLETED THIS PHASE
2516 CLA CMA /NO...MOVE THE POINTER BACK ONE
2519 JMP MOR /NOW CHECK THE NEXT ARGUMENT
2520 OUT, TAD SAVE /GET THE POINTER TO THE FUMCTION NAME AGAIN
2521 DCA L42 /AND PUT IN 42
2522 TAD I L42 /GET THE ARGUMENT
2523 DCA FUNOP /USE FPROP TO PUT OUT THE CALL TO THE FUNCTION
2524 TAD ARGCNT /GIVE FPROP THE NUMBER OF ARGUMENTS
2525 JMS I FPROP /PUT OUT THE CALL TO THE FUNCTION
2527 TAD L73 /NOW RESTORE THE CREATED LABEL LOCATION
2529 MNEXT, TAD L42 /GET THE POINTER
2530 TAD CM2 /MOVE POINTER TO ARGUMENT
2532 TAD I L42 /GET NEXT ARGUMENT
2533 JMS I PSYMOT /GENERATE AN "ARG" FOR THE ARGUMENT
2534 TAD L42 /GET THE POINTER
2535 CIA /SET IT NEGATIVE
2537 SZA CLA /ARE THEY EQUAL
2538 JMP MNEXT /NO THERE ARE MORE ARGS
2539 TAD I SAVE /YES...GET THE FUNCTION NAME
2540 JMS I MODE /WHAT MODE IS IT
2541 TAD E400 /ITS FLOATING POINT
2542 TAD L40 /ITS INTEGER
2543 DCA L46 /PUT THE TRIPLE NUMBER IN THE AC SWITCH
2544 TAD SAVE /YES...CHANGE PUSH LIST POINTER
2545 DCA L41 /STORE POINTER TO NAME IN PUSH LIST POINTER
2546 TAD L46 /GET CURRENT TRIPLE NUMBER
2547 DCA I L41 /AND PUT IT IN THE PUSH LIST
2548 JMP I LFUNCT /RETURN
2550 SZA CLA /IS IT THE SUBSCRIPT OPERATOR?
2551 JMP I CKF /NO - KEEP LOOKING
2563 LQUOTE, JMS I PGTC /GET A CHARACTER
2565 ERR37, JMS I LUNCH /CARRIAGE RETURN - ERROR
2568 JMP LQUOTE-2 /IF NOT A QUOTE, STORE IT
2577 LCONT, JMS I LOOK /CHECK REST OF LINE
2578 -4 /LOOK FOR FOUR CHARACTERS
2584 JMS I PROP /PUNCH 'NOP'
2586 JMS I PRINT /PUT OUT A CRLF
2587 JMP START /GO GET NEXT STATEMENT
2589 LPAUSE, JMS I LOOK /CHECK REST OF STATEMENT TYPE
2590 -1 /JUST ONE CHARACTER
2593 LSTOP, DCA SW /SET SWITCH FOR STOP OR PAUSE
2595 JMS I ENTITY /LOOK FOR THE OPTIONAL INTEGER
2596 JMP MCR /WE GOT A CR
2598 JMP .+3 /WE GOT AN INTEGER
2603 ISZ SW /PAUSE OR STOP?
2605 JMS I FPROP /PUNCH 'CALL 0,CKIO'
2607 JMS I PROP /PRINT OP CODE
2609 TAD L32 /GET THE INTEGER
2610 JMS I PRSYM /PRINT IT
2617 JMS I PRINT /PUT OUT CRLF
2618 JMP START /GO GET NEXT STATEMENT
2623 OSTOP, 0 /PUNCH 'CALL 0,CKIO'
2626 JMS I CLAB /PUNCH '<LAB>, HLT'
2630 JMS I PROP /PUNCH 'JMP <LAB>'
2638 LFRMAT, JMS I LOOK /CHECK REST OF STATEMENT TYPE
2651 JMS I GNB /READ UNTIL A PAREN IS GOTTEN
2652 TAD CM50 /SUBTRACT A (
2654 ERR39, JMS I LUNCH /NO...ILLEGAL CHARACTER
2655 TAD C50 /GET A LEFT PAREN
2656 JMP PAREN /AND GO START COUNTING PARENS
2660 PAREN, RTL CLL /SHIF CHAR LEFT
2663 DCA L32 /SAVE THE CHAR
2667 TAD L32 /PACK THE TWO CHARS (SOME DONE AT FRMTCK)
2668 JMP I FRMTCK /GO CHECK IF FORMAT STMT. TOO BIG
2669 FRMT, TAD OSTOP /GET BALANCED PAREN SWITCH
2670 SZA CLA /ARE THEY BALANCED
2671 JMP AGAIN /NO GET SOME MORE CHARS
2685 TAD L53 /PUNCH '<LABEL>,'
2693 LPIFF, 0 /PUNCH 'IFF <N>'
2694 DCA LZZZ /ENTER WITH N IN THE AC
2702 LZZZ, 0 /PUNCH THE CURRENT LABEL, IF ANY
2704 SNA /IS THERE A LABEL?
2706 JMS I PLAB /PUNCH '<LABEL>, '
2709 ZZZRET, DCA I PXSUBR /MAKE SUBROUTINES AND FUNCTIONS ILLEGAL
2714 JMS I XZQL /FIRST CHECK IF A TRIPLE IS LEGAL HERE
2715 TAD L41 /GET PUSH LIST POINTER
2716 IAC /INCREMENT TO POINT TO OPERATOR
2717 DCA L42 /OPERATOR POINTER
2718 TAD L42 /GET IT AGAIN
2720 DCA L43 /OPERAND TWO POINTER
2721 TAD I L42 /GET OPERATOR
2722 AND C77 /MASK GARBAGE BITS
2723 TAD CM41 /SUBTRACT AN ADD INDIRECT OPERATOR
2724 SNA CLA /IS OPERATOR <DOLLAR>
2725 JMP I LADDIN /YES PROCESS IT
2726 TAD I L43 /NO...GET OPERAND TWO
2727 JMS I DUMARG /SEE IF ITS A DUMMY ARGUMENT
2729 JMP CK2 /NO ..CHECK THE OTHER ARGUMENT
2730 TAD I L42 /YES GET THE OPERATOR
2731 AND C77 /MASK GARBAGE BITS
2732 TAD EM75 /IS IT AN EQUALS SIGN
2734 JMP LEQUIN /YES USE C*
2735 IAC /SEE IF ITS ALREADY EQUALS INDIRECT
2737 JMS I LDUMTW /YES TWO IS DUMMY ARG
2739 TAD I L41 /NO IS OPND ONE A SYMBOL
2740 JMS I DUMARG /SEE IF ITS A DUMMY ARGUMENT
2742 CLA CLL /NOW LETS SEE WHAT THE OPERATOR IS
2743 TAD I L42 /GET THE OPERATOR
2744 AND C77 /MASK OUT GARBAGE BITS
2767 SNA /IS IT A UNARY MINUS
2769 ERR40, JMS I LUNCH /NO BETTER COP OUT
2771 SMA /IS HIGH ORDER BIT ON
2772 JMP INC /NO...ITS NEITHER A SYMBOL OR A TRIPLE NUMBER
2775 JMP MAYBE /NO...WE MIGHT HAVE A SUBSCRIPT THOUGH
2776 RAR /YES...RESTOR THE PARAMETER
2777 CIA /SET IT NEGATIVE
2778 TAD L47 /SUBTRACT IT FROMTHE START OF THE FCON TABLE
2779 SPA /IS THE RELULT POSITIVE
2780 JMP INC /NO...ITS AN FCON NOT A SYMBOL
2781 CIA /YESS...RESTORE ORIGINAL PARAMETER
2783 TAD C2 /YES MOVE POINTER TO CONTROL BITS
2785 TAD I L23 /GET THE CONTROL BITS
2786 AND C10 /MASK ALL BUT DUMMY ARG BIT OUT
2787 INC1, SNA CLA /IS THIS SYMBOL. A DUMMY ARG
2788 INC, ISZ LDMARG /NO...INCREMENT THE RETURN
2789 CLA /CLEAR THE ACCUMULATOR
2790 JMP I LDMARG /AND RETURN
2791 MAYBE, AND F400 /MASK THE SUBSCRIPT BIT OF THE TRIPLE NUMBER
2792 JMP INC1 /AND CHECK BECAUSE WE TREAT SUBSCS AS DUMMY ARG
2793 ARET, JMP I LTRIPL /THIS IS THE RETURN FROM TRIPLE
2796 DCA I L42 /SET OP TO =*
2800 / THIS ROUTINE CHECKS THE REST OF THE CHARS FOR A STATEMENT
2802 JMS GLOOK /GET CHARACTER COUNT
2805 JMS GLOOK /ADD IN THE TEST CHAR
2806 SZA CLA /WERE THEY EQUAL
2807 JMP I ASSIGN /NO...IT MUST BE AN ASSIGNMENT STATEMENT
2808 ISZ LTRIPL /THEY MATCH...ARE WE DONE
2839 CKFND, TAD L42 /SEE IF POINTER IS INTO SYMB. TABLE
2840 TAD K2000 /(IT HAS HAPPENED!)
2843 JMP I .+1 /YES-ERROR
2848 / FIGURE OUT WHATS IN AC
2850 TAD L46 /GET WHATS IN THE AC
2853 SNA CLA /ARE THEY EQUAL
2855 TAD L46 /GET AC AGAIN
2857 TAD I L43 /SUBTRACT TWO
2858 SNA CLA /ARE THEY EQUAL
2862 JMP NONE /NO YES YES YES
2863 JMP SOME /JUST SIMETHING IN AC
2869 / FINDS TEMPORARY THAT TRIPLE NUMBER IS ASSIGNED TO
2872 DCA LFPROP /SAVE TRIPLE NUMBER
2874 JMS I MODE /DETERMINE ITS MODE
2875 TAD C30 /FLOATING POINT
2879 DCA FOP /SET UP COUNT FOR SEARCH
2883 SNA CLA /IS THIS THE ONE?
2884 JMP ZEROIT /YES - ZERO IT OUT AND RETURN IT
2887 JMP LTLP1 /LOOP OVER ENTIRE TABLE
2888 TAD LCHECK /NOT FOUND - WE HAVE TO ASSIGN IT
2890 DCA LCHECK /RESET POINTERS FOR ZERO SEARCH
2894 SNA CLA /IS THIS TEMPORARY FREE?
2898 JMP LTLP2 /CHECK THEM ALL
2899 ERR41, JMS I LUNCH /OUT OF TEMPORARIES
2903 SNA CLA /ADJUST THE NUMBER OF FLOATING POINT TEMPS
2908 SNA CLA /ADJUST THE NUMBER OF INTEGER TEMPS
2910 TAD LFPROP /STORE TRIPLE NUMBER IN THIS TEMPORARY SLOT
2911 ZEROIT, DCA I LCHECK
2913 TAD C31 /GET POSITIVE NUMBER FROM TABLE COUNTER
2914 JMP I LTMPOR /RETURN
2917 LFPROP, 0 /THIS ROUTINE PUNCHES SUBROUTINE CALLS
2918 DCA FOP /SAVE THE NUMBER OF ARGUMENTS
2920 6113 /PUT OUT THE CALL
2921 TAD FOP /GET THE NUMBER OF ARGUMENTS
2922 JMS I PROTAC /PRINT IT
2923 TAD C54 /GET A COMMA
2924 JMS I PRINT /PRINT IT
2930 ISZ LFPROP /INCREMENT RETURN
2931 JMP I LFPROP /RETURN
2933 / COME HERE IF OP IS -
2934 ASUB, JMS I SMODE /MAKE SURE THAT BOTH ARGS ARE OF SAME MODE
2935 TAD I L43 /GET OPERAND TWO
2937 JMP FSUB /ITS FLOATING POINT
2938 JMS LCHECK /ITS INTEGER...CHECK WHATS IN THE AC
2939 JMP STWO /TWO IS IN THE AC
2940 JMS I STORE /SMETHING IS IN THE AC
2941 JMS I LADDON /NOTHING IS IN THE AC...ADD ONE TO IT
2942 ASBCMN, JMS I LCOMP /ONE IS IN AC...COMPLEMENT IT
2943 JMS I LADDTW /ADD TWO TO IT
2944 JMP I LRETUR /AND RETURN
2945 STWO, JMS I LCOMP /TWO IS IN AC...COMPLEMENT IT
2946 JMS I LADDON /ADD ONE TO IT
2947 JMS I LCOMP /AND COMPLEMENT IT AGAIN
2948 JMP I LRETUR /AND RETURN
2949 FSUB, JMS LCHECK /FLOATING POINT...CHECK THE AC
2950 JMP FS /TWO IS IN AC
2951 JMS I STORE /SOMETHING IN AC...STORE IT
2952 JMP FAS /NOTHING IN AC
2953 JMP ASBCMN /ONE IS IN AC - COMPLEMENT AND ADD TWO
2954 FAS, JMS I LADDTW /NOTHING IN AC...ADD TWO IN
2955 FS, IAC /WE HAVE ONE ARG
2958 JMS I ARG /PUT OUT THE ARG PSEUDO OP
2959 TAD I L41 /GET ARGUMENT ONE
2960 IRET, JMS I PRSYM /AND PUT IT OUT
2961 JMS I PRINT /PUT OUT CRLF
2963 TTAB, ITTAB /THIS IS THE STARTING ADDRESS OF THE TEMP TABLE
2971 /CHECK SIZE OF FORMAT STMT.
2973 CKFRMT, DCA I L10 /CONTINUE PACK ROUTINE
2976 TAD M174 /IS IT TOO BIG
2978 JMP I ILCON /YES-GIVE IT ILLEGAL CONT. MESSAGE
2979 JMP I LFRMT /NO-GO BACK
2982 ILCON, ERR1 /ILLEGAL CONTINUATION MESSAGE
2985 ADDIND, JMS I CHECK /CHECK WHATS IN THE AC
2987 SKP /N SOMETHING IS IN AC
2988 SKP /NOTHING IS IN AC
2989 JMS I STORE /STORE WHATEVER IS IN AC
2990 TAD I L41 /GET OPERAND ONE
2991 JMS I MODE /WHAT MODE IS IT
2992 JMP FLOT /YES IT FLOATING POINT
2993 JMS I PROP /IST INTEGER...
2994 6063 /PUT OUT A TAD*
2995 LOOP6, TAD I L41 /GET THE FIRST OPERAND AGAIN
2996 JMP I LIRET /GO TO THE RETURN ROUTINE
2997 FLOT, IAC /WE ONLY HAVE ONE ARG
2998 JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
2999 6132 /PUT OUT A CALL TO FLOATING INDIRECT ADD
3000 JMS I ARG /PUT OUT THE ARG PSEUDO OP
3001 JMP LOOP6 /AND JUMP BACK
3002 / THIS PUTS OUT OPCODES FOR AN ADD
3005 SNA /TEST FOR 0 OR 1
3007 RAL /NOT 0 OR 1, TREAT NORMALLY
3008 JMS I MODE /WHAT MODE ARE WE IN
3010 JMS I PROP /PUT OUT A TAD
3013 LOOP7, IAC /WE ONLY HAVE ONE ARGUMENT
3014 JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
3015 6003 /PUT OUT A FLOATING ADD
3016 JMS I ARG /PUT OUT THE ARG PSEUDO OP
3017 JMP I ADDL /AND RETURN
3019 ISZ ADDL /BUMP RETURN POINT PAST ARGUMENT TO "TAD"
3021 JMP I ADDL /YUP - DON'T PUT OUT NUTTIN
3023 OPIAC /PUT OUT "IAC"
3026 / STORES CONTENTS OF AC IN TEMPORARY
3027 / PUT OUT DCA OR CALL STO
3028 / FOLLOWED BY THE TEMPORARY LOC
3031 JMS I MODE /WHAT MODE IS IT
3032 JMP FSTO /ITS FLOATING POINT
3034 6071 /ITS INTEGER...PUT OUT A DCA
3035 STORET, TAD L46 /GET THE AC AGAIN
3036 JMS I PRSYM /PRINT WHATEVER IS IN IT
3037 JMS I PRINT /PUT OUT A CRLF
3038 DCA L46 /ZERO THE AC
3039 JMP I LSTORE /AND RETURN
3040 FSTO, IAC /WE ONLY HAVE ONE ARG
3041 JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
3042 6006 /PUT OUT A CALL TOFLOATING STORE
3043 JMS I ARG /PUT OUT THE ARG PSEUDO OP
3044 JMP STORET /AND JMP BACK
3047 JMS I MODE /WHAT MODE IS IT
3048 JMP FCOM /ITS FLOATING POINT
3049 JMS I PROP /ITS INYTEGER
3051 JMS I PRINT /PUT OUT A CRLF
3052 JMP I COMP /AND RETURN
3054 6140 /TO FLOATING CHANGE SIGN
3056 / COME HERE IF OP IS *
3057 MUL, JMS I SMODE /CHECK FOR SAME MODE
3058 JMS I CHECK /CHECK WHATS IN THE AC
3059 JMP TMUL /TWO IS IN THE AC
3060 JMS I STORE /SOMETHING IS IN AC...STORE IT
3061 JMS I KADDON /NOTHING IS IN AC..GET ONE IN AC
3062 AMUL, TAD I L43 /GET OPERND TWO
3063 JMS I MODE /WHAT MODE IS IT
3066 DCA FML /SAVE OPCODE
3068 JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
3070 JMS I ARG /PUT OUT THE ARG PSEUDO OP
3071 TAD I L43 /GET OPERAND TWO
3072 JMP I LIRET /AND GO TO THE RETURN ROUTINE
3073 TMUL, TAD I L41 /GET OPERAND ONE AND REPLACE OPERAND TWO
3075 JMP AMUL /AND JUMP BACK
3081 LSUB, JMS I LOOK /CHECK REST OF STATEMENT
3092 LCLEAR, 0 /CLEAR THE PSEUDO ACC AND MQ
3101 / THIS ROUTINE TAKES CARE OF TWO BEING DUMMY ARG
3103 TAD I L41 /GET OPND ONE
3105 TAD I L43 /GET OPND TWO
3106 DCA I L41 /ZERO OPND ONE
3107 JMS DUMONE /PROCESS DUMMY ARGUMENT
3108 TAD FDV /GET SAVED OPERAND
3109 DCA I L41 /AND USE AS OPERAND
3110 TAD L46 /GET TRIPLE NUMBER
3111 DCA I L43 /AND REPLACE
3112 JMP I DUMTWO /RETURN
3113 / TAKES CARE OF ONE BIING DUMMY ARG
3115 TAD I L42 /GET OPERATOR
3117 TAD E41 /GET ADD INDIRECT OPERATOR
3118 DCA I L42 /AND REPLACE OPERATOR
3122 DCA FEX /AND SAVE RETURN
3123 JMS I TRIPL /CALL TRIPL
3124 TAD L46 /GET TRIPLE NUMBER
3125 DCA I L41 /AND REPLACE OPERAND
3126 TAD ASTOP /RESTORE OPERATOR
3128 ISZ L40 /ADVANCE TRIPLE
3129 TAD FEX /RESTORE RETURN
3133 JMP I DUMONE /RETURN
3134 / COME HERE IF OP IS /
3135 DIV, JMS I SMODE /CHECK FOR SAME MODE
3136 JMS I CHECK /CHECK WHATS IN THE AC
3137 JMP DIVE /TWO IS IN AC
3138 \f JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
3139 SKP /NOTHING IS IN AC
3140 JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
3141 JMS I MADDTW /GET TWO INTO THE AC
3142 DIVE, TAD I L41 /GET OPERAND ONE
3143 JMS I MODE /WHAT MODE IS IT
3146 DCA FDV /SAVE OERATOR
3148 JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
3150 JMS I ARG /PUT OUT THE ARG PSEUDO OP
3151 TAD I L41 /GET OPERAND ONE
3152 JMP I MIRET /JUMP TO RETURN ROUTINE
3153 / COME HERE IF OP IS **
3154 EXP, JMS I CHECK /CHECK WHATS IN THE AC
3155 JMP FEXP /TWO IS IN AC
3156 JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
3157 SKP /NOW NOTHING IS IN AC
3158 JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
3159 JMS I MADDTW /GET TWO IN AC
3164 TAD I L43 /GET OPERAND TWO
3165 JMS I MODE /WHAT IS ITS MODE
3166 TAD C3 /FLOATING POINT
3169 DCA FEX /SAVE REOUTINE POINTER
3171 JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
3173 TAD I L41 /GET OPERAND ONE
3174 DCA I L43 /SAVE IN OPERAND TWO
3175 TAD FEX /GET THE OP CODE JUST PUT OUT
3176 TAD CM6207 /SUBTRACT THE INTEGER TO INTEGER CASE
3177 SZA CLA /WAS THIS THE INTEGER INTEGER CASE
3178 TAD L50 /NO, GET A FLOATING POINT POINTER
3179 DCA I L41 /AND SUBSTITUTE IT FOR OPERAND ONE
3180 JMS I ARG /PUT OUT THE PSEUDO OP ARG
3181 \f TAD I L43 /GET THE REAL OPERAND ONE IN THE AC
3182 JMP I MIRET /JUMP TO THE RETURN ROUTINE
3183 /COMES HERE IF THE VARIABLE TO THE LEFT OF THE '=' IS SUBSCRIPTED
3184 EIND, TAD C132 /GET AN ASTERISK
3185 DCA L60 /PUT IT IN SIXTY
3186 /COMES HERE IF THE OPERATOR IS AN '='
3187 EQU, JMS I CHECK /CHECK WHATS IN THE AC
3188 NOP /TWO IS IN THE AC
3189 JMS I STORE /THERES SOMETHING IN THE AC...STORE IT
3190 JMS I TADDON /NOTHING IS IN AC...ADD ONE TO IT
3191 TAD I L43 /GET OPERA ND TWO
3192 JMS I MODE /WHAT IS ITS MODE
3193 JMP FEQU /ITS FLOATING POINT
3195 JMS I MODE /WHAT MODE IS IT
3196 JMP I LFIX /ITS FLOATING POINT
3197 EFIX, TAD L60 /GET EQUALS INDIRECT LOCATION
3198 TAD C6071 /ADD A DCA
3199 DCA ASTOP /AND SAVE OPCODE
3200 JMS I PROP /POT OUT THE OPCODE
3202 EQRET, DCA L46 /ZERO THE AC
3203 TAD I L43 /GET OPERAND TWO
3204 JMS I PRSYM /PRINT IT
3205 JMS I PRINT /PUT OUT A CRLF
3207 JMP I .+1 /AND RETURN
3209 FEQU, TAD L46 /GET THE AC
3210 JMS I MODE /WHAT MODE IS IT
3211 SKP /ITS FLOATING POINT
3212 JMS I LFLOAT /ITS INTEGER...FLOAT IT
3235 XXX, TAD L60 /GET THE INDIRECT EQUALS SWITCH
3236 SNA CLA /IS THE SWITCH ON
3237 TAD CM140 /NO, FLOATING POINT STORE
3238 TAD C6146 /YES...ISTO
3239 DCA FSTOP /SAVE OPCODE
3240 IAC /WE ONLY HAVE ONE ARG
3241 JMS I FPROP /PUT OUT A CALL TO A FLOATING POINT ROUTINE
3243 JMS I ARG /PUT OUT THE ARG PSEUDO OP
3244 JMP I .+1 /JUMP BACK
3246 / THIS ADDS OPERAND ONE TO THE AC
3248 TAD I L41 /GET OPERAND ONE
3249 JMS I LADDL /PUT OUT OPCODES FOR AN ADD
3250 TAD I L41 /GET FIRST OPERAND
3251 JMS I PRSYM /PUT OUT SYMBOL
3252 JMS I PRINT /PUT OUT CR LF
3253 TAD I L41 /GET OPERAND ONE
3254 DCA L46 /PUTN THE AC
3255 JMP I ADDONE /RETURN
3256 UMIN, JMS I CHECK /CHECK WHATSN THE AC
3258 JMS I STORE /THERES SOMETHINGN THE AC...STORET
3259 JMS ADDONE /NOTHINGSN AC NOW...PUT ONEN AC
3260 JMS I MCOMP /AND COMPLEMENTT
3261 JMP RETURN /AND RETURN
3263 JMS I CHECK /CHECK WHATSN THE AC
3265 JMS I STORE /THERES SOMETHINGN THE AC...STORET
3266 JMS ADDONE /GET ONEN AC
3267 JMS ADDTWO /ONESN AC
3269 AONE, JMS ADDONE /ADD ONE TO TWO
3270 JMP RETURN /AND RETURN
3275 JMS I PRSYM /AND PRINT THE SYMBOL
3276 TAD C40 /GET A SPACE
3277 JMS I PRINT /PUT OUT
3278 ISZ LPROP /INCREMENT RETURN
3279 JMP I LPROP /AND RETURN
3280 / THIS ADDS OPERAND TWO TO THE AC
3282 TAD I L43 /GET OPERAND TWO
3283 JMS I LADDL /PUT OUT OPCODES FOR AN ADD
3284 TAD I L43 /GET SECOND OPERAND
3285 JMS I PRSYM /PRINT THE SYMBOL
3286 JMS I PRINT /PUT OUT CR LF
3287 TAD I L43 /GET OPERAND TWO
3288 DCA L46 /AND PUTN AC
3289 JMP I ADDTWO /RETURN
3290 LXZQ, 0 /CHECK FOR EXPRESSION LEFT OF =
3292 TAD L22 /GET SUBSCRIPT NESTING DEPTH
3293 TAD L44 /GET EQUALS SIGN SWITCH
3294 SNA CLA /ARE THEY BOTH ZERO
3295 ERR42, JMS I LUNCH /N YES ...THATS AN ERROR
3297 RETURN, TAD I L41 /THISS THE RETURN...GET OPERAND ONE
3298 JMS I MODE /WHAT MODEST
3299 TAD G400 /ITS FLOATING POINT...TURN F.P. BIT ON
3300 TAD L40 /ADD CURRENT TRIPLE NUMBER
3302 JMP I NARET /AND NOW RETURN FROM THE ROUTINE
3304 JMS I FPROP /PUT OUT A CAL TO THE FLOAT ROUTINE
3306 JMP I FLOAT /AND RETURN
3307 FIX, JMS I FPROP /PUT OUT A CAL
3308 6143 /TO THE FIX ROUTINE
3309 JMP I .+1 /AND JUMP BACKLADDL, ADDL
3317 TAD I L43 /GET FIRST OPERAND
3318 JMS I MODE /FIND WHAT ITS MODE IS
3319 JMP IBM /ITS FLOATING POINT
3320 TAD I L41 /GET OPERAND TWO
3321 JMS I MODE /THIS BETTER BE INTEGER TOO
3322 JMP .+5 /ITS NOT, LUNCH
3323 JMP I LSMODE /GREAT, RETURN
3324 IBM, TAD I L41 /GET OPERAND TWO
3325 JMS I MODE /THIS BETTER BE F.P. TOO
3326 JMP I LSMODE /IT IS RETURN
3327 ERR43, JMS I LUNCH /ERROR
3330 JMP .-1 /NO, TRY AGAIN
3331 PLS /YES, PUNCH THE CHARACTER
3332 CLA /CLEAR THE ACCUMULATOR
3333 JMP I LPUNCH /AND RETURN
3336 LFINI, 0 /FINAL CLEANUP AT END OF COMPILATION
3337 JMS I FPROP /PUNCH 'CALL 0,OPEN'
3339 JMS I PROP /PUNCH A 'PAUSE'
3342 JMS I PRINT /FORCE LAST LINE OUT
3344 JMS I LEADR /PUNCH SOME LEADER
3346 XFINI, HLT /JMP I LFINI, FOR DISK SYSTEM ...
3348 JMP I D1000 /BEGIN NEXT COMPILATION
3353 FORST, JMS I PRINT /FORTRAN STARTING POINT
3368 LLAST, TAD C4000 /END OF COMPILATION, SET CHK SO THAT
3369 DCA CHK /LGTC WILL NOT READ ANOTHER LINE...
3373 JMS I (OSTOP /PUNCH A 'HLT' ETC.
3376 SZA CLA /IS DO LIST EMPTY?
3377 ERR44, JMS I LUNCH /NO, COMPLAIN...
3378 MORDUM, TAD L56 /GET POINTER INTO SYMBOL TABLE
3379 TAD C2 /ADD TWO TO IT FOR CONTROL BITS
3380 DCA L72 /SAVE ADDRESS OF CONTROL BITS
3381 TAD I L72 /GET THE CONTROL BITS
3382 AND E10 /MASK ALL BUT THE DUMMY ARG BIT
3383 SNA CLA /IS THE DUMMY ARG BIT ON
3384 JMP LEDOUT /NO, PUT OUT DUMMY SUBSCRIPT DEFNS
3385 JMS I DEFN /YES, PUT OUT THE VARIABLE NAME
3386 JMS I PROP /PUT OUT THE OP CODE
3388 TAD C2 /RESERVE TWO LOCATIONS
3389 JMS I PROTAC /PRINT THE TWO
3391 ISZ L56 /ADVANCE THE POINTER
3394 JMP MORDUM /GO BACK AND DO THE NEXT ONE
3395 LEDOUT, DCA L72 /ZERO LOCATION 72
3396 LEDOT1, TAD L25 /GET THE NUMBER OF SUBSCRIPT TEMPS
3398 TAD L72 /SUBTRACT FROM THE NUMBER WEVE DEFINED
3399 SNA CLA /HAVE WE DEFINED THEM ALL YET
3400 JMP GOOON /YES, NOW PUT OUT THE END
3401 TAD K5200 /GET SUBSCRIPT DESIGNATOR
3402 TAD L72 /GET WHICH SUBSCRIPT
3403 JMS I PRSYM /AND PRINT IT
3404 TAD C7240 /GET THE TERMINATOR
3406 JMS I PROP /PRINT THE OP CODE
3408 TAD C2 /RESERVE TWO LOCATIONS
3411 ISZ L72 /GO ON TO THE NEXT ONE
3414 6157 /PUT OUT AN END
3415 JMS I PRINT /PUT OUT A CRLF
3416 DCA L65 /ZERO THE PSEUDO LOCATION COUNTER
3417 TAD START /CLA = -600
3418 JMS I LEAD /PUT OUT LOTS OF LEADER CODE
3425 SZA CLA /ARE THERE ANY SYMBOLS
3428 SZA CLA /NO, IS THERE ANY EQUIVALENCING?
3435 TAD I L72 /GET THE CONTROL BITS
3437 TAD L72 /GET THE BITS
3439 SZA CLA /ARE THEY FUNCT NAME,
3441 JMS I DEFN /PUT IT OUT
3443 AND E20 /MASK ALL BUT THE DIMEN
3444 SNA CLA /IS EITHER ONE ON
3449 TAD I L14 /GET THE SECOND DIMENSION
3459 JMS I MODE /DETERMINE MODE OF SYMBOL
3495 TAD L65 /GET THE LOCATION COUNTER
3496 TAD L26 /ADD THE CURRENT AMOUNT TO IT
3497 AND C7600 /MASK ALL BUT THE PAGE BITS
3498 DCA L64 /SAVE THE NUMBER OF PAGES
3499 TAD L65 /GET THE LOCATION COUNTER AGAIN
3500 TAD L26 /ADD THE CURRENT DISPLACEMENT AGAIN
3501 AND C177 /NOW GET THE NUMBER OF LOCATIONS OVER A PAGE
3503 L, TAD L64 /GET THE NUMBER OF PAGES TO BE RESERVED
3504 SNA /ARE THERE ANY TO BE RESERVED
3505 JMP CRAM /NO...JUST PUT OUT STRAIGHT NUMBER OF LOCATIONS
3506 TAD C7600 /YES...SUBTRACT ONE FROM THE PAGE COUNT
3507 DCA L64 /AND SAVE IT
3508 TAD L65 /GET THE NUMBER OF EXTRA LOCATIONS
3509 DCA L26 /AND PUT IN THE DISPLACEMENT LOCATION
3510 JMS I PROTAC /PUT OUT A ZERO
3511 JMS I PRINT /PUT OUT A CRLF
3512 JMS I PROP /PUT OUT THE OPCODE
3513 6151 /WHICH IS THE PAGE PSEUDO OP
3514 JMS I PRINT /PUT OUT A CRLF
3515 JMP L /NOW SEE IF WE HAVE PUT OUT ENOUGH PAGES
3516 CRAM, JMS I PROP /NOW PUNCH 'BLOCK <N>'
3523 TAD L56 /GET THE POINTER TO THE SYMBOL
3524 JMS I PRSYM /PRINT THE SYMBOL
3525 TAD C7240 /GET THE TERMINATOR
3527 JMP I LDEFN /AND RETURN
3528 AFCON, TAD L47 /GET START OF FCON TABLE
3530 DCA L56 /SAVE UPDATED ADDRESS
3531 FLOOP, TAD L50 /GET END OF FCON TABLE
3533 TAD L56 /SUBTRACT FROM CURRENT POINTER
3534 SNA CLA /ARE WE DONE
3536 TAD CM3 /NO, GET MINUS THREE
3537 DCA L63 /TO USE AS A COUNTER
3538 JMS LDEFN /DEFINE IT
3539 TAD I L56 /GET THE FIRST WORD
3540 ISZ L56 /ADVANCE THE POINTER TO THE NEXT WORD
3541 JMS I PROTAC /PRINT THE WORD
3542 JMS I PRINT /PUT OUT A CRLF
3543 ISZ L63 /HAVE WE PUT OUT ALL THREE WORDS
3544 JMP .-5 /NO...PUT OUT ANOTHER
3545 JMP FLOOP /YES...GET THE NEXT CONSTANT
3555 TAD K5400 /GET F.P. DESIGNATOR
3556 JMS LDEFN /PRINT THE SYMBOL
3557 JMS I BSS /RESERVE THE LOCATIONS FOR IT
3558 ISZ L56 /INCREMENT THE POINTER
3569 TAD K5000 /GET THE INTEGER TEMP DESIGNATOR
3571 JMS I BSS /RESERVE LOCATIONS FOR IT
3572 ISZ L56 /INCREMENT THE POINTER
3574 ALTHRU, TAD D6 /PUNCH AN 'IFF 6'
3575 JMS I PIFF /SO THAT ENTRY WILL NOT BE AT END OF THE PAGE
3577 6055 /PUT OUT AN EAP
3579 TAD L70 /GET THE SUBROUTINE FUNCTION POINTER
3581 JMP THRU /NO...WE MUST BE IN A SUBR OR A FUNC
3582 JMS I PROP /YES ...WERE IN A MAIN PROGRAM
3584 TAD C6000 /POINTER TO THE SYMBOL MAIN
3585 JMS I PRSYM /PRINT THE SYMBOL
3586 JMS I PRINT /PUT OUT A CRLF
3587 TAD C6000 /GET THE POINTER TO MAIN AGAIN
3588 JMS I PRSYM /PRINT IT
3589 TAD C7240 /GET A COLON
3590 JMS I P2 /PRINT THEM
3593 JMS I PRINT /PUT OUT A CRLF
3596 JMP I C7600 /AND RETURN TO THE MONITOR ...
3604 JMS I PROP /PUT OUT THE OP CODE
3605 6176 /WHICH IS DUMMY
3606 TAD X5200 /GET SUBSCRIPT DESIGNATOR
3607 TAD L56 /GET THE POINTER
3608 JMS I PRSYM /PRINT THE SYMBOL
3620 /FUNCTION AND SUBROUTINE STATEMENT PROCESSOR
3621 LFUNC, JMS I LOOK /CHECK REST OF STATEMENT
3628 TART, DCA L67 /THIS IS THE SWITCH
3630 SNA CLA /INSURE SUBR. OR FUNCT. IS FIRST STMT.
3634 TAD C6275 /THIS IS THE PLACE TO STORE FUNCTION NAME
3635 DCA L11 /USE AUTO INDEXING TO STORE THE NAME
3636 TAD L30 /GET THE FIRST WORD
3637 DCA I L11 /PUT IT IN THE SYMBOL TABLE
3638 TAD L31 /GET THE SECOND WORD
3639 DCA I L11 /PUT IT IN THE TABLE
3640 TAD L32 /GET THE THIRD WORD
3641 IAC /TURN THE EXTERNAL SYMBOL BIT ON
3642 DCA I L11 /AND PUT IT IN THE TABLE
3643 TAD C6275 /GET THE POINTER
3644 DCA L70 /AND PUT IT IN LOC 70
3646 6052 /PUT OUT AN ENT
3647 TAD L70 /GET THE SUBROUTINE NAME
3648 JMS I PRSYM /PRINT IT
3649 JMS I PRINT /PUT OUT A CRLF
3651 DCA READY /SET SWITCH
3652 TAD L70 /GET THE SUB NAME
3653 JMS I PRSYM /PUT IT OUT
3655 JMS I P2 /PUT IT OUT
3656 JMS I PROP /PUT OUT THE OP CODE 'BLOCK 2'
3661 DCA WHICH /ZERO THE SWITCH WHICH TELLS WHICH WORD
3663 SNA /CHECK FOR END OF CARD
3665 TAD CM50 /CHECK FOR LEFT PAREN
3672 SNA CLA /IS IT A LPAR
3675 GET1, ISZ READY /WERE WE READY FOR LPAR
3676 JMP ERR48 /NO, ERROR ...
3681 TAD C77 /GET MASK FOR SYMBOL TABLE
3682 DCA L21 /AND PUT INTO THE SWITCH
3683 JMS I SYMTAB /AND PUT IN SYMBOL TABLE
3690 6063 /PUT OUT A TAD*
3691 TAD L70 /GET THE FUNCTION NAME
3692 JMS I PRSYM /AND PRINT IT
3693 JMS I PRINT /PUT OUT A CRLF
3696 TAD L77 /GET ADDRESS OF SYMBOL
3697 JMS I PRSYM /PRINT IT
3698 TAD WHICH /GET THE WHICH SWITCH
3699 RAR /GET THE LOW BIT INTO THE LINK
3700 SNL CLA /IS THE WHICH SWITCH BIT SWITCHED
3701 JMP NEXT /NO...THAT MEANS WERE ON THE FIRST WORD
3702 TAD E43 /YES...WERE ON SECOND WORD...GET A "#"
3703 JMS I PRINT /PRINT IT
3705 JMS I PROP /PUT OUT AN INC (ISZ WHICH DOES NOT SKIP)
3707 TAD L70 /GET THE FUNCTION NAME
3708 JMS I PRSYM /AND PRINT IT
3711 JMS I PRINT /PUT OUT A CRLF
3712 ISZ WHICH /INCREMENT THE SHICH SWITCH
3713 TAD WHICH /GET THE SWITCH
3714 RAR /GET LOW BIT IN THE LINK
3715 SZL CLA /IS THE LOW BIT ON
3716 JMP DLOOP /YES...WORK ON THE SECOND WORD
3717 JMP MORE /GO GET SOME MORE
3727 C6275, 6275 /SUBROUTINE OR FUNCTION NAME POINTER
3732 IOEQL, CLA CMA /ROUTINE TO TERMINATE IMPLIED DO LOOPS
3734 DCA IMPDO /REDUCE THE DEPTH BY 1
3735 JMS I DONEXT /GENERATE END-OF-LOOP CODE
3738 SZA CLA /SKIP TO A RIGHT PAREN
3745 LWRIT, JMS I LOOK /LOOK FOR REST OF STATEMENT
3749 LREAD, TAD C6030 /GET THE POINTER TO READ AND WRITE
3750 DCA IOP /USE AS A PARAMETER WITH FPROP
3753 SZA CLA /IS THIS A LEFT PAREN?
3766 TAD CM54 /IS IT A COMMA
3768 JMP ERR50 /NO, ERROR ...
3776 TAD CM51 /CHECK FOR A RIGHT PAREN
3784 SNA CLA /IS IT A COMMA
3786 IOH1, JMS I PUTCH /NO...PUT IT BACK
3787 JMS I GNB /THIS STMT IS TRANSFERRED TO!
3790 JMP I IOPEN /OPEN PAREN - MAY BE IMPLIED DO-LOOP
3792 DCA L52 /SET SWITCHES FOR GENER
3795 JMS I GENER /START PROCESSING THE IO LIST
3799 DCA L73 /SAVE CREATED LABEL LOC
3800 DCA L23 /ZERO TEMPORARY FOR "DUMARG"
3801 JMS I LCHNG /TEST FOR 0 OR DUMMY ARG
3803 TAD L23 /GET TEMPORARY FROM "DUMARG"
3804 SZA CLA /ZERO MEANS NON-VARIABLE NAME
3805 TAD I L23 /NON-ZERO POINTS TO FLAG WORD OF VAR
3807 SNA CLA /DO WE HAVE AN ARRAY NAME?
3810 OPCMA /PUT OUT A "CMA" TO DISTINGUISH THIS CALL
3811 JMS I PRINT /FROM A REGULAR CALL TO "IOH"
3814 6036 /OUTPUT A "CALL 2,IOH"
3818 JMS I DIM /GET THE DIMENSIONS
3825 JMS I MODE /GET THE MODE OF THE ARRAY
3826 TAD C4000 /FLOATING POINT - ADD 4000 TO AC
3829 JMP .-2 /COMPUTE PRODUCT OF DIMENSIONS PLUS MODE BIT
3830 JMS I PROTAC /PRINT IT
3832 JMP IOHRSM /GO PRINT ARRAY NAME
3836 IAC /THERE WILL BE ONE ARGUMENT
3837 JMS I FPROP /PUT OUT THE CALL TO IOH
3840 DCA L53 /RESTORE CREATED LABEL LOC
3843 TAD L63 /GET TERMINATING CHAR
3844 SNA CLA /WAS IT A <CR>?
3846 IOH3, JMS I GNB /GENTLY LOOK AHEAD ...
3847 SNA CLA /DO WE HAVE A ',<CR>' ?
3848 JMP START /YES, DO NOT TERMINATE YET ...
3849 JMP IOH1 /NO, PUSH IT BACK & PROCESS NEXT ITEM
3850 IOH2, IAC /THERE WILL BE ONE ARGUMENT
3851 JMS I FPROP /PUT OUT A CALL TO IOH
3853 JMS I ARG /PUT OUT THE PSEUDO OP ARG
3860 JMP ERR51+1 /ITS A VARIABLE
3864 DCA L21 /ZERO THE SYMBOL TABLE SWITCH
3878 LRET, JMS I LOOK /CHECK REST OF STATEMENT
3884 SNA CLA /ARE WE COMPILING MAIN PROGRAM?
3885 ERR60, JMS I LUNCH /YES
3888 JMP INT /ITS A SUBROUTINE
3889 TAD L70 /GET HE NAME OF THE FUNCTION
3890 JMS I MODE /IS IT FP OR INTEGER
3894 JMP .+5 /PUT OUT THE SYMBOL
3895 IAC /THERE IS ONE ARGUMENT
3899 TAD F34 /GET A BACK SLASH
3901 TAD L70 /GET THE NAME OF THE FUNCTION
3902 JMS I PRSYM /PRINT THE NAME
3903 JMS I PRINT /PUT OUT A CRLF
3906 TAD L70 /GET THE FUNCTION NAME
3907 JMS I PRSYM /PRINT IT
3908 JMS I PRINT /PUT OUT A CRLF
3909 JMP START /WERE DONE
3911 LGETHI, 0 /PUNCH 'TAD ACH'
3914 JMS I PROP /PRINT THE OP CODE
3915 6226 /WHICH IS ACH (HIGH ORDER AC)
3917 JMS I FPROP /PUNCH 'CALL 0,CLEAR'
3920 LDIM, 0 /GETS THE 1ST DIMENSION OF THIS VARIABLE
3921 DCA LGETHI /SYMBOL TABLE ADDRESS IS IN THE AC
3925 LK, TAD I L14 /SEARCH THE DIMENSION TABLE
3933 TAD I L14 /EXIT WITH DIMENSION IN THE AC
3935 / THIS PROCESSES SUBSCRIPTS
3936 SUBRET, JMP I LSUBSC /RETURN FROM SUBSC
3937 LSBTEM, 0 /THIS ROUTINE MAKES AN ENTRY
3938 DCA TRIP /IN SUBSCRIPT TEMPORARY TABLE
3943 LOOP, TAD I POINT /LOOK FOR CURRENT TRIPLE NR
3944 SNA /OR END OF TABLE...
3963 SPA CLA /IF TEMPORARY NR > L25
3967 LWIPE, 0 /ZERO THE SUBSCRIPT TEMP. TABLE
3979 JMS I PROTAC /PUT OUT A ZERO
3980 JMP I LZER /AND REUTURN
3982 SNA /IF NO LABEL IN AC,
3983 JMS I CREATE /CREATE A LABEL
3984 JMS I PRCRL /AND PRINT IT
3985 TAD C7240 /PUT OUT A COLON AND SPACE
3995 SZA /IS THERE ANYTHING IN THE AC?
3996 CHANGE, SKP CLA /********************************
3997 / TRY CHANGING THIS LOCATION TO A "JMS I MODE"
3998 / TO LIMIT THE CHECK TO THE INTEGER AC!
3999 / COULD SAVE UP TO 30% IN HEAVILY SUBSCRIPTED F.P.
4000 / EXPRESSIONS! (IMPORTANT - TEST WITH F.P. SUBSCRIPTS)
4001 SKP /NOTHING IN THE AC
4002 JMS I STORE /YES - STORE IT
4012 SNA CLA /WAS IT A PRIME
4028 DCA LDUM /SAVE ARRAY POINTER (OR 0 IF DUMMY)
4029 TAD L73 /NOW RESTORE THE CREATED LABEL LOC
4032 SNA CLA /HOW MANY SUBSCRIPTS?
4033 JMP .+7 /ONE - SKIP OUTPUTTING "TAD"
4045 DCA I L41 /STORE TRIPLE NUMBER WITH MODE BITS IN PD STACK
4046 TAD SYMOUT /GET NUMBER OF ARGUMENTS (2 OR 3)
4048 JMS I FPROP /PUT OUT A CALL TO THE SUBSCRIPTING ROUTINE
4049 6173 /TO THE SUBSCRIPTING ROUTINE
4051 SNA CLA /ONLY ONE ARG?
4052 JMP .+3 /YES - DON'T OUTPUT FIRST SUBSCRIPT
4057 TAD LDUM /GET THE ARRAY NAME
4058 JMS SYMOUT /OUTPUT IT AS AN ARGUMENT
4060 JMS I PRSYM /OUTPUT THE DESTINATION TEMPORARY
4063 DCA L12 /MARK IT AS THE CONTENTS OF THE LAST LINE
4064 JMP I FSUBSC /RETURN
4066 OPCMA /OPCODE IS CMA
4068 TAD H400 /SET MODE TO FLOATING POINT
4074 JMS I CLAB /CREATE LABEL IF DUMMY ARG
4078 JMS I ZER /YES PUT OUT A ZERO
4079 JMS I PRSYM /OTHERWISE PUT OUT SUBSCRIPT
4080 JMS I PRINT /PUT OUT A CRLF
4085 JMS I PRCRL /CHANGE LAST LINE TO STORE IN NEW DESTINATION
4086 DCA L12 /MARK LAST LINE USELESS FOR OPTOMIZATION
4089 ISZ LDUM /INCREMENT RETURN
4090 TAD I L42 /GET THE THING WHICH IS DUMMY
4092 TAD L12 /DID WE JUST PUT THIS OUT AS A SUBSCRIPT
4093 SNA CLA /DESTINATION??
4094 JMP LDSPCL /YES - SAVE OODLES OF CODE
4098 JMS I PRSYM /PUT IT OUT
4099 JMS I PRINT /PUT OUT A CRLF
4102 JMS I CREATE /CREATE A LABEL
4103 JMS I PRCRL /AND PRINT IT
4104 JMS I PRINT /PUT OUT A CRLF
4121 TAD I L42 /NO...THERES TWO SUBSCRIPTS
4126 JMS I DUMARG /SEE IF SECOND SUBSC IS A DUMMY ARG
4127 JMS I DUM /YES IT IS A DUMMY ARG
4128 TAD I L42 /GET THE SECOND SUBSC
4141 DCA L24 /ZERO "BUFFER WAITING TO PRINT" FLAG
4142 DCA IMPDO /ZERO IMPLIED DO LOOP FLAG
4143 TAD TTYPE /CHANGE TO TTY OUTPUT
4145 JMS I LLIST /TYPE THE CURRENT LINE
4147 TAD KOUNT /USE THE BUFFER POINTER AS AN INDEX
4151 TAD C40 /NOW PUT OUT SOME SPACES...
4158 TAD LELIST /NOW TYPE THE ERROR MESSAGE
4163 SNA CLA /IS THIS THE MSG WE WANT?
4170 JMS I LLIST /FAKE LISTER INTO PRINTING ERROR MESG
4171 JMS I PRINT /FORCE BUFFER
4172 TAD EPNCH /BACK TO PUNCH OUTPUT
4174 ISZ L75 /SET THE NON-PRINT SWITCH
4175 TAD CHK /IF ERROR OCCURED WHILE PROCESSING END STMT.
4176 TAD C4000 /CHK WILL BE 4000-WANT TO ABORT IMMEDIATELY
4177 SZA CLA /WAS IT END STMT?
4178 JMP START /NO-GO PROCESS NEXT STMT.
4179 JMP I (THRU /YES-CLEAN UP AND ABORT
4182 LELIST, ELIST-1 /ERROR LIST ...
4187 / THIS ROUTINE PRINTS THE CONTENTS OF THE AC IN DECIMAL
4189 DCA TEM /SAVE THE AC
4190 TAD CM3 /WE WILL PUT OUT FOUR CHARACTERS
4192 TAD ASE /THIS IS THE ASE OF THE CONVERSION TABLE
4193 DCA NPOINT /SAVE IT IN THE POINTER
4195 LOP, DCA MCHAR /ZERO OUT THE CHARACTER
4196 TAD TEM /GET THE NUMBER AGAIN
4197 TAD I NPOINT /TO GET THE ITEM IN THE TABLE
4198 SPA /IS THE RESULT POSITIVE
4199 JMP LOPRST /NO...RESTORE THE NUMBER
4200 DCA TEM /AND SAVE THIS VALUE
4202 DCA FLAG /SET FLAG TO SHOW THAT WE HAVE SOMETHING
4203 ISZ MCHAR /YES...INCREMENT THE OUTPUT CHARACTER
4204 JMP LOP+1 /TRY THE SEQUENCE AGAIN
4208 SZA /DO WE HAVE A SIGNIFICANT DIGIT?
4209 JMS I PRINT /YES - PRINT IT
4212 JMP LOP /AND GET THE NEXT DIGIT
4213 TAD TEM /GET THE CHARACTER TO OUTPUT
4214 TAD D60 /PUT IT IN TRIMMED ASCII FORM
4215 JMS I PRINT /PRINT IT
4216 JMP I LDCOUT /YES...RETURN TO CALLING PROGRAM
4222 DCA IOHTMP /SAVE POINTER TO LEFT PAREN +1
4224 DCA PARCT /INITIALIZE PAREN COUNTER
4226 DCA TEM /TEM POINTS TO ENTITY (OR PREV ONE IF A VAR)
4227 IOPENL, JMS I ENTITY /GET SOMETHING
4228 ERR52, JMS I LUNCH /END OF STMT - BAD
4229 JMP IOPENL /VARIABLE - DON'T UPDATE TEM
4231 JMP IOPENL-2 /CONSTANT - UPDATE TEM
4232 TAD CM51 /PUNCTUATION - TEST FOR RIGHT PAREN
4239 SNA CLA /IF CHAR IS AN EQUAL SIGL
4242 SZA CLA /AND WE ARE ON THE TOP LEVEL OF PARENTHESES
4244 TAD TEM /THEN WE HAVE AN IMPLIED DO
4246 JMS I DO /GENERATE DO LOOP CODE
4247 JMP ERR52 /NOT TERMINATED WITH RPAR - ERROR
4248 ISZ IMPDO /BUMP IMPLIED DO COUNT
4250 DCA KOUNT /RESTORE CHAR PTR TO BEGINNING OF LOOP
4252 IOH1+1 /COMPILE INNARDS OF LOOP
4256 JMP IOPENL-3 /BUMP PAREN COUNT UP AND LOOP
4258 IORPAR, ISZ PARCT /BUMP PAREN COUNT DOWN
4259 JMP IOPENL-2 /LOOP IF NOT BALANCED
4261 DCA KOUNT /BALANCED - NOT AN IMPLIED DO
4263 IOH1BK /COMPILE NORMALLY
4267 EQUI, JMS I LOOK /CHECK REST OF STATEMENT TYPE
4268 -7 /THERE ARE 7 MORE CHARACTERS
4276 RETA, ISZ SNUM /INCREMENT THE STRING NUMBER
4277 JMS CCCC /GET AND CHECK THE NEXT NON-BLANK CHARACTER
4278 SKP /ONLY LEGAL CHAR HERE IS A "("
4279 JMP RETB /WE GOT THE "("
4282 RETB, JMS I ENTITY /LOOK FOR A VARIABLE
4284 JMP LA /GOT IT, ANYTHING ELSE IS AN ERROR
4288 LA, ISZ L32 /TURN EQUIVALENCE BIT ON
4290 TAD K57 /GET MASK FOR SYMBOL TABLE
4291 DCA L21 /PUT IN THE SYMBOL TABLE SWITCH
4292 JMS I SYMTAB /PUT IN SYMBOL TABLE
4293 TAD L77 /GET THE POINTER
4294 ISZ MIKE4 /AND PUT IN EQUIVALENCE TABLE
4296 TAD SNUM /GET THE CURRENT STRING NUMBER
4297 ISZ MIKE4 /AND PUT IT IN THE EQUIVALENCE TABLE
4299 ISZ MIKE8 /INCREMENT NUMBER OF ENTRIES
4300 JMS CCCC /GET NEXT PUNCTUATION
4301 JMP ERR59 /C/R, THAT'S AN ERROR ...
4302 JMP .+3 /LEFT PAREN, VARIABLE IS SUBSCRIPTED
4303 JMP LB /COMMA, NOT SUBSCRIPTED, STRING CONTINUES
4304 JMP LC /RIGHT PAREN, NOT SUBSCRIPTED, END OF STRING
4305 JMS I ENTITY /LOOK FOR SUBSCRIPT
4308 JMP LD /GOT IT, ANYTHING ELSE IS ERROR
4311 LD, CLA CMA /SUBTRACT ONE FROM
4312 TAD L32 /FIRST SUBSCRIPT
4314 JMS CCCC /GET NEXT PUNCTUATION
4315 NOP /CR IS ILLEGAL HERE
4316 JMP RETB-1 /SO IS LEFT PAREN
4317 SKP /COMMA, DOUBLY SUBSCRIPTED
4318 JMP LF /RIGHT PAREN, SINGLY SUBSCRIPTED
4319 JMS I ENTITY /GET OTHER SUBSCRIPT
4325 LG, TAD L32 /SET IT NEGATIVE
4327 DCA INTB /AND SAVE IT
4328 JMS CCCC /GET NEXT PUNCTUATION
4332 TAD L77 /RIGHT PAREN IS ONLY LEGAL CHARACTER
4333 JMS I DIM /GET DIMENSION INFORMATION
4335 SKP /GO TO TEST PART OF LOOP
4336 TAD CCCC /THIS LOOP IS A MAKESHIFT MULTIPLY
4337 ISZ INTB /ARE WE DONE
4339 TAD INTA /YES, ADD FIRST SUBSCRIPT
4341 LF, TAD L77 /GET POINTER TO VARIABLE
4342 JMS I MODE /WHAT MODE IS IT
4343 TAD INTA /F.P., MULTIPLY BY THREE
4346 IAC /ADD ONE TO ANSWER
4347 ISZ MIKE4 /AND PUT IN EQUIVALENCE TABLE
4349 JMS CCCC /GET NEXT PUNCTUATION
4351 JMP RETB-1 /CR AND "(" ARE ILLEGAL HERE
4352 JMP RETB /COMMA MEANS STRING NOT FINISHED
4353 JMP LI /")" MEANS STRING FINISHED
4354 LC, CLA IAC /HERE WE CRAM A ONE INTO EQUIVALENCE
4357 LI, JMS CCCC /WE FINISHED A STRING, ARE THERE MORE
4361 JMP RETB-1 /"(" AND ")" ARE ILLEGAL HERE
4362 LB, CLA IAC /CRAM A ONE INTO TABLE
4365 JMP RETB /AND GO BACK
4367 / THIS"ROUTINE GETS AND CHECKS THE NEXT NON-BLANK CHAR
4371 SNA /PUNCTUATION IS WHAT WE WANT
4372 JMP I CCCC /ITS A CR
4382 JMP RETB-1 /NONE OF THE ABOVE
4392 JMS I ZZZ /PRINT LABEL ON "FINI"
4396 /THE FOLLOWING CODE IS TO PROCESS THE EQUIVALENCE TABLE
4397 /AT THE END OF A COMPILATION
4401 DCA I MIKE4 /SET END OF LIST
4402 JMS INIT /INITIALIZE POINTERS
4403 AAB, TAD MA /SET POINTERS TO STRING NUMBERS
4410 TAD I MA /GET FIRST STRING NUMBER
4412 TAD I MB /SUBTRACT FROM SECOND
4413 SZA CLA /ARE THEY THE SAME
4414 JMP KICK1 /NO, ADVANCE POINTERS
4415 ISZ MA /YES, MOVE TO LINEAR SUBSCRIPT
4417 TAD I MA /GET FIRST SUBSC
4419 TAD I MB /SUBTRACT FROM SECOND
4420 SPA CLA SNA /IS FIRST ONE SMALLER
4421 JMP KICK2 /NO, JUST ADVANCE POINTERS
4422 TAD MA /YES, SWITCH PLACES
4443 JMP AA /NOW THEYRE SWITCHED, CHECK AGAIN
4444 KICK2, CLA CMA /MOVE BACK FIRST POINTER
4448 KICK1, ISZ MA /MOVE UP FIRST POINTER
4449 ISZ MIKE7 /ARE WE OUT OF ENTRIES
4452 / NOW THE SORTING IS DONE
4454 JMS INIT /INITIALIZE POINTERS
4455 DCA TOTAL /ZERO OUT TOTAL
4458 JMS I PRSYM /PUT OUT THE SYMBOL
4460 JMS I P2 /PUT OUT THE TERMINATOR
4464 TAD I L14 /GET CONTROL BITS FROM SYMBOL TABLE
4466 SNA CLA /IS IT DIMENSIONED
4468 TAD I MA /YES, COMPUTE THE TOTAL LENGTH
4478 MIKE5, IAC /IF NOT DIMENSIONED, USE ONE A LENGTH
4481 JMS I MODE /WHAT IS THE MODE OF THE SYMBOL
4482 TAD MB /FP, MULTIPLY BY THREE
4486 TAD TOTAL /GET TOTAL REMAINING LENGTH OF STRING
4488 TAD INIT /SUBTRACT CURRENT LENGTH FROM IT
4489 SPA CLA /WHICH IS BIGGER
4490 JMP .+3 /REMAINING PORTION IS BIGGER
4491 TAD INIT /CURRENT PORTION IS BIGGER, REPLACE REMAINING PORTION
4497 TAD I MB /GET NEXT ENTRY STRING NUMBER
4499 TAD I MA /SUBTRACT CURRENT STRING NUMBER
4500 SZA CLA /ARE THEY EQUAL
4502 ISZ MA /YES, GET THE DIFFERENCE
4508 TAD MB /SUBTRACT DIFFERENCE FROM TOTAL REMAINING
4511 MIKE6, DCA TOTAL /SAVE
4512 TAD MB /GET THE DIFFERENCE
4514 JMS I BSS /RESERVE THAT MANY LOCATIONS
4515 ISZ MIKE7 /ARE WE DONE
4518 MIKE1, TAD TOTAL /SWITCH TOTAL TO THE CURRENT LOCATION
4520 ISZ MA /EQUALIZE POINTERS
4524 TAD MIKE8 /GET ENTRY COUNT
4527 TAD POINTZ /GET TABLE POINTER
projects / pdp8.git / blob