X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=programs%2Ffortran%2Fsrc%2Ffortran-corrected.asm;fp=programs%2Ffortran%2Fsrc%2Ffortran-corrected.asm;h=0000000000000000000000000000000000000000;hb=6ad6bd16506f180bf1a9214233bae33ccf25a299;hp=e80a7e7573f81fe040b263fc576ab84868e56f96;hpb=5b966def691a7aec3e5b101fc3ae08ea5c1e3afd;p=h316.git diff --git a/programs/fortran/src/fortran-corrected.asm b/programs/fortran/src/fortran-corrected.asm deleted file mode 100644 index e80a7e7..0000000 --- a/programs/fortran/src/fortran-corrected.asm +++ /dev/null @@ -1,7165 +0,0 @@ -* C210-001-6601 (FRTN) 3C NO.180463000 REV. D -* -* -* -* COMPUTER. DDP-116,516 -* -* -* -* -* PROGRAM CATEGORY- COMPILER -* -* -* -* -* PROGRAM TITLE. FRTN -* EXPANDED FORTRAN IV COMPILER -* FOR DDP-116,516 -* -* -* -* -* -* -* -* APPROVAL DATE -* -* -* PROG--------------------- ------------ -* -* -* SUPR---------------------- ------------ -* -* -* QUAL---------------------- ------------ -* -* -* NO. OF PAGES ------------ -* -* REVISIONS -* -* REV. D ECO 5249 -* REV. C ECO 3824 10-31-66 -* REV. B ECO 3476 09-19-66 -* REV. A 06-08-66 -* -* AUTHOR -* -* HONEYWELL. INC. - COMPUTER CONTROL DIVISION -* -* -* PURPOSE -* -* THIS PROGRAM IS DESIGNED TO COMPILE ASA STANDARD FORTRAN IV -* PROGRAMS IN ONE PASS, GENERATING OPTIMUM OBJECT CODE FOR THE -* DDP-116 OR DDP-516. -* -* -* RESTRICTIONS -* -* MINIMUM 8K CORE STORAGE -* -* -* STORAGE -* -* 6682 (DECIMAL) -* 15034 (OCTAL) -* -* -* USE -* -* -* ******************************** -* -* *FORTRAN-IV OPERATING PROCEDURE* -* ******************************** -* -* 1. LOAD THE COMPILER SYSTEM TAPE USING STANDARD 'LOAD-MODE' -* (DDP-116), OR "PAL-MODE (DDP-516) LOADING PROCEDURES -* -* 2. SET THE (A) REGISTER FOR THE DESIRED INPUT/OUTPUT DEVICE -* SELECTION AS DESCRIBED BELOW, SET (P) TO '1000, SET THE -* SENSE SWITCHES AS DESCRIBED BELOW, AND PRESS START. -* -* 3. INPUT/OUTPUT DEVICE SELECTION (BITS SET IN (A) ON ENTRY)..... -* 1......IF SET, CERTAIN ERROR CHECKS ARE NOT MADE. THIS -* OPTION IS USED WHEN COMPILING THOSE PARTS OF THE -* LIBRARY WRITTEN IN FORTRAN LANGUAGE AND IT ALLOWS THE -* LIBRARY TO TAKE ADVANTAGE OF THE COMPILER'S LOGIC TO -* GENERATE SPECIAL CODING. -* -* 2-7....NOT ASSIGNED -* -* 8-10...INPUT DEVICE SELECTION -* 1 = ASR-33/35 KEYBOARD (OR ITS PAPER TAPE READER) -* 2 = NCR CARD READER -* 3 = DIGITRONICS PAPER TAPE READER -* 4 = MAGNETIC TAPE ( UNIT 1 ) -* 5-7 = (SPARES) -* -* 11-13..SYMBOLIC LISTING SELECTION -* 0. SUPPRESS ALL SYMBOLIC LISTINGS -* 1. ASR-33/35 TYPEWRITER -* 2. LINE PRINTER -* 3 = ( SPARE ) -* 4 = LISTING ON MAGNETIC TAPE UNIT 2 -* 5-7 = (SPARES) -* -* 14-16..BINARY OUTPUT SELECTION -* 0. SUPPRESS BINARY OUTPUT. -* 1. BRPE HIGH SPEED PAPER TAPE PUNCH -* 2. ASR BINARY OUTPUT ASR/33 -* 3. ASR BINARY OUTPUT ASR/35 -* 4 = MAGNETIC TAPE OUTPUT -* 5-7 (SPARES) -* -* -* 4. SENSE SWITCH SETTINGS AND MEANINGS....... -* 1......EXPAND THE SYMBOLIC LISTING TO INCLUDE -* SIDE-BY-SIDE OCTAL INFORMATION. -* 2......INHIBIT SYMBOLIC LISTING (AS LONG AS SSW-1 NOT SET). -* 3......PAUSE BEFORE INPUT OF THE NEXT RECORD. DURING -* THIS PAUSE, THE (A) REGISTER WILL DISPLAY THE CURRENT -* STATUS OF THE I/O KEYBOARD, IT MAY BE -* CHANGED AT THIS TIME IF DESIRED BEFORE RESETTING -* SSW-3 AND PRESSING START TO CONTINUE. -* 4......CAUSE TRACE COUPLING INFORMATION TO BE INCLUDED -* IN THE OBJECT CODING BEING GENERATED REGARDLESS OF -* ANY TRACE STATEMENTS WITHIN THE PROGRAM (OPERATOR -* OVERRIDE). -* -* 5. WHEN BINARY TAPE IS BEING GENERATED, THE COMPILER -* AUTOMATICALLY TURNS ON THE TAPE PUNCH AND PUNCHES OUT A -* LENGTH OF LEADER. AFTER THE END-OF-JOB IS TYPED, A LENGTH OF -* TRAILER IS PUNCHED BEFORE TURNING OFF THE PUNCH, AND THE LINE -* PRINTER IS ADVANCED TO THE NEXT PAPER SEAM. PRESS 'START' -* TO PROCESS THE NEXT PROGRAM (BATCH COMPILING). -* -* FOR ASR BINARY OUTPUT, NO LEADER OR TRAILER IS -* PROVIDED, AND THE BINARY PUNCH IS LEFT ON THROUGHOUT -* THE COMPILATION. -* -* -* ERRORS -* -* THE ERROR MESSAGES OUTPUT BY THIS COMPILER ARE LISTED ON A -* SEPERATE DOCUMENT FOR EASE OF DISTRIBUTION. -* ************************* -* *DATA POOL ENTRY FORMATS* -* ************************* -* -* THE DATA POOL CONSISTS OF FOUR FORMS OF INFORMATION -* 1. THE ASSIGNMENT TABLE CONSISTS OF 5 WORDS, STARTS -* AT THE END OF THE COMPILER AND EXTENDS TOWARD THE -* END OF MEMORY. -* -* TDCCCCCCCCCCCCCC....DP(A+4) -* CCCCCCCCCCCCCCCC....DP(A+3) -* CCCCCCCCCCCCCCCC....DP(A+2) -* IIAAAAAAAAAAAAAA....DP(A+1) -* NRRRMMMLLLLLLLLL....DP(A) -* -* T = TRACE TAG -* D = DATA TAG -* C = SIX 8-BIT CHAR. OR BINARY CONSTANT -* I = ITEM USAGE (IU) -* 0 = NO USAGE 2 = VAR/CONSTAN^ -* 1 = SUBPROGRAM 3 = ARRAY -* A = ASSIGNMENT ADDRESS -* N = NAME TAG (NT) -* 0 = NAME 1 = CONSTANT -* R = ADDRESS TYPE (AT) -* 0 = ABSOLUTE 3 = STRING-REL -* 1 = RELATIVE 4 = COMMON -* 2 = STRING-ABS 5 = DUMMT -* M = ITEM MODE (IM) -* 1 = INTEGER 5 = COMPLEX -* 2 = REAL 6 = DOUBLE -* 3 = LOGICAL -* 4=COM/EQU LINK -* 2. THE DO TABLE 'FLOATS' ON TOP OF THE ASSIGNMENT -* TABLE AND CONTAINS THE INFORMATION NEEDED TO CLOSE-OUT -* A DO-LOOP, EACH ENTRY IS 5 WORDS. -* 00IIIIIIIIIIIII -* 00TTTITTTTTTTTT -* 00XXXXXXXXXXXXX -* 00UUUUUUUUUUUUUU -* 00NNNNNNNNNNNNNN -* I = INITIAL VALUE/OR RPL -* T = TERMINAL VALUE -* X = INDEX -* U = INCREMENT -* N = STATEMENT NUMBER -* -* 3. THE EXPRESSION TABLE (A0I TABLE) 'FLOATS' ON TOP -* THE DO TABLE AND CONSISTS OF 2 WORD ENTRIES. -* -* NOOOOOOOOIIIIIII.....DP(I+1) -* 00AAAAAAAAAAAAAAAA...DP(I) -* N = NEGATION INDICATOR -* O = OPERATOR -* I = INDEX (OPERATOR LEVEL) -* A = ASSIGNMENT TABLE REFERENCE -* 4. THE TRIAD TABLE IS USED TO OPTIMIZE EXPRESSIONS AND -* IS AT THE END OF MEMORY EXTENDING DOWN TOWARDS THE -* COMPILER. EACH ENTRY IS THREE WORDS LONG. -* -* S000000000PPPPPP.....DP(L+2) -* 0011111111111111.....DP(L+1) -* 0022222222222222.....DP(L) -* S = TEMP STORAGE INDICATOR -* P = OPERATOR -* 1 = FIRST OPERAND ADDRESS -* 2 = SECOND OPERAND ADDRESS - ABS - ORG '100 -* -* ************************************ -* * DIRECTORY OF FORTRAN IV COMPILER * -* ************************************ -* -* -* -*..............ENTRANCE GROUP - DAC A3 (ENG1) COMPILER ENTRANCE/INITIALIZE - DAC DP DATA POOL START -* -*..............INPUT GROUP - DAC IC00 (IPG1) INPUT COLUMN - DAC UC00 (IPG2) UNINPUT COLUMN - DAC CH00 (IPG3) INPUT CHARACTER - DAC ID00 (IPG4) INPUT DIGIT - DAC IA00 (IPG5) INPUT (A) CHARACTERS - DAC FN00 (IPG6) FINISH OPERATOR - DAC DN00 (IPG7) INPUT DNA - DAC II00 (IPG8) INPUT ITEM - DAC OP00 (IPG9) INPUT OPERAND - DAC NA00 (IPG10) INPUT NAME - DAC IG00 (IPG11) INPUT INTEGER - DAC IV00 (IPG12) INPUT INTEGER VARIABLE/CONSTANT - DAC IR00 (IPG13) INPUT INTEGER VARIABLE - DAC IS00 (IPG14) INPUT STATEMENT NUMBER - DAC XN00 (IPG15) EXAMINE NEXT CHARACTER - DAC SY00 INPUT STMBOL -* -*..............TEST GROUP - DAC TS00 (TSG1) ALL CHARACTER TEST (EXCEPT C/R) - DAC IP00 (TSG2) )-INPUT OPERATOR - DAC A1 (TSG3) C/R TEST - DAC B1 (TSG4) , OR C/R TEST - DAC NU00 (TSG5) NO USAGE TEST - DAC NC00 (TSG6) NON CONSTANT TEST - DAC NS00 (TSG7) NON SUBPROGRAM TEST - DAC AT00 (TSG8) ARRAY TEST - DAC IT00 (TSG9) INTEGER TEST - DAC NR00 (TSG10) NON REL TEST -* -*..............ASSIGNMENT GROUP - DAC AS00 (ASG1) ASSIGN ITEM - DAC TG00 (ASG2) TAG SUBPROGRAM - DAC TV00 (ASG3) TAG VARIABLE - DAC FA00 (ASG4) FETCH ASSIGN - DAC FL00 (ASG5) FETCH LINK - DAC KT00 (ASG6) D(0)= SIZE OF ARRAY DEFLECTION - DAC DM00 (ASG7) DEFINE IM - DAC DA00 (ASG8) DEFINE AF - DAC AF00 (ASG9) DEFINE AFT - DAC LO00 (ASG10) DEFINE LOCATION - DAC AI00 (ASG11) ASSIGN INTEGER CONSTANT - DAC AA00 (ASG12) ASSIGN SPECIAL - DAC NXT GET NEXT ENTRY FROM ASSGN TABLE - DAC BUD BUILD ASSIGNMENT TABLE ENTRT -* -*..............CONTROL GROUP - DAC B6 (CNG1) JUMP - DAC C5 ILL TERM - DAC C6 (CNG2) CONTINUE - DAC C7 (CNG3) STATEMENT INPUT - DAC C8 (CNG4) STATEMENT SCAN - DAC A9 (CNG5) STATEMENT IDENTIFICATION - DAC NP00 (CNG6) FIRST NON-SPEC CHECK -* -*..............SPECIFICATIONS GROUP - DAC EL00 (SPG1) EXCHANGE LINKS - DAC NM00 (SPG2) NON COMM0N TEST - DAC ND00 (SPG3) NON DUMMY OR SUBPROGRAM TEST - DAC SC00 (SPG4) INPUT SUBSCRIPT - DAC IL00 (SPG5) INPUT LIST ELEMENT - DAC R1 (SPG6) FUNCTION - DAC R2 SUBROUTINE - DAC A3 (SPG7) INTEGER - DAC A4 REAL - DAC A5 DOUBLE PRECISION - DAC A6 COMPLEX - DAC A7 LOGICAL - DAC B2 (SPG8) EXTERNAL - DAC B3 (SPG9) DIMENSION - DAC B7 INPUT DIMENSION - DAC B4 (SPG10) COMMON - DAC B5 (SPG11) EQUIVALENCE - DAC C2 (SPG12) RELATE COMMON ITEMS - DAC C3 (SPG13) GROUP EOUIVALENCE - DAC C4 (SPG14) ASSIGN SPECIFICATIONS - DAC W4 (SPG15) DATA - DAC R3 (SPG16) BLOCK DATA - DAC TRAC (SPG17) TRACE -* -*..............PROCESSOR GROUP - DAC V3 (PRG1) IF - DAC R7 (PRG2) GO TO - DAC IB00 INPUT BRANCH LIST - DAC W3 (PRG3) ASSIGN - DAC C9 (PRG5) DO - DAC V7 (PRG6) END FILE - DAC V6 BACKSPACE - DAC V8 REWIND - DAC V5 (PRG7) READ - DAC V4 WRITE - DAC V2 (PRG8) FORMAT - DAC SI00 INPUT FORMAT STRING - DAC IN00 INPUT NUMERIC FORMAT STRING - DAC NZ00 NON ZERO STRING TEST - DAC W8 (PRG9) PAUSE - DAC W7 STOP - DAC R8 (PRG10) CALL - DAC G2 ASSIGNMENT STATEMENT - DAC R9 (PRG11) RETURN - DAC G1 (PRG12) STATEMENT FUNCTION - DAC W5 (PRG13) END -* -*..............PROCESSOR SUBROUTINES GROUP - DAC PO00 (PSG1) INPUT CHAR AND OUTPUT PACK - DAC HS00 (PSG2) TRANSMIT HOLLERITH STRING - DAC DP00 (PSG3) DO INPUT - DAC DS00 (PSG4) DO INITIALIZE - DAC DQ00 (PSG5) DO TERMINATION - DAC EX00 (PSG6) EXPRESSION - DAC CA00 (PSG7) SCAN - DAC ST00 TRIAD SEARCH - DAC TC00 TEMP STORE CHECK - DAC ET00 (PSG8) ENTER TRIAD - DAC GE00 (PSG9) GENERATE SUBPROGRAM ENTRANCE -* -*..............OUTPUT GROUP - DAC OL00 (OPG1) OUTPUT OBJECT LINK - DAC OI00 (OPG2) OUTPUT I/O LINK - DAC CN00 (OPG3) CALL NAME - DAC OK00 (OPG4) OUTPUT PACK - DAC OB00 (OPG5) OUTPUT OA - DAC OT00 (OPG6) OUTPUT TRIADS - DAC OM00 (OPG7) OUTPUT ITEM - DAC OR00 (OPG8) OUTPUT REL - DAC OA00 OUTPUT ABS - DAC OS00 OUTPUT STRING - DAC OW00 (OPG9) OUTPUT WORD - DAC PU00 PICKUP - DAC FS00 (OPG10) FLUSH - DAC TRSE (OPG11) OUTPUT TRACE COUPLING - DAC PRSP SET BUFFER TO SPACES -* -*..............MISC. GROUP - DAC AD3 ADD TWO 3 WORD INTEGERS - DAC IM00 MULTIPLY (A) BY (B) - DAC STXA SET A INTO INDEX - DAC STXI SET I INTO INDEX - DAC NF00 SET FS INTO NAMF - DAC BLNK SET AREA TO ZEROS - DAC MOV3 MOVE 3 WORDS TO TEMP STORAGE - DAC CIB COMPARE IBUF TO A CONSTANT - DAC SAV SAVE INDEX IN PUSH-DOWN STACK - DAC RST RESET INDEX FROM PUSH-DOWN STACK - DAC PACK - DAC ER00 ERROR OUTPUT - DAC SRT SHIFT RIGHT 1 (TRIPLE PRES.) - DAC SFT SHIFT LEFT 1 (TRIPLE PRES.) - DAC LIST -* -* -* **************************** -* *CONSTANT AND VARIABLE POOL* -* **************************** -* -XR EQU 0 INDEX REGISTER -* THE FOLLOWING 62 VARIABLES ARE SET TO ZERO DURING -* PROGRAM INITIALIZATION -A EQU '40 ASSIGNMENT TABLE INDEX -I EQU A+1 EXPRESSION TABLE INDEX -C EQU A+2 -ASAV EQU A+3 -L EQU A+4 -MFL EQU A+5 MODE FLAG -SFF EQU A+6 FUNCTION FLAG -SBF EQU A+7 SUBFUNCTION FLAG -SXF EQU A+8 POSSIBLE CPX FLAG -SPF EQU A+9 PEC. FLAG -TCF EQU A+10 TEMP STORE COUNT -IFF EQU A+11 -ABAR EQU A+12 BASE OF ASSIGN TABLE -XST EQU A+13 FIRST EXECUTABLE STMNT. -CFL EQU A+14 MON FLAG -D EQU A+15 DO INDEX -RPL EQU A+16 RELATE PROGRAM LOCATION -BDF EQU A+17 LOCK DATA FLAG -SLST EQU A+18 SOURCE LIST -OBLS EQU A+19 OUTPUT BINARY LIST -BNOT EQU A+20 BINART OUTPUT FLAG -TRF EQU A+21 TRACE FLAG (END TRACE STATEMENT NO.) -TRFA EQU A+22 POINTER TO FIRST VAR, 0R ARRAY NAME IN -* AN EXPRESSION (FOR USE BY TRACE). -SOF EQU A+23 SUBSCRIPT CONSTANT FLAG (NON-ZERO IF SET) -LIF EQU A+24 LOGICAL IF FLAG -LSTN EQU A+25 LAST STATEMENT NO. -LSTF EQU A+26 LAST STATEMENT FLAG -LSTP EQU A+27 LAST STATEMENT STOP -SDSW EQU A+28 STATEMENT I0 SWITCH -* -NAMF EQU '570 NAME FUNCTION -ND EQU NAMF+1 NO OF DIMENSIONS -NS EQU '572 NO OF SUBSCRIPTS -NT EQU NS+1 NAME TAG -NTF EQU NS+2 NAME TAG FLAG -NTID EQU NS+3 NO. WORDS IN TID -O1 EQU NS+4 OPERATOR 1 -O2 EQU NS+5 OPERATOR 2 -P EQU NS+6 -PCNT EQU NS+7 -OCNT EQU NS+8 OUTPUT COUNT -S0 EQU NS+9 -S1 EQU NS+10 SUBSCRIPT NO.1 -S2 EQU NS+11 SUBSCRIPT NO.2 -S3 EQU NS+12 SUBSCRIPT NO.3 -TC EQU NS+13 TERMINAL CHAR -TT EQU NS+14 -TYPE EQU NS+15 -X EQU NS+16 ARRAY INDICES -X1 EQU NS+17 -X2 EQU NS+18 -X3 EQU NS+19 -X4 EQU NS+20 -NTA EQU NS+21 UNPACKED ASSIGNMENT ITEMS -ATA EQU NS+22 -IMA EQU NS+23 -CLA EQU NS+24 -IUA EQU NS+25 -DTA EQU NS+26 -TTA EQU NS+27 -*..........ADJUST THIS ORG IF THE SIZE OF THE CONSTAST POOL IS MODIFIED - ORG '630 -AF PZE 0 ADDRESS FIELD -GF EQU AF -AT PZE 0 ADDRESS TYPE -CODE PZE 0 OUTPUT CODE -D0 PZE 0 DIMENSIONS -D1 PZE 0 -D2 PZE 0 -D3 PZE 0 -D4 PZE 0 -DF PZE 0 DATA FLAG -NF PZE 0 -B PZE 0 -DFL PZE 0 DELIMITER FLAG -E OCT 0 EQUIVALENCE INDEX -EP PZE 0 E-PRIME -E0 PZE 0 E-ZERO -FTOP PZE 0 OUTPUT COMMAND -GFA PZE 0 -ICSW PZE 1 INPUT CONTROL SWITCH -IFLG PZE 0 I-FLAG -IM PZE 0 ITEM MODE -IOF PZE 0 I-0 FLAG -IU PZE 0 ITEM USAGE -KBAR PZE 0 TEM STORE -KPRM PZE 0 TEM STORE -EBAR OCT -1 E-BAR -DO OCT 17 DO TABLE INDEX(FLOATS ABOVE ASSIGNMENT) -CC PZE '111 CARD COLUMN COUNTER -DCT PZE 0 DUMMY ARGUMENT COUNT -F PZE 0 TRIAD TABLE INDEX -CL PZE 0 ASSIGNMENT ITEMS UNPACKED -DT PZE 0 -FLT1 PZE 0 FETCH LINK CL POINTER LOCATION -LIBF PZE 0 SPECIAL LIBRARY FLAG (NON-ZERO IF SET) -*..........CONSTANTS USED BY THE COMPILER -K4 OCT 251 0) -K5 OCT 254 0, -K8 OCT 240 0-SPACE -K9 OCT 257 0/ -K10 OCT 256 0. -K12 OCT 255 0- -K13 OCT 253 0+ -K15 OCT 244 0$ -K16X OCT 16 -K17 OCT 250 0( -K18 OCT 275 0= -K19 BCI 1,DO DO -K34 OCT 324 0T -K35 OCT 317 0O -K40 BCI 1,WN -K41 BCI 1,RN RN -K42 BCI 1,CB -K43 OCT 311 0I -K44 OCT 321 0Q -K45 EQU K34 0T -K57 OCT 252 0* -K60 OCT 260 00 (BCI ZERO) -K61 OCT 271 09 -K68 EQU K19 -K101 OCT 1 -K102 OCT 2 -K103 OCT 3 -K104 OCT 4 -K105 OCT 5 -K106 OCT 6 -K107 OCT 7 -K109 DEC 16 -K100 OCT 377 -K111 OCT 37777 -K110 DEC -17 -K115 OCT 170777 -K116 OCT 177400 -K117 DEC -27 -K118 OCT 777 -K119 OCT 177000 -K120 DEC -15 -K122 OCT 040000 -K123 DEC -1 -K124 DEC 9 -K125 DEC 8 -K126 DEC 10 -K127 DEC 11 -K128 DEC 12 -K129 DEC 13 -K131 DEC -14 -K132 OCT 22 -K134 OCT 17 -K137 OCT 24002 -K138 OCT 25 -K139 OCT 24 -CRET OCT 215 0 C/R -ZERO OCT 0 -HBIT OCT 140000 HIGH BITS FOR ALPHA DATA -KAEQ BCI 1,EQ EQUIVALENCE ERROR MESSAGE ATTACHMENT -MIN2 DEC -2 -2 -HC2 OCT 340 -K357 OCT 357 -* -* -DP EQU '15400 DUMMY START OF DATA POOL (ACTUALLY SET -* BY THE FORTRAN IOS SUBROUTINE.) -L0 EQU '113 DUMMY END OF DATA POOL (MINUS 3 WORDS) -* THE FOLLOWING INSTRUCTIONS CAUSE THE LOADER -* TO ASSIGN ALL REFERENCES TO THE DATA POOL IN WORDS -* 100 TO 112 OF THE ZERO SECTOR, FORTRAN IOS WILL -* CAUSE THESE CELLS TO BE SET TO THE ACTUAL DATA POOL -* LOCATIONS WHICH WILL BE DETERMINED BY COMPUTER -* CONFIGURATION. - ORG '1000 - PZE DP-4,1 (100) - PZE DP-3,1 (101) DATA POOL REFERENCES - PZE DP-2,1 (102) - PZE DP-1,1 (103) - PZE DP,1 (104) - PZE DP+1,1 (105) - PZE DP+2,1 (106) - PZE DP+3,1 (107) - PZE DP+4,1 (108) - PZE DP+9,1 (111) - PZE DP+6,1 (112) - PZE DP+7 (113) NO WDS IN DATA POOL SET BY IOS -* -* - ORG 1 - JST ER00 THIS INSTRUCTION REACHED ONLY IF THE - BCI 1,CG COMPILER JUMPED TO ZERO BY MISTAKE. -* -* -* -* -* ******************* -* *START OF COMPILER* -* ******************* -* - ORG '1000 -* -* -* -* - A0 COMP ENT EMPTY BUFFERS - LRL 15 - STA LIBF SET SPECIAL LIBRARY FLAG - LLL 15 (BIT 1 ON INHIBITS CERTAIN ERROR CHECKS) -A0 CALL F4$INT INITIALIZE I/O DEVICES - LDA K108 - STA CC CC = 73 - JST IC00 INPUT COLUMN -A051 LDA A090 - STA XR - LDA A092 LOC, OF INDEX PUSH-DOWN BUFFER - STA SAV9 INITIALIZE PUSH-DOWN BUFR, - CRA - STA A+M,1 SET M VARIABLES TO ZERO - STA NAMF+M,1 - IRS XR - JMP *-3 - STA IFLG - STA PKF - JST FS00 INITIALIZE OUTPUT BUFFER - CMA - STA LSTF LSTF NOT EQ 0 - STA LSTP LSTP NOT EQ 0 - STA EBAR EBAR SET NEGATIVE - LDA L0 - STA ICSW - STA E0 INITIALIZE EQUIVALENCE TABLE - STA L INITIALIZE TRIAD TABLE POINTER - JST PRSP SET PRINT BUFFER TO SPACES - LDA K134 - STA DO INITIALIZE DO TABLE POINTER - SUB K138 - STA A091 - CRA - STA ID -A055 IRS ID ESTABLISH CONSTANTS - JST AI00 - IRS A091 - JMP A055 - LDA K81 - STA ID - STA ID+1 - STA ID+2 - CRA - LRL 32 (B)=0 IM=NO USAGE - LDA K101 (A)=1 IU=SUBR - JST AA00 ASSIGN (SPECIAL) - JST STXA SET POINTER A INTO INDEX AND (A) - STA CFL CFL=A (LOCATION OF FIRST COMMON BLOCK) - ADD K122 ='40000 (IU=SUBR) - STA DP+1,1 GF(A)=A (IN CASE NO BLANK COMMON IS SPECIFI - JMP C7 GO TO STMNT INPUT -M EQU 30 -A090 DAC* -M,1 -A091 PZE 0 -A092 DAC SAVX START OF INDEX PUSH-DOWN BUFFER -* -* -* -* ************** -* *INPUT COLUMN* -* ************** -* -* INPUT NEXT CHARACTER -* IGNORE BLANKS -* CHECK FOR COMMENTS -* IC02 SET AS FOLLOWS - -* NORMAL - ICIP -* INITIAL SCAN -ICSR -IC00 DAC ** LINK STORE - JST SAV SAVE INDEX - LDA CC IF CC = 73, GO TO IC 10 - SUB K108 - SZE - JMP IC19 ELSE, GO TO IC -IC10 LDA ICSW IF ICSW. GO TO IC12 - SNZ - JMP IC24 ELSE, GO TO IC24 -IC12 CALL F4$IN INPUT SYMBOLIC CARD IMAGE - DAC CI - LDA CI - LGR 8 GO 70 IC 14 - CAS K16 =(C) - JMP *+2 - JMP IC30 COMMENT CARD (IGNORE) - SUB K15 =($) - SNZ - JMP IC18 CONTROL CARD (IGNORE COLUMN 6) - LDA K357 IF CARD COL, SIX IS - ANA CI+2 ZERO OR BLANK, GO TO IC18 - SUB K8 - SZE - JMP IC26 ELSE, GO TO IC26 -IC18 STA CC CC = 0. - LDA CI+2 CI(6) = SPECIAL - ANA K116 - ADD HC2 ='340 - STA CI+2 - LDA CRET - JMP IC20 TC = C.R. -IC19 LDA CC TC = CI(CC) - SUB K101 - LGR 1 - STA XR - LDA CI,1 - SSC - LGR 8 - ANA K100 -IC20 STA TC - IRS CC CC = CC+1 -IC22 JST RST RESTORE INDEX - JMP* IC00 RETURN -IC24 LDA K9 TC = /, END OF LINE - STATEMENT SCAN - STA TC - JMP IC22 GO TO IC22 -IC26 JST LIST LIST, CONTINUATION CARD - LDA K107 CC = 7. IGNORE STATEMENT NO. - STA CC - JMP IC19 G0 TO IC19 -IC30 JST LIST PRINT CARD IMAGE - JMP IC12 READ IN NEW CARD -K16 OCT 303 0C -K108 DEC 73 -KASP BCI 1, (SP)(SP) MUST PRECEDE CARD IMAGE BUFFER -CI BSS 40 - BCI 20, -* -* -* -* **************** -* *UNINPUT COLUMN* -* **************** -* BACK UP ONE COLUMN -* -UC00 DAC ** - IMA CC CC= CC-1 - SUB K101 RETAIN (A) - IMA CC - JMP* UC00 -* -* -* ***************** -* *INPUT CHARACTER* -* ***************** -* INPUT ONE CHARACTER FROM EITHER -* 1, INPUT BUFFER (EBAR POSITIVE) OR -* 2, EQUIVALENCE BUFFER (EBAR NEGATIVE) -* -CH00 DAC ** - LDA EBAR IF EBAR 7 0, - SMI - JMP CH10 G0 10 CH10 -CH03 JST IC00 INPUT COLUMN - SUB K8 IF BLANK, REPEAT - SNZ - JMP CH03 - LDA TC ELSE, -* -CH04 CAS CH13 ='301 - NOP - JMP CH06 - CAS K61 ='271 - JMP CH05 - NOP - CAS K15 ='244 - JMP *+2 - JMP CH05-1 - CAS K60 ='260 - NOP - CRA ALPHA NUMERIC CHARACTER -CH05 STA DFL DELIMITER ENTRY - LDA TC EXIT WITH TC IN A - JMP* CH00 -CH06 CAS K63 ='332 - JMP CH05 - NOP - JMP CH05-1 -CH08 STA DFL - JMP* CH00 -CH10 LDA E IF E = EBAR - CAS EBAR - JMP *+2 - JMP CH12 GO TO CH12 - STA 0 SET E INTO INDEX - LLL 16 SET (B) TO ZERO - LDA DP,1 CURRENT CHARACTER WORD - LLR 8 - STA DP,1 SAVE REMAINING CHARACTER IF ANY - IAB - STA TC TC=LEFTMOST CHARACTER - SZE SKIP IF NEW CHARACTER WORD NEEDED - JMP CH04 - LDA E E=E-1 - SUB K101 =1 - STA E - JMP CH10 PICK UP NEXT CHARACTER WORD -CH12 SSM MAKE E MINUS - STA EBAR - JMP C4 GO TO ASSIGN SPEC -K63 OCT 332 0Z -CH13 OCT 301 -* -* -* ************* -* *INPUT DIGIT* -* ************* -* A IS ZERO IF NOT DIGIT -* -ID00 DAC ** INPUT DIGIT - JST CH00 INPUT A CHAR - CAS K61 ='271 (9) - JMP* ID00 (A) = TC - JMP ID10 ELSE, (A) = 0 - CAS K60 RETURN - NOP - JMP *+2 - JMP* ID00 -ID10 CRA - JMP* ID00 -* -* -* ********************** -* *INPUT (A) CHARACTERS* -* ********************** -* CHAR COUNT IN XR, TERMINATES WITH EITHER -* 1, CHAR COUNT -1 = ZERO OR -* 2, LAST CHAR IS A DELIMITER -* -IA00 DAC ** - TCA SET COUNTER - STA IA99 - JST IA50 EXCHANGE IBUF AND ID - CRA - STA NTID NTID = 0 -IA10 JST CH00 INPUT A CHARACTER - JST PACK - LDA DFL IF DFL NOT ZERO, - SZE CONTINUE - JMP IA20 ELSE, - IRS IA99 TEST COUNTER - JMP IA10 MORE CHARACTERS TO INPUT -IA20 JST IA50 EXCHANGE ID AND IBUF - JMP* IA00 RETURN -IA50 DAC ** EXCHANGE IBUF AND ID - JST SAV SAVE INDEX - LDA IA90 - STA XR - LDA IBUF+3,1 - IMA ID+3,1 - STA IBUF+3,1 - IRS XR - JMP *-4 - JST RST RESTORE INDEX - LDA NTID - JMP* IA50 -IA90 OCT -3 -IA99 PZE 0 -* -* -* ***************** -* *FINISH OPERATOR* -* ***************** -* WRAP UP LOGICAL/RELATIONAL OPERATORS -* -FN00 DAC ** - LDA DFL IF DFL NOT . , - STA IBUF - SUB K10 - SZE - JMP FN05 GO TO FN05 - LDA K104 - JST IA00 -FN05 LDA K110 USE TABLE TO CONVERT - STA XR OPERATOR -FN10 LDA FN90+17,1 - CAS IBUF - JMP *+2 - JMP FN20 - IRS XR - JMP FN10 - LDA TC - JMP* FN00 -FN20 LDA FN91+17,1 FOUND A LOGICAL OPERATOR - STA TC SET INTO TC - JMP* FN00 -FN90 OCT 253,255,252,257 +-*/ - BCI 9,NOANORLTLEEQGEGTNE - OCT 275,254 =, -FN91 OCT 1,2,3,4,5,6,7,10,11,12,13,14,15,16,17 -* -* -* *********** -* *INPUT DNA* -* *********** -* BASIC INPUT ROUTINE, HANDLES FOLLOWING - -* CONSTANT CONVERSION -* MODE TYPING (CONSTANTS, IMPLIED/VARIABLES) -* ALL OPERATORS (TERMINATE ITEM) -* -ID BSS 4 -TID EQU ID TEMP STORE FOR ID -IBUF BSS 3 3-WORD BUF -TIDN PZE 0 -K155 OCT 177727 -41 -K156 OCT 024000 1085 -K157 OCT 007777 -K158 OCT 074000 -F1 PZE 0 SIGN FLAG -F2 PZE 0 -F3 PZE 0 INPUT EXPONENT -F4 PZE 0 NO, FRAC. POSITIONS -F5 PZE 0 TEMP DELIMITER STORE -F6 PZE 0 -L4 PZE 0 -HOLF PZE 0 HOLLERITH FLAG -DN00 DAC ** -DN01 CRA - STA HOLF SET HOLF =0 - STA F4 F4 = 0 - STA IU - STA NT IU=NT=NTID=0 - STA NTID - JST BLNK CLEAR OUT TID = ID - DAC TID - JST BLNK - DAC F1 F1,F2,F3 = 0 -DN06 CRA - STA IM - STA DNX2 -DN07 JST ID00 INPUT DIGIT - SZE - JMP DN14 (A) NON-ZERO, G0 T0 DN14 -DN10 LDA TID+2 CHECK FOR OVERFLOW AND ADJUST - ANA K158 POSITION COUNT IF NECESSARY, - SZE - JMP SKIP - ADD IM - ARS 1 - ADD F4 F4 = F4+1 IF NO OVERFLOW - STA F4 AND IM ALREADY SET TO REAL - LDA K101 - STA NT NT=1 - ADD K101 - STA IU IU = VAR/COD - JST SFT SHIFT ID LEFT - DAC ID - JST MOV3 MOVE TO TEMP STORE - JST SFT - DAC ID - JST SFT - DAC ID - JST AD3 ID = 10*ID+TC - JST BLNK - DAC DNX1 - LDA TC - SUB K60 - STA DNX1 - JST AD3 - JMP DN07 -SKIP LDA MIN2 - ADD IM - ARS 1 - ADD F4 - STA F4 - JMP DN07 -DN14 LDA IM IM = REAL - SUB K102 - SZE - JMP DN50 NO, GO TO DN50 -DN16 LDA K10 YES, -DN17 STA F5 F5 = '.' - LDA DFL IF DFL =0, GO SO DN20 (5) - SZE - JMP DN90 ELSE GO TO DN90 (9) -DN20 LDA TC IF TC = D, GO TO DN26 - SUB K11 - SNZ - JMP DN26 - SUB K101 ELSE, IF TC = E, GO TO DN22 - SNZ - JMP DN22 TERMINATOR = E - JST UC00 - LDA K10 ='256 (,) - STA DFL SET DELIMITER FLAG - LDA K101 =1 - STA IM SET ITEM MODE TO INTEGER - JMP DN67 FINISH OPERATOR AND EXIT -* -DN22 JST ID00 INPUT DIGIT - SNZ IF (A) = 0, GO TO DN30 - JMP DN30 - LDA TC IF TC = -, GO TO DN28 - SUB K12 - SNZ - JMP DN28 - ADD K102 - SNZ - JMP DN29 - LDA F5 - STA DFL - JST UC00 UN-INPUT COL -DN24 JST FN00 FINISH OPERATOR -DN25 LDA K101 IM = INT - STA IM - LDA ID+1 IF ID IS TOO BIG TO - SZE BE AN INTEGER (>L2), - JMP DN69 GO TO DN69 (20) - LDA ID+2 - SZE - JMP DN69 - JMP DN84 OTHERWISE, GO TO DN84(12) -DN26 LDA K106 IM = DBL - STA IM - JMP DN22 -DN28 LDA K101 F2 = 1 - STA F2 -DN29 JST ID00 INPUT DIGIT - SZE IF (A) = 0, GO TO DN30 (8.5) - JMP DN69 ELSE, GO TO DN69 (20) -DN30 LDA F3 F3 = 10 * F3 - ALS 3 - IMA F3 F3 = F3 +TC - ALS 1 - ADD F3 - ADD TC INPUT DIGIT - SUB K60 - STA F3 IF (A) = 0, GO TO DN30 (8.5) - JST ID00 ELSE, GO TO DN90 (9) - SZE - JMP DN90 - JMP DN30 -DN50 LDA K102 IM=REA - STA IM - LDA TC IF TC = ., GO TO DN54 - SUB K10 - SNZ - JMP DN54 ELSE, - LDA NT - SNZ IF NT = 0, GO TO DN72 - JMP DN72 - LDA TC IF TC = H, GO TO DN9H (22) - SUB K14 - SNZ - JMP DN9H - LDA DFL IF DFL = 0, - SZE GO TO DN16 (4.9) - JMP DN25 ELSE, GO TO DN25 - JMP DN16 -DN54 JST ID00 INPUT DIGIT - SNZ - JMP DN10 IF (A) = 0, GO TO DN10 (3) - LDA NT - SNZ IF NT = 0, GO TO DN56 - JMP DN56 - LDA TC F5 = TC - JMP DN16 GO TO DN16 (4) -DN56 CRA - STA TC TC = ) -DN58 JST UC00 UN-INPUT A COLUMN, - LDA F1 IF F1 = 0, GO TO DN60 - SZE - JMP DN63 ELSE, GO TO DN63 (15) -DN60 LDA K106 - JST IA00 INPUT (6) CHARS - JST CIB IF IBUF = TRUE., - DAC K1+3,1 - JMP DN64 - JST CIB IF IBUF = FALSE., - DAC K2+3,1 GO TO DN66 (16) - JMP DN66 - JST CIB CHECK FOR .NOT. OPERATOR - DAC KNOT+3,1 CHECK FOR .NOT. OPERATOR - JMP DN9N OPERATOR IS .NOT. -DN63 CRA IM = 0 - STA IM - JMP DN67 GO TO DN67 (18) -DN64 LDA K101 - STA TID -DN66 LDA K101 - STA NT NAME TAG = 1 (CONSTANT) - LDA K102 IU=VAR - STA IU - LDA K103 - STA IM IM = LOG - JST CH00 -DN67 JST FN00 FINISH OPERATOR -DN68 LDA F6 IF F6 = 0, - SNZ GO TO DN70 (21) - JMP DN70 -DN69 LDA K10 - STA TC TC = . -DN70 CRA - STA F6 F6 = SXF = 0 - STA SXF - LDA IM (A) = IM - JMP* DN00 RETURN -DN72 LDA F1 IF F1 = 0, GO TO DN74 - SNZ - JMP DN74 - LDA F1 ELSE, TC = F1 - STA TC - JMP DN58 GO TO DN58 (14) -DN74 LDA TC IF TC = -, GO TO DN82 - SUB K12 - SNZ - JMP DN82 - ADD K102 CHECK FOR TC = + - SNZ - JMP DN82 - LDA DFL IF DFL = NON-ZERO - SZE - JMP DN63 GO TO DN63 (15) - LDA TC - CAS K43 - JMP *+3 - JMP DN78 - JMP DN80 - CAS K62 - JMP DN80 - NOP -DN78 LDA K101 IM < INT - STA IM -DN80 LDA TC PACK TC TO ID - JST PACK - JST CH00 INPUT CHAR - LDA DFL IF DFL IS NOT ZERO, - SZE GO TO DN67 (18) - JMP DN67 - LDA NTID IF NTID = 6, GO TO DN67 - SUB K106 - SZE - JMP DN80 - JMP DN67 -DN82 JST FN00 - STA F1 F1 = CONVERTED TC - JMP DN06 GO TO DN06 (2) -DN84 LDA F1 IF F1 = -, - SUB K102 GO TO DN85(13) - SZE - JMP DN85 - CRA - SUB TID COMPLEMENT THREE WORDS AT TID - SZE - JMP DN8A - SUB TID+1 - SZE - JMP DN8B - JMP DN8C -DN8A STA TID - LDA K123 - SUB TID+1 -DN8B STA TID+1 - LDA K123 -DN8C SUB TID+2 - STA TID+2 -DN85 LDA SXF IF SXF = 0, GO T0 DN67 (18) - SNZ - JMP DN67 ELSE, - LDA IM IF IM NOT = REA, - SUB K102 - SZE GO TO DN67 (18) - JMP DN67 - LDA F6 ELSE, - SNZ IF F6 = 0, GO TO DN87 - JMP DN87 - LDA K105 - STA IM IM = CPX - LDA TID INTERCHANGE - IMA TIDB 3 CELLS - STA TID TID - LDA TID+1 WITH - IMA TIDB+1 3 CELLS - STA TID+1 OF - LDA TID+2 TIDB - IMA TIDB+2 - STA TID+2 - JST IP00 )-INPUT OPERATOR - JMP DN70 GO TO DN70 (21) -DN87 LDA TC IF TC = , - SUB K5 - SZE - JMP DN67 TID-BAR = TID - LDA TID F6 = 1 - STA TIDB GO TO DN01 (1) - LDA TID+1 - STA TIDB+1 ELSE, GO TO DN67 (18) - LDA TID+2 - STA TIDB+2 - LDA K101 - STA F6 - JMP DN01 -DN90 LDA F2 IF F2= 0, GO TO DN9A (10) - SNZ - JMP DN9A - LDA F3 F3 = - F3 - TCA - STA F3 -DN9A LDA F3 F4 = F3 - F4 - SUB F4 - STA F4 - LDA K12 F2 = EXP, BIAS + MANTISSA - STA F2 - LDA TID IF TID = 0, - ADD TID+1 - ADD TID+2 GO TO DN85(13) - SNZ - JMP DN85 -DN9C LDA TID+2 - LGL 1 NORMALIZE ID - SPL - JMP DN9D ID IS NORMALIZED - JST SFT - DAC ID -* F2 = F2 - = SHIFTS - LDA F2 - SUB K101 - STA F2 - JMP DN9C CONTINUE NORMALIZE LOOP -DN9D LDA F4 - CAS ZERO - JMP DN9E - JMP DN9G FINISHED E FACTOR LOOP - IRS F4 - NOP F4 = F4 +1 - LDA K155 DIVIDE LOOP COUNTER - STA TIDN - JST SRT - DAC TID - JST SRT - DAC TID -DND1 JST SFT - DAC TID - LDA TID+2 - SUB K156 10 AT B=4 - SMI - STA TID+2 - SMI - IRS TID - IRS TIDN - JMP DND1 REDUCE DIVIDE COUNTER - JST SFT - DAC TID - LDA TID+2 - ANA K157 - STA TID+2 - JMP DN9C -DN9E SUB K101 - STA F4 F4 = F4-1 - LDA F2 F2 = F2+4 - ADD K104 - STA F2 - JST SRT - DAC ID - JST MOV3 - JST SRT ID = ID*10 - DAC ID - JST SRT - DAC ID - JST AD3 ADD THREE WORD INTEGERS - JMP DN9C -* CONVERT THREE WORD INTEGER TO INTERNAL FORMAT -DN9G LDA TID+2 - IAB - LDA F2 - LRS 8 - SNZ - JMP *+3 - JST ER00 - BCI 1,CE CONSTANT'S EXPONENT OVER 8 BITS (OVERFLOW) - IAB - IMA TID+2 - IAB - LDA TID+1 - LGL 1 - LRR 8 - STA TID+1 - LRR 9 - LDA TID PACK UP TRIPLE PRECISION - LGL 1 - LRR 7 REAL CONSTANT - STA TID - LDA F2 - LGR 8 - SZE - JMP DN69 GO TO DN69 (20) - JMP DN84 ELSE. GO TO DN84 (12) -DN9H STA IM - LDA SPF - SUB K102 - SZE - LDA K106 - SUB K124 - ADD TID - SMI - JMP DN70 - LDA TID - STA HOLF HOLF=NO.OF HOLLERITH CHARS, - STA F3 - TCA - SNZ - JMP DN9K FIELD WIDTH OF ZERO - STA F2 F2= -1(1 CHAR) OR -2(2 CHAR) - JST BLNK SET ID,ID+1(ID+2 TO ZERO - DAC TID -DN9J JST IC00 INPUT COLUMN (INCLUDING BLANKS) - JST PACK PACK CHARACTERS 2 PER WORD - IRS F2 REDUCE CHARACTER COUNT - JMP DN9J INPUT AND PACK MORE CHARACTERS - LDA F3 F3= 0 IF 2 CHAR. HAVE BEEN INPUT - ANA K101 - SNZ - JMP *+3 - LDA K8 ='240 (SP) - JST PACK SHIFT A SPACE INTO THE LAST WORD - IRS IM -DN9M JST CH00 INPUT THE TERMINATING CHARACTER - JMP DN67 FINISH OPERATOR AND EXIT -DN9K JST ER00 - BCI 1,HF -DN9N LDA K105 SET .NOT. OPERATOR (TC=5) - STA TC SET .NOT. OPERATOR (TC=5) - CRA - STA IM IM=0 = UNDEFINED - JMP DN68 -DNX1 BSS 3 -DNX2 DAC ** OVERFLOW FLAG - JMP* *-1 -* -* -* ************ -* *INPUT ITEM* -* ************ -* INPUTS AND ASSIGNS ITEM (IF ONE EXISTS) -* -II00 DAC ** - JST DN00 INPUT DNA - SNZ IF (A) = 0 - JMP* II00 RETURN - JST AS00 NO, ASSIGN ITEM - LDA IM - JMP* II00 RETURN (A) = IM -* -* -* *************** -* *INPUT OPERAND* -* *************** -* EXIT WITH ITEM MODE IN A (TC SET TO . IF NO -* OPERAND) -* -OP00 DAC ** INPUT OPERAND - JST II00 INPUT ITEM - SZE IF IM = 0, SKIP - JMP* OP00 ELSE (A) = IM, RETURN - LDA K10 TC = . - STA TC (A) = 0 - CRA - JMP* OP00 RETURN -* -* -* ************ -* *INPUT NAME* -* ************ -* INPUT OPERAND AND ENSURE THAT IT IS A NAME -* -NA00 DAC ** INPUT NAME - JST OP00 INPUT OPERAND - LDA NT IF NT = 1, - SNZ - JMP NA10 - JST ER00 - PZE 9 -NA10 LDA IM (A) = IM - JMP* NA00 RETURN -* -* -* *************** -* *INPUT INTEGER* -* *************** -* INPUT ITEM AND ENSURE THAT IT IS AN INTEGER CONSTANT -* GREATER THAN ZERO -* -IG00 DAC ** INPUT INTEGER - JST DN00 INPUT - DNA - LDA F1 - SZE IF F1 = 0, - JMP IG20 AND NT = 1, - LDA NT AND IM = INT, - SNZ AND TID L2**15, - JMP IG20 GO TO IG10 - LDA IM LSE, GO TO IG20 - SUB K101 - SZE - JMP IG20 - LDA TID+1 - SZE - JMP IG20 - LDA TID+2 - SZE - JMP IG20 -IG10 LDA TID - JMP* IG00 -IG20 JST ER00 ERROR - BCI 1,IN INTEGER REQUIRED -* -* -* *********************** -* *INPUT INTEGER VAR/CON* -* *********************** -* -IV00 DAC ** - JST OP00 INPUT OPERAND - JST IT00 INTER TEST - JST TV00 TAG VARIABLE - JMP* IV00 EXIT -* -* -* ************************ -* *INPUT INTEGER VARIABLE* -* ************************ -* -IR00 DAC ** INPUT INT VAR - JST IV00 INPUT INT VAR/CON - JST NC00 NON-CONSTANT TEST - JMP* IR00 RETURN -* -* -* ************************ -* *INPUT STATEMENT NUMBER* -* ************************ -* NUMBER IS FORMED AS SPECIAL NAME , NOT CONVERTED -* TO NUMERIC -* -IS00 DAC ** -IS04 CRA - STA NT - STA IM - STA IU IU = IM = IT = 0 - STA NTID PUT LEADING 'S' IN STATEMENT NO, - LDA K79 - JST PACK -IS10 JST ID00 INPUT DIGIT - SZE - JMP IS20 NOT A DIGIT GO TO IS20 - LDA NTID - SUB K106 - SMI - JMP IS22 - LDA TC - JST PACK PACK TC TO ID - LEGAL ST, NO, CHAR - LDA TID - CAS K79X - JMP IS10 - JMP IS04 IGNORE LEAD ZERO ON ST. NO, - JMP IS10 -IS20 LDA NTID - SUB K101 - SMI - JMP IS25 -IS22 JST ER00 - BCI 1,ST ILLEGAL STATEMENT NUMBER FORMAT -IS25 JST AS00 ASSIGN ITEM - JST STXA - LDA DP+1,1 - ANA K111 - STA DP+1,1 IU = 0 - LDA AF ADDRESS FIELD IS - CAS XST LE XST - ALREADY ASSIGNED - JMP* IS00 - JMP* IS00 OK - OTHERWISE - LDA AT MUST HAVE STR-ABS OTHERWISE - CAS K102 - JMP *+2 - JMP* IS00 !!! - JST ER00 - BCI 1,RN REFERENCE TO A SPECIFICATION STMNT NUMBER -K79 OCT 337 -K79X OCT 157660 -* -SY00 DAC ** INPUT SYMBOL - LDA K101 - STA NTF NTF NOT 0 - DON'T SET IU IN AS00 - JST NA00 INPUT NAME - JMP* SY00 EXIT -* -* ************************ -* *EXAMINE NEXT CHARACTER* -* ************************ -* CHECK NEXT CHAR FOR DIGIT (BACKUP ONE COL, THEN EXIT) -* -XN00 DAC ** - JST ID00 INPUT DIGIT - JST UC00 UNINPUT COLUMM - JMP* XN00 -K1 BCI 3,TRUE. -K2 BCI 3,FALSE. -K3 OCT 247 -KNOT BCI 3,NOT. CONSTANT FOR .NOT. TEST -K11 OCT 304 0D -K14 OCT 310 0H -K62 OCT 316 0N -K64 OCT 336 0) -* -* -* ******************** -* *ALL CHARACTER TEST* -* ******************** -* -TS00 DAC ** TEST (A) AGAINST TC - SUB TC - SNZ - JMP* TS00 RETURN - JST ER00 TO ERROR TEST - BCI 1,CH IMPROPER TERMINATING CHARACTER -* -* -* ******************* -* *)- INPUT OPERATOR* -* ******************* -* -IP00 DAC ** - LDA K4 TEST - ) - JST TS00 - JST CH00 INPUT CHAR - JST FN00 FINISH OPERATOR - LDA B B = B-16 - SUB K109 - STA B - CRA (A) = 0 - JMP* IP00 RETURN -* -* -* -* B1 COMMA OR C/R TST -B1 LDA K134 IF TC = ','(CONVERTED TO 17) - SUB TC - SNZ - JMP* A9T2 GO TO SIDSW - JMP A1 ELSE, GO TO C/R TEST -* -* -NR00 DAC ** NON-REL TEST - LDA AT - SUB K101 IF AT = 1 GO TO ERROR- - SZE TEST - JMP* NR00 RETURN - JST ER00 ERROR TEST ROUTINE - BCI 1,MS MULTIPLY DEFINED STATEMENT NUMBER -* -* -* *************** -* *NO USAGE TEST* -* *************** -* -NU00 DAC ** N0 USAGE TEST - LDA IU - SNZ IF IU NOT = 0, TO ERROR - JMP* NU00 RETURN - JST ER00 ERROR TEST - BCI 1,NU NAME ALREADY BEING USED -* -* -* ******************* -* *NON-CONSTANT TEST* -* ******************* -* -NC00 DAC ** NON CONSTANT TEST - LDA NT - SNZ IF NT NOT = 0, TO ERROR TEST - JMP* NC00 RETURN - JST ER00 ERROR TEST - BCI 1,NC CONSTANT MUST BE PRESENT -* -* -* ********************* -* *NON SUBPROGRAM TEST* -* ********************* -* -NS00 DAC ** NON SUBPROGRAM TEST - LDA IU - SUB K101 IF IU = 1, GO TO- - SZE ERROR TEST - JMP* NS00 RETURN - JST ER00 ERROR TEST - BCI 1,NS SUBPROGRAM NAME NOT ALLOWED -* -* -* ********** -* *ARR TEST* -* ********** -* -AT00 DAC ** ARRAY TEST - LDA IU - SUB K103 IF IU = 3, GO TO - SNZ - JMP* AT00 RETURN - JST ER00 ERROR TEST - BCI 1,AR ITEM NOT AN ARRAY NAME -* -* -* ************** -* *INTEGER TEST* -* ************** -* -IT00 DAC ** INTEGER TEST - LDA IM - SUB K101 IF IM = 1, GO TO- - SNZ ERROR ROUTINE, ELSE - JMP* IT00 RETURN - JST ER00 TO ERROR TEST - BCI 1,IT ITEM NOT AN INTEGER -* -* -TA00 DAC ** - LDA AT STRING-ABS TEST - SUB K102 - SNZ - JMP* TA00 - JST ER00 - BCI 1,NR ITEM NOT A RELATIVE VARIABLE -* -* -* -* -* -* -* -* -AD3 DAC ** ADD TWO THREE WORD INTEGERS, - LDA TID - ADD DNX1 - CSA - STA TID - LDA TID+1 - ACA - ADD DNX1+1 - CSA - STA TID+1 - LDA TID+2 - ACA - ADD DNX1+2 - STA TID+2 - JMP* AD3 -* -* -* *********************** -* *ASSIGN INDEX REGISTER* -* *********************** -* -STXA DAC ** - LDA A - STA 0 - JMP* STXA -STXI DAC ** - LDA I - STA 0 - JMP* STXI -K153 OCT 16 -IM00 DAC ** - STA T1IM MULTIPLY A BY B - LDA K120 =-15 - STA T2IM - CRA - RCB C BIT = 0 -IM10 LRL 1 LOW BIT OF B INTO C - SRC SKIP IF B = 0 - ADD T1IM - IRS T2IM - JMP IM10 - LLL 14 - JMP* IM00 RETURN, RESULT IN A -T1IM PZE 0 -T2IM PZE 0 -* -* -NF00 DAC ** CONSTRUCT EXTERNAL NAME - LDA K80 ENTRY FOR FORTRAN GENERATER - STA NAMF - LDA K81 SUBROUTINE CALLS, - STA NAMF+2 - JMP* NF00 -K80 BCI 1,F$ -K81 BCI 1, -KM92 DEC 1 001 = INT - DEC 2 010 = REA - DEC 1 011 = LOG - DEC 0 - - - DEC 4 101 = CPX - DEC 3 110 = DSL - OCT 3 111 = HOL -* -* -BLNK DAC ** CLEAR A 3/36 - JST SAV AREA TO ZEROS - LDA* BLNK - STA XR - CRA CLEAR 3 WORDS OF MEMORY - STA 1,1 PARAMETER INPUT ADDRESS TO 0 - STA 2,1 - STA 0,1 - JST RST - IRS BLNK - JMP* BLNK EXIT -* -* -MOV3 DAC ** MOVE 3-WORDS - LDA TID TO TEMO STORE - STA DNX1 - LDA TID+1 - STA DNX1+1 - LDA TID+2 - STA DNX1+2 - JMP* MOV3 -* -* -* -* -CIB DAC ** COMPARE IBUF TO A CONSTANT - JST SAV SAVE INDEX - LDA* CIB +DDR OF CON+3,0 - STA CIBZ - CRA - SUB K103 XR=-3 - STA XR -CIBB LDA IBUF+3,1 - SUB* CIBZ - SZE - JMP CIBD - IRS XR - JMP CIBB -CIBC IRS CIB - JST RST RESTORE INDEX - JMP* CIB -CIBD IRS CIB - JMP CIBC -CIBZ DAC ** -* -* -* -* -SAV DAC ** SAVE INDEX REGISTER - STA SAVY STACKED IN PUSH DOWN LIST - LDA XR - STA* SAV9 - IRS SAV9 - LDA SAVY - JMP* SAV -RST DAC ** RESTORE INDEX REGISTER - STA SAVY - LDA SAV9 UNSTACK PUSH DOWN LIST - SUB K101 - STA SAV9 - LDA* SAV9 - STA XR - LDA SAVY - JMP* RST -SAVY PZE 0 -SAV9 DAC SAVX IS INITIATED BY A092 -SAVX BSS 20 -* -* -PACK DAC ** PLACE CHARACTER IN A - STA PAK7 - LDA NTID INTO ID - UPDATE 3 WORDS OF -PAK1 SNZ - JMP PAK4 ID - LRL 1 - ADD PAK9 - STA PAK8 - LDA PAK7 - IAB - SPL - JMP PAK3 - LLL 24 - ADD K8 -PAK2 STA* PAK8 - IRS NTID - JMP* PACK -PAK3 LLL 8 - LDA* PAK8 - LGR 8 - LLL 8 - JMP PAK2 -PAK4 LDA PAK6 - STA TID - STA TID+1 - STA TID+2 - STA TID+3 - LDA NTID - JMP PAK1+2 -PAK6 BCI 1, -PAK7 DAC ** -PAK8 DAC ** -PAK9 DAC TID -* -* -* *************** -* *ERROR ROUTINE* -* *************** -* -ER00 DAC ** ERROR ROUTINE - LDA SAV9 - STA SAVX - LDA ER93 =-35 - STA 0 SET INDEX - LDA ER91 (*)(*) - STA PRI+35,1 SET ** INTO PRINT BUFFER - IRS 0 SET COMPLETE PRINT BUFFER TO ******** - JMP *-2 - LDA CC - ARS 1 CC = CC/2 - SUB K101 =1 - SPL - CRA - STA XR - LDA EBAR (NEGATIVE IF NOT WITHIN AN EQUIVALENCE ST.) - SPL SKIP IF PROCESSING AN EQUIVALENCE STATEMENT - JMP *+3 - LDA KAEQ ='142721 (=(E)(Q) ) - STA PRI+1,1 - LDA* ER00 - STA PRI,1 SET ERROR TYPE LETTERS INTO THE BUFFER - CALL F4$SYM PRINT THE BUFFER - DAC PRI - JST PRSP SET PRINT BUFFER TO SPACES - LDA TC -ER20 CAS CRET INPUT CHARACTERS UNTIL C/R - JMP *+2 - JMP C7 GO TO STATEMENT INPUT - JST CH00 - JMP ER20 -ER91 BCI 1,** -ER93 OCT 177735 -35 -* -* -SRT DAC ** - JST SAV - LDA* SRT SHIFT RIGHT ONE PLACE - STA XR TRIPLE PRECISION - LDA 0,1 - IAB - LDA 1,1 - LRS 1 - LGL 1 - IAB - STA 0,1 - LDA 2,1 - LRS 1 - STA 2,1 - IAB - STA 1,1 - JST RST - IRS SRT - JMP* SRT -* -* -SFT DAC ** TRIPLE PRECISION - JST SAV SHIFT LEFT ONE PLACE - LDA* SFT - STA XR - LDA 0,1 - IAB - LDA 1,1 - LLS 1 - CSA - STA 1,1 - IAB - STA 0,1 - ACA - LRS 1 - LDA 2,1 - LLS 1 - CSA - STA 2,1 - JST RST - IRS SFT - JMP* SFT -* -LIST DAC ** - JST PRSP - SR2 - JMP *+3 - CALL F4$SYM PRINT BLANK LINE - DAC PRI - CALL F4$SYM PRINT SOURCE INPUT LINE - DAC CI - JMP* LIST -* ************* -* *ASSIGN ITEM* -* ************* -* CHECKS ASSIGNMENT AREA OF DATA POOL (A0 TO ABAR) -* FOR ITEM DEFINED BY ID, IM, IU, ETC. -* IF FOUND, EXIT WITH POINTER AND -* ASSIGNMENTS DATA SET, OTHERWISE -* ASSIGN THE ITEM. -* -* -* -T0AS PZE 0 -AS00 DAC ** - CRA - STA A A = A (0) -AS04 JST STXA - JST NXT GET NEXT ENTRY - JMP AS30 AT END, GO TO AS30 - LDA NT - SUB NTA NT = NT(A) - SZE - JMP AS04 NO, G0 TO AS04 - LDA TID - SUB TIDA - SZE - JMP AS04 TID = TID(A) - LDA TID+1 - SUB TIDA+1 - SZE - JMP AS04 NO, GO TO AS04 - LDA TID+2 - SUB TIDA+2 - SZE - JMP AS04 - LDA NT IF NT (A) .NE. 0, - SNZ GO TO AS10 - JMP AS16 GO TO AS16 (4) -AS10 LDA IM IF IM .NE. IM (A), - SUB IMA GO TO AS04 (1) - SZE - JMP AS04 - LDA IU IF IU = 0, - SNZ OR NOT EQUAL IU (A) - JMP AS04 GO T0 AS04 (1) - SUB IUA - SZE - JMP AS04 ELSE, - LDA IM - SUB K105 GO TO AS16 (4) - SZE - JMP AS16 - JST NXT ELSE, GET NEXT ENTRY - JMP AS30 - LDA TIDA IF IU (A) = TIDB - SUB TIDB GO TO AS16 (4) - SZE ELSE, GO TO AS04 (1) - JMP AS04 - LDA TIDA+1 - SUB TIDB+1 - SZE - JMP AS04 - LDA TIDA+2 - SUB TIDB+2 - SZE - JMP AS04 - LDA A - SUB K105 - STA A -AS16 LDA IUA IF IU (A) .NE. 0 - ADD NTF - SZE - JMP AS18 GO TO AS18 (5) - LDA SPF IF SPF = 0, GO TO AS18 (5) - SNZ - JMP AS18 - LDA TC IF TC = ( - SUB K17 - SZE - JMP AS19 - JST TG00 TAG SUBPROGRAM -AS18 CRA SET NTF TO 0 - STA NTF SET NTF TO 0 - JST FA00 GO TO FETCH ASSIGNS - JST STXA - LDA IM - JMP* AS00 RETURN -AS19 JST TV00 TAG VARIABLE - JMP AS18 -AS30 JST BUD BUILD ASSIGNMENT ENTRY - LDA NT IF NT = 1 - SZE - JMP AS32 OR IV = VAR, - LDA IU - SUB K102 - SZE - JMP AS40 AMD -AS32 LDA IM IF IM = CPX, - SUB K105 - SZE - JMP AS40 - STA IU MOVE 1ST PART OF - LDA TIDB COMPLEX ENTRY TO - STA TID TID AND BUILD - LDA TIDB+1 ASSIGNMENT ENTRY - STA TID+1 - LDA TIDB+2 - STA TID+2 - LDA A - ADD K105 - STA A - JST BUD - LDA A - SUB K105 RESTORE A - STA A -AS40 LDA ABAR - SUB A TO = -(ABAR-A+5) - ADD K105 GIVING NO. OF WORDS TO MOVE TABLES UP - TCA - STA T0AS - TCA - ADD DO CO=DO+TO - STA DO - LDA IFLG IF IFLG = 0, THERE IS NO EXPRESSION TABLE - SNZ - JMP AS60 GO TO AS60 - LDA I - SUB T0AS - STA I I = I - T0(T0 IS NEGATIVE) - AOA -AS41 CAS L CHECK AGAINST BOTTOM OF TRIAD TABLE - NOP - JMP AS50 - ADD '104 =DP,1 - STA AS91 AS91 = NEW TABLE TOP - ADD T0AS - STA AS92 AS92 - SUB T0AS COMPUTE SIZE OF FLOATING TABLES - SUB '104 =DP,1 - SUB DO - SNZ IF ZERO, ASSIGN TABLE ONLY, - JMP AS16 - TCA - STA T0AS - CRA - STA XR -AS46 LDA* AS92 END-5 - STA* AS91 END (MOVE TABLES UP) - LDA 0 - SUB K101 =1 - STA 0 REDUCE INDEX - IRS T0AS = NO, OF WORDS TO MOVE - JMP AS46 - JMP AS16 -AS50 JST ER00 - BCI 1,MO DATA POOL OVERFLOW -AS60 LDA DO - ADD D - JMP AS41 -AS91 DAC 0 -AS92 DAC ** -* -* -* -* -* **************** -* *TAG SUBPROGRAM* -* **************** -* TAG ITEM AS A SUBPROGRAM, CHECK TO SEE IF -* NAME IS IN IMPLICIT MODE TABLE AND SET -* MODE ACCORDINGLY -* -TG00 DAC ** - LDA IU - SUB K101 IF IU = SUB - SNZ - JMP* TG00 RETURN, ELSE - JST NU00 NO * USAGE TEST - LDA TG22 =-21 - STA 0 SET INDEX -TG04 LDA ID+1 CHARACTERS 3 AND 4 - CAS TGT2+21,1 IMPLICIT MODE SUBR. NAME TABLE - JMP *+2 - JMP TG10 -TG06 IRS 0 - JMP TG04 NOT DONE WITH TABLE -TG08 LDA K101 =1 (IU=SUBR.) - STA IU - JST STXA - LDA DP+1,1 IU(A) = SUB - LGL 1 - SSM - LGR 1 - STA DP+1,1 - JMP* TG00 RETURN -* -TG10 LDA ID CHARACTERS 1 AND 2 - ANA K111 ='37777 - ADD HBIT ='140000 - SUB TGT1+21,1 - SZE - JMP TG06 CONTINUE SEARCH - LDA ID+2 CHARACTERS 5 AND 6 - SUB TGT3+21,1 - SZE - JMP TG06 CONTINUE SEARCH - LDA TGT1+21,1 - LGR 8 - ANA K107 =7 (=3 IF CPX, 4 IF DBL) - ADD K102 =2 (=5 IF CPX, 6 IF DBL) - JST DM00 DEFINE IM - JMP TG08 -* -TG22 OCT 177753 =-21 -* -*...........IMPLICIT MODE SUBROUTINE NAME TABLE -TGT1 BCI 6,DECEDLCLDLDS - BCI 6,CSDCCCDSCSDA - BCI 6,DADMDADMDMDS - BCI 3,DBCMCO -TGT2 BCI 6,XPXPOGOGOGIN - BCI 6,INOSOSQRQRTA - BCI 6,TAODBSAXINIG - BCI 3,LEPLNJ -TGT3 BCI 6, 10 / - BCI 6, T T N / - BCI 6,N2 1 1 N / - BCI 3, X G / -* -* -TIDA BSS 3 -TIDB BSS 3 -* -* - TV00 TAG VARIABLE -TV00 DAC ** - LDA IU IF IU = 'VAR', - SUB K102 - SNZ - JMP* TV00 RETURN - JST NU00 ELSE, NO USAGE TEST - JST STXA - LDA DP+1,1 - ANA K111 IU (A) = 'VAR' - SSM - STA DP+1,1 - JMP* TV00 RETURN -* -* -* -* -* -* ************** -* *FETCH ASSIGN* -* ************** -* SET ASSIGNMENT DATA FROM ASSIGN (EXCEPT ID) -* EXPAND DIMENSION INFO IF ARRAY -* -FA00 DAC ** - JST STXA - LDA DP,1 - LRL 15 - STA NT NT=NT(A) - CRA - LLL 3 - STA AT AT=AT(A) - CRA - LLL 3 IM = IM(A) - STA IM - STA 0 - LDA KM92-1,1 - STA D0 D0 = NUMBER OF WORDS - ALS 2 - ADD D0 - STA X X = POINTER TO CONSTANT NUMBER OF WORDS - JST STXA - LDA DP+1,1 - LRL 14 - STA IU - SUB K103 IF IU NOT 'ARR' - SNZ - JMP FA10 - CRA - LLL 14 AF = GF(A) - STA AF - JMP* FA00 -FA10 LLL 14 - STA 0 INDEX = GF(A) - LDA DP+4,1 - STA X1 POINTER OF DIMENSION 1 - LDA DP+3,1 - STA X2 POINTER OF DIMENSION 2 - LDA DP+2,1 - STA X3 POINTER OF DIMENSION 3 - LDA DP+1,1 - ANA K111 ='37777 - STA AF AF = GF(GF(A)) - LDA DP,1 - LGR 9 - ANA K107 =7 - STA ND NUMBER OF DIMENSIONS - STA 0 - LDA K101 =1 - STA D2 - STA D3 - JMP* FA91-1,1 -FA22 LDA X3 FETCH 3RD DIMENSION SIZE - STA XR - JST FA40 - STA D3 STORE D3 -FA24 LDA X2 - STA XR - JST FA40 - STA D2 D2 = 2ND DIMENSION SIZE -FA26 LDA X1 - STA XR - JST FA40 - STA D1 D1 = 1ST DIMENSION SIZE - JST STXA EXIT WITH AF IN A - LDA AF - JMP* FA00 -FA40 DAC ** - LDA DP,1 IM OF SUBSCRIPT VALUE - SSP - LGR 12 - SUB K105 =5 - SZE SKIP IF DUMMY SUBSCRIPT - LDA DP+4,1 FETCH VALUE OF SUBSCRIPT - JMP* FA40 -FA91 DAC FA26 - DAC FA24 - DAC FA22 -* -* -* ************ -* *FETCH LINK* -* ************ -* EXPAND LINK FIELD AND FETCH ASSIGNS FOR THE -* LINKED ITEM -* -FL00 DAC ** - JST STXA - LDA DP,1 A = 5 * CL(A) - ANA K118 - STA FLT1 - ALS 2 - ADD FLT1 (FLT1 ALSO USED BY ASSIGN SPEC) - STA A - JST FA00 FETCH ASSIGN - JST KT00 D0 = = WDS /ITEM - LDA A - SUB F (A) = A-F - JMP* FL00 RETURN -* -* -* ******************* -* *D0=WORDS FOR LINK* -* ******************* -* D = ITEM MODE SIZE TIMES THE TOTAL SIZE IF -* THE ITEM IS AN ARRAY -* -KT00 DAC ** - LDA IU IF IU NOT 'ARR' - SUB K103 - SZE - JMP* KT00 RETURN - LDA D0 - IAB D0 = D0 * D1 * D2 * D3 - LDA D1 - JST IM00 MULTIPLY A BY B - IAB - LDA D2 - JST IM00 MULTIPLY A BY B - IAB - LDA D3 - JST IM00 MULTIPLY A BY B - STA D0 - JMP* KT00 RETURN -* -* -* -* *********** -* *DEFINE IM* -* *********** -* IM SUBA = IM (SET FROM A REG) -* -DM00 DAC ** - STA IM IM = (A) - JST STXA ESTABLISH A - LDA DP,1 - LRL 9 - LGR 3 IM(A) = IM - LGL 3 - ADD IM - LLL 9 - STA DP,1 - JMP* DM00 -* -* -* *********** -* *DEFINE AF* -* *********** -* AF SUBA = AF (SET FROM A REG) -* -DA00 DAC ** - STA AF AF = (A) - LRL 14 - JST STXA -DA10 LDA DP+1,1 IF IU (A) NOT ARR - LGR 14 - CAS K103 GF (A) : AF - JMP *+2 - JMP DA20 ELSE, GF (GF (A)) = AF - LLL 14 - STA DP+1,1 - JMP* DA00 RETURN -DA20 LDA DP+1,1 - ANA K111 - STA GFA - STA 0 - JMP DA10 -NXT DAC ** GET NEXT ENTRY - LDA A FROM ASSIGNMENT - ADD K105 =5 - STA A - STA 0 - CAS ABAR - JMP* NXT - NOP - IRS NXT - LDA DP,1 - LRL 15 - STA NTA NT(A) = NT FROM (A) - CRA - LLL 3 - STA ATA AT(A) = AT FROM (A) - CRA - LLL 3 - STA IMA IM(A) = IM FROM (A) - CRA - LLL 9 - STA CLA CL(A) = CL FROM (A) - LDA DP+1,1 - LRL 14 - STA IUA IU(A) = IU FROM (A) - CRA - LLL 14 - STA GFA GF(A) = GF FROM (A) - LDA DP+2,1 - STA TIDA+2 TID(A) = TID FROM (A) - LDA DP+3,1 - STA TIDA+1 - LDA DP+4,1 - STA TIDA - LRL 15 - STA DTA DT(A) = DT FROM (A) - CRA - LLL 1 - STA TTA TT(A) = TT FROM (A) - LDA NTA NT(A) = NT FROM (A) - SZE - JMP* NXT - LDA DP+4,1 - SSM - ALR 1 - SSM - ARR 1 - STA TIDA - JMP* NXT -* -* -BUD DAC ** BUILD ASSIGNMENT - JST STXA - STA ABAR - LDA TID TABLE ENTRY - STA DP+4,1 - LDA TID+1 - STA DP+3,1 - LDA TID+2 - STA DP+2,1 - LDA IU - STA IUA - LGL 14 - STA DP+1,1 - LDA NT - LGL 3 - ADD K102 AT = STR/+BS - LGL 3 - ADD IM - LRL 16 - STA CL - LDA K102 - STA AT - LDA A CL(A) = A/5 - SUB K105 - SPL - JMP *+3 - IRS CL - JMP *-4 - LLL 25 - ADD CL - STA DP,1 - SPL - JMP* BUD - LDA DT - LGL 1 - ADD TT - LGL 14 - IMA DP+4,1 - ANA K111 - ADD DP+4,1 - STA DP+4,1 - JMP* BUD -* -* -* -* -* -* ************ -* *DEFINE AFT* -* ************ -* AT SUBA = AT (FROM B REG), THEN DEFINE AF -* -AF00 DAC ** - IAB - STA AF90 - JST STXA - LDA AF90 - LGL 12 - IMA DP,1 - ANA AF91 - ADD DP,1 - STA DP,1 AT(A) = CONTENTS OF B INPUT - IAB - JST DA00 DEFINE AF - JMP* AF00 -AF90 PZE 0 -AF91 OCT 107777 -* -* -* ***************** -* *DEFINE LOCATION* -* ***************** -* SET AF = RPL, AT = REL -LO00 DAC ** - LDA K101 REL - IAB - LDA RPL - JST AF00 DEFINE AF - JMP* LO00 -* ************************* -* *ASSIGN INTEGER CONSTANT* -* ************************* -* IM (INTEGER), IU(VARIABLE) , ASSIGN SPECIAL -AI00 DAC ** - CRA - STA ID+1 - STA ID+2 - LDA K101 (B) = INT - IAB - LDA K102 (A) = VAR - JST AA00 ASSIGN SPECIAL - JMP* AI00 RETURN -* -* -* **************** -* *ASSIGN SPECIAL* -* **************** -* B REG TO IM, A REG TO IU, 1 TO NT (CONSTANT), THEN -* ASSIGN ITEM -AA00 DAC ** - STA IU IU = (A) - IAB - STA IM IM = (B) - LDA K101 - STA NT NT = 1 - JST AS00 ASSIGN ITEM - JMP* AA00 RETURN -* -* -* ********** -* *JUMP * -* *ILL TERM* -* ********** -* -* CLEAR LAST OP FLAG FOR NO PATH TESTING -* -B6 CRA - STA LSTP LSTP = 0 -* SET ILLEGAL DO TERM FLAG -C5 LDA K101 - STA LSTF LSTF =1 -A1 LDA CRET - JST TS00 IF TC NOT C/R, ERROR - JMP C6 -* -* -* ********** -* *CONTINUE* -* ********** -* WRAPUP LOGICAL IF, CHECK TRACE STOP AND SEARCH -* DO TABLE FOR DO TERMINATION -C6 LDA LIF - SZE IF LIF NON-ZERO, - JMP C6H GO TO -C6A LDA LSTN IF LSTN NON-ZERO, - SZE GO TO - JMP C6C -C6B STA LSTF LSTF = 0 - JMP C7 GO TO STATEMENT INPUT -C6C SUB TRF TRACE FLAG - SNZ SMP IF NOT END OF TRACE ZONE - STA TRF SET TRF TO ZERO (TURN FLAG OFF) - LDA DO START OF DO TABLE - ADD D -C6D STA I I = DO + D - JST STXI - SUB DO - SNZ - JMP C6B GO TO C6B - FINISHED DO - LDA DP-4,1 - SUB LSTN - SZE - JMP C6E - LDA LSTF - SZE - JMP C6K - JST DQ00 DO TERMINATION - LDA D - SUB K105 - STA D D = D-5 - LDA LSTF -C6E STA LSTF - LDA I - SUB K105 - JMP C6D I = I-5 - CONTINUE DO LOOP -C6H LDA IFF - STA A - SNZ - JMP C6J - LLL 16 - LDA OMI5 (A) = JMP INSTRUCTION - JST OB00 OUTPUT OA - CRA - STA IFF IFF = 0 -C6J STA A A = U - LDA LIF - STA LSTP SET TO NON-ZERO TO PREVENT DATA ERROR MSG - JST OS00 OUTPUT STRING - RPL - JMP C6A -* -C6K JST ER00 - BCI 1,DT -* -* ***************** -* *STATEMENT INPUT* -* ***************** -* SET UP PROCESSING OF NEXT SOURCE STATEMENT -* PROCESS STATEMENT NUMBER IF PRESENT -* WRAPUP ANY OUTSTANDING ARITHMETIC IF -C7 CRA - STA LSTN LSTN = 0 - STA IFLG IFLG = 0 - STA LIF LIF = 0 - LDA L0 L = L (0) - STA L - LDA CI CHECK CARD COLUMN 1 - LGR 8 FOR $ CHARACTER - SUB K15 *($) - SNZ - JMP CCRD CONTROL CARD - JST XN00 EXAMINE NEXT CHAR - SZE - JMP C71 - JST IS00 INPUT STATEMENT = - LDA A - STA LSTN LSTN = A - STA LSTP -C71 LDA IFF CHECK FOR IFF=0 - LDA IFF IF IFF = 0, - SNZ - JMP C7B GO TO C7B - SUB LSTN IF = LSTN - SZE - JMP C7C -C7A STA IFF IFF = 0 -C7B JST C7LT LINE TEST - JMP C8 -C7C LDA IFF IFF = A - STA A - LRL 32 - LDA K201 (A) = JMP INSTRUCTION - JST OB00 OUTPUT OA - CRA - JMP C7A GO TO C7A -C7LT DAC ** LINE TEST - LDA CI+2 CI = BLANK - ANA K116 LIST LINE - ADD K8 RETURN - STA CI+2 - LDA TC - SUB HC2 IF TC : SPECIAL - SZE - JMP C7LU - JST LIST - JMP* C7LT -C7LU JST ER00 CONSTRUCTION ERROR - BCI 1,SC STATEMENT NO. ON A CONTINUATION CARD -* -* -* -* ************************ -* *CONTROL CARD PROCESSOR* -* ************************ -CCRD JST FS00 FLUSH BUFFER IF NECESSARY - JST LIST LIST CARD - LDA CI WORD CONTAINING COLUMN 1 - LGL 12 - SNZ - LDA CCRK ='030000 (EOJ CODE = 3) - LGR 6 TRUNCATE TO A DIGIT - STA OCI - LDA K106 =6 - STA OCNT SET BUFFER WORD COUNT TO 3 - JST FS00 FLUSH BUFFER - LDA CI - LGL 12 CHECK COLUMN 1 FOR CONTROL CODE 0 - SZE - JMP ER20 SKIP TO NEXT CARD (NOT CONTROL CARD) - CALL F4$END CLOSE-OUT I/0 DEVICES AND STOP - JMP A0 RESTART NEW COMPILATION -CCRK OCT 030000 EOJ CONTROL CODE -* -* **************** -* *STATEMENT SCAN* -* **************** -* DETERMINE THE CLASS OF THE STATEMENT -* IF AN = IS FOUND WITH A FOLLOWING , -* THE STATEMENT IS A DO -* IF NO FOLLOWING COMMA, THE PAREN FLAG -* IS TESTED, IF NO PARENS, THE STATEMENT -* IS ARITHMETIC ASSIGNMENT -* IF PARENS WERE DETECTED AND THE FIRST -* NAME IS AN ARRAY, THE STATEMENT IS -* ARITHMETIC ASSIGNMENT -* OTHERWISE, IT IS A STATEMENT FUNCTION -* IF NO = IS FOUND, THE STATEMENT IS -* PROCESSED FURTHER IN STATEMENT ID -C8T1 PZE 0 -C8 LDA CC SAVE CC - STA C8X9 - LDA K101 - STA C8T1 T (1) = 1 - CRA - STA ICSW ICSW = SIR -C8A JST CH00 INPUT CHARACTER -C8B LDA TC IF TC = ) - SUB K4 - SZE - JMP C8C - JST CH00 INPUT CHAR -C8B2 LDA DFL IF DFL NOT ZERO - SZE - JMP C8B GO TO C8B -C8B4 LDA C8X9 RESTORE CC - STA CC - LDA K101 IPL - STA ICSW ICSW = IPL - JMP A9 GO TO STATEMENT ID -C8C LDA TC IF TC NOT (, - SUB K17 - SZE - JMP C8D GO TO C8D - LDA C8T1 T1 = T1 - 1 - SUB K101 - STA C8T1 -C8C4 SZE IF T1 = 0 - JMP C8B4 - JST DN00 INPUT DNA - JMP C8B2 GO TO C8B2 -C8D LDA TC IF TC = , - CAS K134 ='17 ('FINISHED' CODE FOR COMMA) - JMP *+2 - JMP C8D2 TC = COMMA - SUB K5 - SZE - JMP C8E -C8D2 LDA C8T1 GO TO C8C4, - JMP C8C4 -C8E LDA TC ELSE, IF TC = '/' - SUB K9 - SNZ - JMP C8B4 GO TO C8B4 - LDA TC - SUB K18 IF NOT = , - SZE - JMP C8A GO TO C8A - LDA K107 INPUT 7 CHARACTERS - JST IA00 - LDA C8X9 RESTORE CC - STA CC - LDA K101 IPL - STA ICSW ICSW = IPL - LDA TC - SUB K5 IF TC NOT, - SZE - JMP C8G GO TO C8G - LDA K102 ELSE, INPUT 2 CHARS - JST IA00 - LDA IBUF IF (A) = 'DO' - SUB K19 - SNZ - JMP *+3 - JST ER00 - BCI 1,CM COMMA OUTSIDE PARENTHESES, NOT IN DO STMNT, - LDA K104 - JST NP00 FIRST NON-SPEC CHECK - JMP C9 GO TO DO -C8G LDA C8T1 1 IF NO ( TO LEFT OF EQUALS - SZE - JMP G2 ARITHMETIC ASSIGNMENT STATEMENT - JST SY00 INPUT SYMBOL - LDA C8X9 - STA CC RESTORE CC - LDA IU IF IU = SUBR - SUB K103 - SZE - JMP G1 GO TO ARITH ST. FUNCT, - JMP G2 OTHERWISE = ASSIGNMENT STATEMENT -C8X9 PZE 0 -* -* -* ************************** -* *STATEMENT IDENTIFICATION* -* ************************** -* READ FOUR CHARACTERS AND DETERMINE CORRECT ROUTINE -* FOR PROCESSING, THEN CHECK SPELLING ON REST -A9T1 PZE 0 -A9T2 PZE 0 -A9T3 PZE 0 -A9 LDA K104 - JST IA00 INPUT (4) CHARS - LDA IBUF - STA NAMF NAMF = IBUF - LDA IBUF+1 - STA NAMF+1 - LDA A9Z9 INITIALIZE INDEX FOR LOOP - STA XR THROUGH THE STATEMENT NAMES -A9A LDA NAMF - SUB A9X1+30,1 - SZE - JMP A9F READ IN REST OF - LDA NAMF+1 CHECK REST OF SPELLING FOR - SUB A9X2+30,1 - SZE A MATCH ON 4 CHARACTERS - JMP A9F NOT FOUND - LDA A9X4+30,1 - ANA K133 - STA A9T1 T1 = NUMBER OF REMAINING CHARACTERS - LDA A9X3+30,1 LEFT TO CHECK - LRL 13 - IAB - LGR 3 - STA A9T2 T2 = ADDRESS OF ROUTINE - IAB - JST NP00 FIRST NON-SPECIFIC. CHECK -(A) = -A9B LDA A9T1 HIERARCHY CODE - SZE - JMP A9C MUST CHECK MORE CHARACTERS - JMP* A9T2 FINISHED CHARACTER CHECK, EXIT TO -* SPECIFIC ANALYZER. -A9C SUB K106 - SPL - JMP A9E - STA A9T1 - LDA K106 REMAINING SPELLING 1S CHECKED. -A9D STA A9T3 - JST IA00 - SUB A9T3 - SNZ - JMP A9B - JST ER00 - BCI 1,SP STATEMENT NAME MISSPELLED -A9E ADD K106 - IMA A9T1 - CRA - IMA A9T1 - JMP A9D -A9F IRS XR LOOP CONTROL FOR STATEMENT NAMES. - JMP A9A MORE NAMES - CONTINUE LOOP - LDA TC - SUB CRET - SZE - JMP A9G - LDA LSTN TC = C/R - SNZ - JMP C7 AND LSTN = 0 - INPUT NEW STATEMENT -A9G JST ER00 - BCI 1,ID UNRECOGNIZED STATEMENT -A9X1 BCI 10,INREDOCOLOFUSUBLEXDI - BCI 10,COEQGOCARECOFOIFWRRE - BCI 7,BAENREENASSTPA - BCI 2,DATR - BCI 1,PR -A9X2 BCI 10,TEALUBMPGINCBROCTEME - BCI 10,MMUITOLLTUNTRM( ITAD - BCI 3,CKDFWI - OCT 142215 D, C/R - BCI 3,SIOPUS - BCI 2,TAAC - BCI 1,IN -A9X3 DAC A3 - DAC A4 - DAC A5 - DAC A6 - DAC A7 - DAC R1 - DAC R2 - DAC R3 - DAC B2 - DAC B3 - DAC B4 - DAC B5 - DAC* R7 - DAC* R8 - DAC* R9 - DAC* CONT - DAC* V2 - DAC* V3 - DAC* V4 - DAC* V5 - DAC* V6 - DAC* V7 - DAC* V8 - DAC W5+'20000 - DAC* W3 - DAC* W7 - DAC* W8 - DAC W4,1 - DAC* TRAC+'20000,1 TRACE STATEMENT - DAC* V10 -* -* ****************************** -* *CONTINUE STATEMENT PROCESS0R* -* ****************************** -CONT LDA LSTP ACCOUNTS FOR POSSIBLE PATH ERROR - ADD LSTN ACCOUNTS FOR POSSIBLE PATH ERROR - STA LSTP ACCOUNTS FOR POSSIBLE PATH ERROR - JMP C6 -* -*-------------THE FOLLOWING TABLE IS USED BY STATEMENT ID -*-------------(RIGHT 6 BITS) AND OUTPUT ITEM, -A9X4 OCT 000003 (00) - OCT 030100 (01) + (A$--) - OCT 032313 (02) - (S$--) - OCT 031503 (03) * (M$--) - OCT 030403 (04) / (D$--) - OCT 000004 (05) .NOT. - OCT 000006 (06) .AND. - OCT 031405 (07) .OR. (L$-, - OCT 000004 (10) .LT. - OCT 000005 (11) .LE. - OCT 000002 (12) .EQ. - OCT 000007 (13) .GE. - OCT 000000 (14) .GT. - OCT 000000 (15) .NE. - OCT 031003 (16) = (H$--) - OCT 000005 (17) , - OCT 030503 (20) 'E' (E$--) - OCT 031600 (21) 'C' NC$--) - OCT 000001 (22) 'A' - OCT 000000 (23) - OCT 000005 (24) 'X' - OCT 000003 (25) 'H' - OCT 000002 (26) 'L' - OCT 000000 (27) 'I' - OCT 000002 (30) 'T' - OCT 031400 (31) 'F' (L$--) - OCT 000001 (32) 'Q' - OCT 000000 - OCT 000001 - OCT 000001 -A9Z9 DAC* -30,1 NO. OF ITEMS IN STMNT NAME TABLE -* -* -* ********************** -* *FIRST NON-SPEC CHECK* -* ********************** -* AT FIRST SHIFT IN LEVEL FROM ZERO, WRAP-UP -* SPECIFICATION STATEMENTS -T0NP PZE 0 -NPT0 EQU T0NP -T2NP PZE 0 -T1NP PZE 0 -NP00 DAC ** - STA NPT0 T0 = (A) - LDA A - STA T1NP T1 = A - LDA NPT0 - CAS K107 =7 - JMP *+2 - JMP NP10 TRACE STMNT. (MAY OCCUR ANYWHERE) - CAS SPF T0 , G.R. SPF, GO TO NP30 - JMP NP30 T0 = SPF, G0 TO NP25 - JMP NP25 - LDA TC IF TC = C/R - SUB CRET GO TO NP10 - SNZ - JMP NP10 - JST ER00 ELSE, ILLEGAL STATEMENT - BCI 1,EX SPECIFICATION STATEMENT APPEARS AFTER -* -NP10 LDA LSTN SPECIFICATION STATEMENT CLEAN-UP - STA A A = LSTN - SNZ - JMP NP16 IF ZERO, RETURN - JST FA00 FETCH ASSIGNS - LDA K103 STR-REL - SUB AT - SZE - JMP NP20 - LDA AF - JST OS00 OUTPUT STRING RPL -NP15 JST LO00 DEFINE LOCATION - LDA NAMF - SUB A9X1+16 - SZE - JST TRSE OUTPUT TRACE COUPLING -NP16 LDA T1NP - STA A - JMP* NP00 -NP20 JST NR00 NON-REL TEST - JMP NP15 -NP25 LDA LIF - SZE - JMP NP16 - LDA LSTP IF LSTP + LSTN =0 - ADD LSTN - SZE - JMP NP10 - IRS LSTP - JST ER00 'NO PATH' ERROR - BCI 1,PH NO PATH LEADING TO THE STATEMENT -NP30 LDA SPF IF SPF 0 0 - SZE - JMP NP37 -NP32 LDA TC - STA T2NP T2 = TC - LDA RPL - STA XST XST = RPL - LDA BDF BLOCK DATA SUBPROGRAM FLAG - SZE SKIP IF NOT BLOCK DATA SUBPROGRAM - JMP C2 GO TO RELATE COMMON - STA A SET LISTING FOR OCTAL ADDR. - LDA OMI5 JMP INSTRUCTION - STA DF SET LISTING FOR SYMBOLIC INSTR. - JST OA00 OUTPUT ABSOLUTE - JMP C2 GO TO RELATE COMMON -NP35 LDA T2NP - STA TC -NP37 LDA T0NP - STA SPF SPF = T0 - SUB K104 - SZE - JMP NP10 -NP40 STA A SET LISTING FOR OCTAL ADDR. - LDA XST LOCATION OF INITIAL JUMP - JST OS00 OUTPUT STRING - LDA RPL - STA XST XST = RPL - JMP NP10 GO TO NP10 -* -* ***************** -* *IF( PROCESSOR* -* ***************** -* ARITHMETIC IF ($1 $2 $3) -* IF $2 NOT = $3, JZE $2 -* IF $3 NOT = $1, JPL $3 -* (IF $1 NOT = NEXT ST NO., JMP $1) LATER -* LOGICAL IF -* OUTPUT JZE 77777 (FOR STRINGING AROUND -* IMBEDDED STATEMENT) -V3 JST II00 INPUT ITEM - SNZ - JMP V310 IM=0 (POSSI8LE UNARY + OR -) - LDA DFL - SZE - JMP V310 FIRST ITEM IN EXPRESSION 0.K. -V308 JST ER00 ERROR.....IF(SENSE SWITCH,.ETC)..... - BCI 1,IF ILLEGAL IF STATEMENT TYPE -V310 CRA (A)=0 - JST EX00 EXPRESSION EVALUATOR - LDA K4 - JST TS00 )-TEST - CRA - STA A SET A TO SPECIAL (IF) ENTRY IN DATA POOL - STA 0 - LDA MFL SET MODE OF EXPRESSION INTO SPECIAL (IF) - LGL 9 - STA DP,1 - JST TRSE OUTPUT TRACE COUPLING (IF NECESSARY) - LDA MFL CHECK MODE FLAG FOR LOGICAL - SUB K103 - SZE - JMP V320 ARITHMETIC IF - LDA LIF - SZE - JMP V308 - STA AF SET ADDR OF SNZ AND JMP INSTR TO 00000 - LDA OMJ2 =SNZ INSTR. - JST OA00 OUTPUT ABSOLUTE - LDA RPL SET LIF=CURRENT +DDR, (STRING BACK) - STA LIF - LDA OMI5 =JMP 0 INSTR. - JST OA00 OUTPUT ABSOLUTE - JST XN00 GO TO NEXT INPUT LINE - JMP C8 GO TO STATEMENT SCAN -* -V320 SUB K102 CHECK FOR MODE = COMPLEX - SNZ - JMP V308 ERROR,...COMPLEX MODE EXPRESSION - LDA V356 =-3 - STA I -V324 JST IS00 INPUT STATEMENT NUMBER - JST STXI SET INDEX TO I - LDA A - STA T1V3+3,1 SAVE BRANCH ADDRESSES - IRS I I=I+1 - JMP V350 CHECK FOR TERMINAL COMMA - LDA T3V3 - CAS T2V3 CHECK FOR ADDR-2 = ADDR-3 - JMP *+2 - JMP V330 ADDR-2 = ADDR-3 - CRA - STA A - LDA OMJ2 =SNZ INSTR. - STA DF - JST OA00 OUTPUT ABSOLUTE - LDA T2V3 - JST V360 OUTPUT A JMP(ADDR-2) INSTR. - LDA T3V3 -V330 CAS T1V3 CHECK FOR ADDR-3 = ADDR-2 - JMP *+2 - JMP V340 ADDR-3 = ADDR-1 - CRA - STA A - LDA OMJ3 =SMI INSTR. - JST OA00 OUTPUT ABSOLUTE - LDA T3V3 - JST V360 OUTPUT A JMP (ADDR-3) INSTR. -V340 LDA T1V3 - STA IFF SET IFF ' ADDR-1 - JMP C5 GO TO ILL-TERM -* -V350 LDA K5 - JST TS00 COMMA TEST - JMP V324 INPUT NEXT STATEMENT NO. -* -V356 OCT 177775 -3 -* -*---------------SUBROUTINE TO OUTPUT A RELATIVE JMP -V360 DAC ** - STA A SET ADDR. OF JUMP REF. TO A - CRA - IAB SET (B) = 0 - LDA OMI5 SET (A) = JMP INSTR. - JST OB00 OUTPUT OA - JMP* V360 EXIT -* -T1V3 *** ** ADDR-1 -T2V3 *** ** ADDR-2 -T3V3 *** ** ADDR-3 -* -* ******* -* *GO TO* -* ******* -* CHECK FOR NORMAL (R740), COMPUTED (R710) OR -* ASSIGNED (R730). INPUT BRANCH LIST USED BY BOTH -* R710 AND R730 FOR STATEMENT NO. LIST. -* -* -R7 JST XN00 EXAMINE NEXT CHAR - SZE - JMP R78 GO TO TEST DFL - JST IS00 INPUT STMNT = - LDA A (GO TO 20) - STA IFF IFF = A - JMP C5 G0 TO ILLTERM -R78 LDA DFL - SZE - JMP R7D - JST IR00 GO TO I (10, 20, 30} - LRL 32 - LDA K206 OUTPUT JMP* INSTRUCTION - JST OB00 OUTPUT OA - LDA K134 - JST TS00 , TEST - JST IB00 INPUT BRANCH LIST - JMP B6 GO TO JUMP -R7D JST IB00 INPUT BRANCH LIST GO TO (10,11,12), I - LDA K134 - JST TS00 , TEST - JST IR00 INPUT INT VAR - LRL 32 - LDA K200 OUTPUT LDA - JST OB00 OUTPUT OA - CRA - STA A - STA AF CAUSE OCTAL ADDRESS IN LISTING - LDA K75 - JST OA00 OUTPUT ABS (STA 0) - INDEX LOAD - LDA RPL - STA AF CAUSE RPL T0 BE IN LISTING - LDA K207 - JST OR00 OUTPUT RELATIVE (JMP RPL,1) - LDA L0 -R7F SUB K101 - STA I I = L (0) - JST STXI - LDA DP,1 - STA A - JST STXA - SNZ - JMP B6 FINISHED LOOPING ON LIST - LLL 16 - LDA K201 OUTPUT JMP INSTRUCTIONS - JST OB00 OUTPUT OA (JMP 0) - LDA I - JMP R7F -* ******************* -* *INPUT BRANCH LIST* -* ******************* -* INPUT STATEMENT NO. LISTS FOR GO TO PROCESSOR -IB00 DAC ** - LDA L0 - SUB K101 - STA I I = L0-1 - JST CH00 INPUT CHAR - LDA K17 - JST TS00 (- TEST -IB10 JST IS00 INPUT STMNT = - JST STXI - LDA A - STA DP,1 SET POINTER OF ST. N0. INTO TRIAD TABLE -* AREA - LDA I DP (J) = A - SUB K101 - STA I I = I-1 - LDA TC IF TC = , GO TO IB10 - SUB K5 - SNZ - JMP IB10 CONTINUE LOOP - CRA - STA DP-1,1 SET END FLAG INTO TABLE - JST IP00 )- INPUT OPEN - JMP* IB00 EXIT -K75 STA 0 -* -* -* ******** -* *ASSIGN* -* ******** -* CHECK TO SEE THAT 'TO' IS INCLUDED PROPERLY -W3 JST IS00 INPUT STMNT = - LDA A - STA T1W3 SAVE A - LDA TC - SUB K34 CHECK FOR T0 - SZE - JMP W305 CLEAR A FOR OUTPUT REL - STA A CAUSE OCTAL ADDRESS IN LIST - JST CH00 INPUT CHAR - LDA TC - SUB K35 - SNZ - JMP *+3 -W305 JST ER00 ERROR - BCI 1,TO GO TO IN ASSIGN STATEMENT - LDA RPL - ADD K102 - STA AF OUTPUT REL LDA *+2 - LDA K200 OUTPUT LDA *+2 - JST OR00 OUTPUT REL - LDA RPL - ADD K102 - STA AF OUTPUT REL JMP *+2 - LDA K201 - JST OR00 OUTPUT OA - LRL 32 - LDA T1W3 - STA A RESTORE A - CRA - JST OB00 OUTPUT DAC ST. NO. - JST IR00 INPUT INTEGER VARIABLE - LRL 32 - LDA K202 OUTPUT STA INSTRUCTION - JST OB00 OUTPUT OA - JMP A1 GO TO C/R TEST -T1W3 PZE ** TEMP STORE -* -* -* ************************ -* *DO STATEMENT PROCESSOR* -* ************************ -* STACK INFO IN DO TABLE. OUTPUT DO INITIAL -* CODE -C9T0 PZE ** -C9 JST IS00 INPUT STATEMENT = - JST NR00 NON-REL TEST - LDA A - STA C9T0 T0 = A - JST UC00 UNINPUT COLUMN - JST IR00 - LDA C951 - JST TS00 - LDA C9T0 (A) = T0 - IAB - JST DP00 DO INPUT - JST DS00 DO INITIALIZE - JMP C5 GO TO ILLTERM -C951 OCT 16 = -* -* -* ********** -* *END FILE* -* ********** -* *********** -* *BACKSPACE* -* *REWIND * -* *********** -V6 LDA K71 -V6A STA NAMF+1 - JST NF00 SET UP NAMF - JST OI00 OUTPUT I/0 LINK - JMP A1 GO TO C/R TEST -V7 LDA K72 - JMP V6A -V8 LDA K73 - JMP V6A -K71 BCI 1,FN FN -K72 BCI 1,DN -K73 BCI 1,BN BN -* -* -* ************** -* *READ * -* *WRITE * -* *INPUT FORMAT* -* ************** -* LIST ELEMENT DATA AND IMPLIED DO CONTROL -* STACKED IN TRIAD TABLE. PROCESSED BY -* OUTPUT TRIAD ROUTINE, SPECIAL OPERATORS -* ARE -I = DO INITIALIZATION -* T = DO TERMINATION -* Q = I/0 ARG TRANSFER -T0V5 PZE ** -V5 LDA K41 FSRN - STA NAMF+1 - JST XN00 EXAM NEXT CHAR - SZE - JMP V5A GENERAL READ - LDA V5K4 - JMP V10A CARD READ -V4 LDA K40 NAWF = F$WN - STA NAMF+1 -V5A JST NF00 SET UP REMAINING NAME - LDA D - STA V5T1 - JST CH00 INPUT CHARACTER - LDA K17 ='250......( - JST TS00 (-TEST - JST OI00 OUTPUT I0 LINK - LDA TC IF TC .NE. , - SUB K134 ='17 (,) - SZE G0 10 V5J - JMP V5J - JST V5X INPUT FORMAT -V5B JST IP00 ) - INPUT OPERATOR - LDA TC - SUB CRET TEST FOR TC=C/R - SZE - JMP V5C N0, G0 TO V5C -V5B2 LDA K42 YES. NAMF = ND - STA NAMF+1 - JST CN00 CALL NAME - LDA V5T1 - STA D - JMP A1 G0 TO C/R TEST -V5C JST UC00 -V5C5 CRA - STA IOF IOF = 0 -V5D JST II00 INPUT ITEM - SZE - JMP V5E IF (A) NOT 0, GO TO V5E - LDA K17 - JST TS00 (-TEST - CRA - STA O2 O2 = 0 - LDA IOF - STA O1 01 = IOF - LDA V5K1 = '27 - STA P - JST ET00 - LDA L - STA IOF IOF = L - JMP V5D GO TO V5D -V5E JST NC00 NON-CONSTANT TEST - LDA IU IF IU NOT ARR - SUB K103 - SZE - JMP V5H GO TO V5H - LDA TC - SUB K17 IF TC NOT -(, - SZE - JMP V5G GO TO V5G - LDA D0 - STA T0V5 T5 = D0 - LDA K103 - TCA - JST EX00 EXPRESSION - LDA T0V5 - STA D0 D0 = T5 -V5E5 LDA A - STA O2 - LDA D0 O2 = D0 - STA O1 - LDA V5K2 ='32 - STA P - JST ET00 ENTER TRIAD -V5E7 LDA TC IF TC = COMMA - SUB K134 GO T0 V5D - SNZ - JMP V5D - LDA IOF I = IOF - STA I - SZE IF NOT ZERO, - JMP V5F GO TO V5F - JST OT00 OUTPUT TRIADS - JMP V5B2 GO TO V5B2 -V5F JST IP00 )-INPUT OPERATOR - JST STXI - LDA DP+1,1 - STA IOF IOF = O1 (I) - JMP V5E7 -V5G JST KT00 K = = WDS/ITEM - JMP V5E5 GO TO V5E5 -V5H JST TV00 TAG VARIABLE - LDA TC - SUB K16X ='16 (=) - SZE GO TO V5E5 - JMP V5E5 ELSE, - JST IT00 INTEGER TEST - LDA IOF - SNZ IF IOF = ZERO OR L - JMP V5H7 - SUB L - SZE - JMP *+3 ERROR -V5H7 JST ER00 - BCI 1,PR PARENTHESES MISSING IN DO STATEMENT - JST DP00 DO INPUT - LDA IOF - STA I - JST STXI - LDA D - STA DP,1 O2(IOF) = D - STA O2 O2 = D - LDA V5K3 ='30 - STA P - JST ET00 ENTER TRIAD 'T'. - JMP V5F -V5J CRA - STA A A = 0 - JST OA00 OUTPUT ABSOLUTE - JMP V5B -V5T1 PZE 0 -V5K1 OCT 27 -V5K2 OCT 32 -V5K3 OCT 30 -V5K4 BCI 1,R3 -V5K5 BCI 1,W4 -V5X DAC ** INPUT FORMAT - JST XN00 EXAM NEXT CHARACTER - SZE - JMP V5X5 GO TO INPUT ARRAY NAME - JST IS00 INPUT STMNT NO. -V5X2 LRL 32 OUTPUT DAC A - JST OB00 OUTPUT 0A - JMP* V5X RETURN -V5X5 JST NA00 INPUT NAME - JST AT00 ARRAY TEST - JMP V5X2 -* PRINT -V10 LDA V5K5 PRINTER -V10A STA NAMF+1 - JST NF00 SET UP REST 0F NAME - JST CN00 CALL NAME - JST V5X INPUT FORMAT - LDA TC - SUB K134 - SZE SKIP IF COMMA - JMP V5B2 - LDA D - STA V5T1 - JMP V5C5 -* -* -* ************************** -* *FORMAT * -* *INPUT FORMAT STRING * -* *INPUT NUMERIC FORMAT STR* -* *NON ZERO TEST STRING * -* ************************** -T0V2 PZE 0 -T2V2 PZE 0 -V2T0 EQU T0V2 -V2T2 EQU T2V2 -V2 LDA K17 - JST OK00 OUTPUT RACK - CRA - STA T0V2 TO = 0 - LDA LSTP IF LSTOP .NE. 0 - SZE - JMP V2K GO TO V2K -V2A JST SI00 INPUT FORMAT STRING - SZE - JMP V2B -V2A1 LDA TC - SUB K12 IF TC NOT MINUS - SZE - JMP V2F GO TO V2F - JST IN00 INPUT NUMERIC FORMAT STRING - CRA - STA TID TID = 0 -V2B LDA TC IF TC .NE. P - SUB K46 - SZE - JMP V2H GO TO V2H - JST SI00 INPUT FORMAT STRING - SZE - JST NZ00 IF (A) .NE. 0 -V2C LDA TC - CAS K52 IF TC = D,E,F, OR G - NOP - JMP *+2 - JMP V2DA - CAS K53 - JMP V2E5-2 - NOP - JST IN00 INPUT NUMERIC FORMAT STRING - JST NZ00 NON-ZERO STRING TEST - LDA K10 - JST TS00 PERIOD TEST -V2D JST IN00 INPUT NUMERIC FORMAT STRING -V2DA LDA TC IF TC = ) - SUB K4 - SZE - JMP V2E - JST CH00 - JST OK00 INPUT CHAR AND OUTPUT PACK - LDA T0V2 IF F4 + ( Z ( - SUB K101 GO TO V2E - STA T0V2 - SPL - JMP V2N ELSE, - JMP V2DA -* GO TO C/R TEST -V2E LDA TC IF TC =, - SUB K5 - SNZ - JMP V2A GO TO V2A - LDA K9 - JST TS00 / TEST - JMP V2A -V2E5 JST SI00 INPUT FORMAT STRING - SZE IF (A) NOT 0, - JMP V2B GO TO V2B - LDA DFL IF DFL .NE. ZERO, - SZE - JMP V2DA GO TO V2DA - JMP V2A1 -V2F LDA TC IF TC = H - CAS K48 - JMP *+2 - JMP V2P GO TO V2P -V2FB CAS K47 - JMP *+2 - JMP V2E5 - CAS K17 IF TC = (, - JMP *+2 - JMP V2Q GO TO V2Q - LDA TC IF TC .NE. A,I, OR L - CAS K49 A - JMP *+2 - JMP V2G - CAS K50 I - JMP *+2 - JMP V2G - SUB K51 L - SZE - JMP V2C -V2G JST IN00 INPUT NUMERIC FORMAT STRING - JST NZ00 NON-ZERO STRING TEST - JMP V2DA -V2H JST NZ00 NON-ZERO STRING TEST - LDA TC - SUB K48 - SZE - JMP V2F -V2J JST HS00 TRANSMIT HOLLERITH STRING - JMP V2E5 GO T0 V2E5 -V2K LDA LSTN IF LSTN = 0, - SZE - JMP *+3 - JST ER00 ERR0R, NO PATH - BCI 1,NF NO REFERENCE T0 FORMAT STATEMENT - LDA RPL LIF = RPL - STA LIF - CRA - STA A - STA AF - AOA - STA DF - LDA K201 = JMP 0 - JST OA00 OUTPUT ABS - JMP V2A GO T0 V2A -* -NZ00 DAC ** - LDA TID - SZE - JMP* NZ00 -NZ10 JST ER00 - BCI 1,NZ NON-ZERO STRING TEST FAILED -IN00 DAC ** - JST SI00 (A) = 0 IS ERROR CONDITION - SZE - JMP* IN00 - JMP NZ10 -SI00 DAC ** - CRA - STA TID ID = T2 = 0 -SI05 STA V2T2 - JST CH00 INPUT CHAR - JST OK00 OUTPUT PACK - LDA TC - SUB K60 ASC-2 ZERO - CAS K124 - JMP SI10 - NOP - SPL - JMP SI10 - STA TC - LDA TID TID = 10*TID+TC - ALS 3 - ADD TID - ADD TID - ADD TC - STA TID - LDA K101 T2 =1 - JMP SI05 -SI10 LDA V2T2 (A) = ERROR CONDITION OR NOT - JMP* SI00 -V2M JST ER00 - BCI 1,FR FORMAT STATEMENT ERROR -V2N EQU A1 -V2P LDA K101 - STA ID ID = 1 - JMP V2J GO T0 V2J -V2Q LDA T0V2 - AOA - STA T0V2 - SUB K103 - SZE - JMP V2A - JMP V2M -K46 OCT 320 0P -K47 OCT 330 0X -K48 EQU K14 0H -K49 OCT 301 0A -K51 OCT 314 0L -K52 EQU K11 0D -K53 OCT 307 0G -K50 EQU K43 0I -* -* -* ******* -* *STOP * -* *PAUSE* -* ******* -* PAUSE AND STOP CENERATE CALLS TO F$HT -T1W7 PZE 0 -T2W7 PZE 0 -W7 LDA K55 - STA T1W7 -W7A LDA K74 - STA NAMF+1 NAMF = F$HT - JST NF00 SET-UP REMAINING CHAR 0F NAME - JST XN00 EXAMINE NEXT CHAR - LDA TC - SUB CRET - SNZ - JMP W7C TC = C/R - NOTING FOLLOWING - JST IV00 INPUT INTEGER/VARIA8LE - LRL 32 - LDA K200 OUTPUT LDA - JST OB00 OUTPUT OA -W7C JST CN00 CALL NAME - CRA - STA DF DF = 0 - LDA T1W7 - STA ID - JST AI00 ASSIGN INTEGER CONSTANT - CRA OUTPUT DAC - JST OB00 OUTPUT OA OF ST/PA OR HT - LDA T1W7 - SUB K54 - SNZ - JMP C5 PA-NOT THE CASE - LDA RPL - STA AF OUTPUT JMP * - CRA - STA A CAUSE LISTING TO HAVE OCTAL ADDRESS - LDA K201 - JST OR00 OUTPUT RELATWE - JMP B6 -W8 LDA K54 - JMP W7+1 -K74 BCI 1,HT HT -K54 BCI 1,PA PA -K55 BCI 1,ST ST -* -* -* - R8 CALL -* GENERATES CALL DIRECTLY OR USES EXPRESSION TO -* ANALYZE AN ARGUMENT LIST. -R8 JST SY00 INPUT SYMBOL - LDA IU - SUB K101 =1 (SUB) - SZE SKIP IF IU=SUBR, - JST TG00 TAG SUB PROCRAM - LDA TC - SUB K17 ='250 ( ( ) - SZE - JMP *+3 -G2B LDA K101 SET A=1 BEFORE EXPRESSION - JMP G2A - CRA - IAB (B)=0 - LDA OMI2 =JST INSTR, - JST OB00 OUTPUT 0A - JMP A1 CR TEST -* ********************** -* *ASSIGNMENT STATEMENT* -* ********************** -G2 LDA K104 - JST NP00 FIRST NON-SPEC CHECK - JST II00 INPUT ITEM - LDA K102 SET A = 2 BEFORE EXPRESSION -G2A TCA - JST EX00 - JMP A1 -* -* -* ******** -* *RETURN* -* ******** -* OPTIMIZES EXIT CODING FOR FUNCTIONS TO MINIMIZE -* FETCHES OF THE FUNCTION VALUE. -R9 LDA SBF A = SBF, - STA A IF ZERO, GO TO ERROR - SZE - JMP *+3 - JST ER00 - BCI 1,RT RETURN NOT ALLOWED IN MAIN PROGRAM - LDA SFF ELSE, IF SFF = 0, - SNZ - JMP R9C GO TO R9C - CAS K101 IF SFF = 1, GO TO R98 - JMP *+2 - JMP R9B - STA AF OUTPUT REL JMP TO 1ST RETN - LRL 32 - STA A SET A=0 TO OUTPUT OCTAL ADDR ON LISTING - LDA K201 - JMP R9A -R9B IAB - LDA RPL SFF = RPL - STA SFF - LDA K56 0UTPUT ITEM (F,A) - JST OM00 -R9C LRL 32 - STA A SET FOR OCTAL ADDHESS IW LISTING - STA AF SET RELATIVE ADDRESS TO ZERO - LDA K206 JUMP I, 0 -R9A JST OR00 OUTPUT REL - JMP B6 EXIT -K56 OCT 31 P CODE FOR 'F' (FETCH) -* -* -* ******************** -* *STATEMENT FUNCTION* -* ******************** -* OLD ASSIGN VALUES ARE SAVED IN SFTB AND ARE -* RESTORED AT COMPLETION. -G1T0 PZE 0 -G1T1 PZE 0 -G1 LDA K103 (A) = 3 - JST NP00 FIRST NON-SPEC CHECK - JST SY00 INPUT SYMBOL - JST LO00 DEFINE LOCATION - LDA K103 - STA I - JST GE00 GENERATE SUBPROGRAM ENTRANCE - LDA I - STA G1T1 T1 = I - LDA K16X '=' TEST - JST TS00 - JST II00 INPUT ITEM - CRA - JST EX00 EXPRESSION - LDA G1T1 - STA I I = T1 - IRS TCF TCF = TCF+1 -G1A JST STXI - LDA SFTB+2,1 - STA A - LDA SFTB+0,1 - IAB - JST STXA SET R TO A - IAB - STA DP,1 - JST STXI SET R TO I - LDA SFTB+1,1 - IAB - JST STXA SET R TO A - IAB - STA DP+1,1 - LDA I - SUB K103 I = I-3 = 0 - STA I - SUB K103 - SZE - JMP G1A NO, GO TO G1A - LDA T1NP - STA A - LLL 16 - LDA OMJ1 - JST OB00 - JST TG00 TAG SUBPROGRAM - JMP A1 GO TO C/R TEST -* - W5 END -* *************** -* *END PROC6SSOR* -* *************** -* FIRST CHECK SUBPROGRAMS FOR CORRECT USAGE, THEN -* GENERATE MAP AND STRING BACK VARIABLES -* AND CONSTANTS. -T1W5 PZE -W5 LDA BDF IF BLOCK DATA, - SZE - JMP W5K GO TO W5K - LDA SBF IF SBF NOT ZERO - STA A INDICATES SUBROUTINES - SZE OR FUNCTION, - JMP W5M GO TO W5M -W5B CRA - STA A A = J=0 - JMP W5H -W5D JST FA00 FETCH ASSIGNS - JST STXA - LDA NT - SZE IF NT=L (CONSTANT) - JMP W5O GO TO W5O - LDA IU - SUB K101 IF IU=1 - SZE INDICATES VARIABLE, - JMP W5T GO TO W5T -W5F LDA RPL SAVE RPL - STA T1W5 RPL=-AF (INHIBIT LISTING) - LDA AF - SSM - STA RPL - CRA - JST OR00 OUTPUT REL - LDA T1W5 RESTORE RPL - STA RPL -W5H LDA A A=A+5 - ADD K105 - STA A - SUB ABAR IF A=ABAR, (DONE) - SUB K105 - SZE - JMP W5D ELSE, GO TO W5D -W5J JST FS00 FLUSH BUFFER - LDA SBF - SZE - LDA W5Z1 - ERA W5Z2 - STA OCI - LDA SBF - SZE - LDA W5Z3 - STA OCI+1 - LDA K106 - STA OCNT - JST FS00 - JMP A051 GO TO INITIALIZE -W5K LDA RPL IF RPL NOT ZERO, - SNZ - JMP W5J - JST ER00 ERROR-CODE GENERATED - BCI 1,BD IN A BLOCK DATA SUBPROGRAM -W5M JST FA00 FETCH ASSIGNS - LDA SFF IF FUNCTION, - SZE - JMP W5N GO TO W5N - JST NU00 NO USE TEST - JST STXA - LDA DP,1 IF NO ERROR, - SSM NT(A)=1 - STA DP,1 - JMP W5B GO T0 W5B -W5N LDA IU - SUB K102 IU MUST BE VAR/CON, - SNZ ELSE, - JMP W5B - JST ER00 ERROR-FUNCTION - BCI 1,FD NAME NOT DEFINED BY AN ARITHM, STATEMENT -W5O LDA IU IF IU=VAR/CON - SUB K102 - SZE - JMP W5H - LDA AT AND AT = STR/REL - SUB K103 A "STRING" REQ'D. - SZE - JMP W5H -W5P LDA D0 IF D0 IS 4, THE - SUB K104 CONSTANT IS COMPLEX, - SZE OTHERWISE - JMP W5Q GO TO W5Q - LDA AF - JST OS00 OUTPUT STRING - JST STXA - LDA DP+2,1 OUTPUT 4 WORDS - JST W5X OF CONSTANT - LDA DP+3,1 - JST W5X - LDA NT - SNZ - JMP W5S - LDA A INCREMENT A - ADD K105 - STA A - JST STXA - JMP W5S -W5Q LDA AF - JST OS00 OUTPUT STRING - JST STXA - LDA D0 IF D0=1, - SUB K101 INDICATES INTEGER, - SNZ - JMP W5R GO TO W5R -W5S LDA DP+2,1 OUTPUT TWO WORDS - JST W5X FLOATING POINT CONSTANT - LDA DP+3,1 - JST W5X - LDA D0 IF DOUBLE PRECISION, - SUB K103 - SZE - JMP W5H -W5R LDA DP+4,1 OUTPUT THE 3RD WORD - JST W5X - JMP W5H GO TO W5H -W5T LDA AT - CAS K103 - JMP W5F STRONG VARIABLE (IU = NON 0) - JMP W5T5 - CAS K102 TEST FOR STG ABS ADDRESS - OCT 17400 - JMP *+2 - JMP W5F NO - LDA DP+4,1 TEST FOR PREFIX G - ANA *-4 - SUB *-5 - SZE - JMP W5F STRONG VARIABLE (IU = NON 0) -W5T5 LDA IU - SZE - JMP W5P - JST ER00 - BCI 1,US -W5X DAC ** - LRL 16 - STA DF - IAB - JST OA00 OUTPUT ABS - JST STXA REST "A" - JMP* W5X EXIT -W5Z1 EQU K100 000377 -W5Z2 EQU K122 040000 -W5Z3 EQU K116 177400 -* -* -* -* -* -* ************************ -* *INPUT CHAR/OUTPUT PACK* -* ************************ -PO00 DAC ** - JST CH00 INPUT CHAR - JST OK00 OUTPUT PACK - JMP* PO00 RETURN -* ************************ -* *TRANS HOLLERITH STRING* -* ************************ -* FORM HOLLERITH STRING, CHARACTER COUNT IN ID 0N -* ENTRY. C/R WILL ALSO TERMINATE STRING. -HS00 DAC ** -HS10 JST IC00 INPUT 1 CHARACTER - CAS CRET CHECK FOR CHAR = C/R - JMP *+2 - JMP HS15 HOLLERITH STRING EXTENDS PAST END 0F CARD - JST OK00 OUTPUT PACK THE CHARACTER - LDA ID - SUB K101 REDUCE CHARACTER COUNT BY 1 - STA ID - SZE - JMP HS10 INPUT MORE CHARACTERS - JMP* HS00 -HS15 JST ER00 - BCI 1,HS HOLLERITH STRING EXTENDS OVER STATEMENT -* -* -* ********** -* *DO INPUT* -* ********** -* SET UP DO TABLE ENTRIES. -DP00 DAC ** - LDA D D = D+5 - ADD K105 IFLG = NON-ZERO - STA IFLG - STA D - ADD DO I = D0+D - STA I - JST STXI - LDA A DP (1-4) = (B) - STA DP-2,1 DP (1-2) = A - IAB - STA DP-4,1 - JST IV00 INPUT INT VAR/CON - LDA K134 = , - JST TS00 COMMA TEST - JST STXI - LDA A - STA DP,1 DP(I) = INITIAL VALUE POINTER - JST IV00 INPUT INT VAR/CON - JST STXI - LDA A - STA DP-1,1 DP (I-1) = A - FINAL VALUE POINTER - LDA TC - SUB K134 = , - SZE IF THIRD TERM - JMP DP20 - JST IV00 READ AND ASSIGN, -DP10 JST STXI - LDA A - STA DP-3,1 DP(I-3) = INCREMENT POINTER - CRA - STA IFLG CLEAR IFLAG - JMP* DP00 EXIT -DP20 LDA K101 - STA ID THIRD TERM = 1 - JST AI00 ASSIGN CONSTANT - JMP DP10 -* *************** -* *DO INITIALIZE* -* *************** -* GENERATE DO INITIALIZATION CODE. -DS00 DAC ** - JST STXI ESTABLISH I - LDA DP,1 A = DP (I) - STA A - LDA K200 - JST DS20 LOAD - LDA INITIAL VALUE - LDA DP-2,1 - STA A A = DP (I-2) - LDA RPL - STA DP,1 SET RETURN ADDRESS INTO DP(I) - LDA K202 - JST DS20 STORE - STA VARIABLE NAME - JMP* DS00 -* OUTPUT OA SUBROUTINE -DS20 DAC ** - IAB - LLL 16 SET B = 0 - JST OB00 OUTPUT OA - JST STXI RESTORE I - JMP* DS20 RETURN -* -DS90 PZE 0 -* -* **************** -* *DO TERMINATION* -* **************** -* GENERATE DO TERMINATION CODE. -DQ00 DAC ** - JST STXI - LDA DP-2,1 - STA A - LDA K200 - JST DS20 OUTPUT LDA VARIABLE NAME - LDA DP-3,1 - STA A - LDA K203 - JST DS20 OUTPUT ADD INCREMENT - LDA DP-1,1 - STA A - LDA OMK9 - JST DS20 OUTPUT CAS FINAL VALUE - CRA - STA A - LDA RPL - ADD K103 - STA AF - LDA DP,1 - STA DS90 - LDA OMI5 JUMP *+3 - JST OR00 OUTPUT REL - LDA DS90 - STA AF - LDA OMI5 JMP RPL (SAVED) - POINTS TO 'STA' INST. - JST OR00 OUTPUT REL - LDA OMI5 OUTPUT JMP RPL (SAVED) - JST OR00 OUTPUT REL - JMP* DQ00 -* ************ -* *EXPRESSION* -* ************ -* THE RESULTANT OUTPUT IS A BUILT UP AOIN -* TABLE THAT IS FURTHER PROCESSED BY SCAN. -T0EX PZE 0 -EXT0 EQU T0EX -T1EX PZE 0 -T2EX PZE 0 -T3EX PZE 0 -T5EX PZE 0 -T6EX PZE 0 -EXT7 PZE 0 -T9EX PZE 0 -EX00 DAC ** - STA F F = (A) - LDA A SAVE POINTER TO FIRST VARIABLE - STA TRFA FOR LATER POSSIBLE TRACING - LDA D I = D+D0+10 - ADD DO - ADD K125 =8 - STA I - JST EX99 DATA POOL CHECK - JST STXI - CRA - STA EXT0 T0 = 0 - STA B B = 0 - STA EXT7 T7 = 0 - ADD EX92+12 - LGL 9 O(1-2) = '=' - STA DP-1,1 0 (I) = 0 - CMA - STA IFLG IFLM NOT 0 - LDA L0 - STA DP-2,1 O(I-2) = L0 -EX10 JST STXI - CRA - STA T1EX T1 = 0 - STA DP,1 AOIN(I) = T(1) = 0 - STA DP+1,1 - LDA IM IF IM NOT ZERO, - SZE - JMP EX50 GO TO EX50 - LDA K106 - TCA - STA 0 -* PERFORM TABLE SEARCH -EX11 LDA TC GO TO ROUTINE ACCORDING - SUB EX90+6,1 TO TC. - SNZ IF NO MATCH, ERROR - JMP EXI1 - IRS XR - JMP EX11 - JST STXI - LDA LIBF SPECIAL LIBRARY FLAG - SZE - JMP EX39 - JMP EX95 ERROR CONDITION -EXI1 LDA EX91+6,1 - STA 0 - JMP 0,1 PROCESS LEADING OPERATOR -* SPECIAL OPERATOR FLAG SET WHEN COMPILING THE FORTRAN -* LIBRARY IN WHICH CASE THE OPERATIONS ( A= ) AND -* ( =A ) ARE REQUIRED, THIS LOGIC WILL ALLOW THESE -* TO BE PROCESSED WITHOUT GIVING AN ERROR MESSAGE IF THE -* SPECIAL LIBRARY FLAG, (LIBF) IS SET TO NON-ZERO, -* -EX12 LDA B TC = ( - ADD K109 B = B+16 - STA B SXF = NON-ZERO - STA SXF -EX14 JST II00 INPUT ITEM - JST STXI - JMP EX10 GO TO EX10 -EX16 JST STXI TC = * - LDA TC - LGL 9 OI (I-2) = *, B+13 - ADD B - ADD K129 - ERA DP-1,1 - SSP - SNZ - JMP *+3 - JST ER00 NO, CONSTR ERROR - BCI 1,PW * NOT PRECEDED BY ANOTHER * - LDA K109 (E = '20) - LGL 9 - IMA DP-1,1 - ANA K118 ='777 - ADD K101 - ERA DP-1,1 CHAJNE * TO ** - STA DP-1,1 - JMP EX14 GO TO EX14 -EX18 LDA K102 =2 - STA TC SET TC TO - - LDA K125 =8 - STA T1EX T1 = 8 - JST STXI - LDA DP-1,1 - ANA K118 - SUB B 8 .GT. I (I-2) -B - SUB T1EX - SPL - JMP *+3 -EX19 JST ER00 NO, ERROR - BCI 1,NT LOGICAL .NOT. NOT A UNARY OPERATOR -EX20 LDA T0EX YES - SZE T (0) = 0 - JMP EX34 -EX22 LDA B YES, - ADD F B + + (5) .GT. 0 - SPL NO, ERROR - JMP EX96 -EX24 JST STXI - LDA TC - LGL 9 - ADD T1EX - ADD B - STA DP+1,1 OI(I) = TC , T1+B - JST EX99 DATA POOL CHECK - JMP EX14 -EX26 JST STXI - LDA DP-1,1 - ANA K118 IF I (I-2) .LT. B - CAS B - JMP EX97 ERROR-----MULTIPLE + OR - SIGNS - NOP -EX30 LDA K131 SET INDEX TO - STA 0 SEARCH OPERATOR TABLE FOR TRAILING -EX31 LDA EX92+14,1 OPERATOR AFTER HAVING ENCOUNTERED AN - SUB TC ITEM 0R A NEGATE, - SZE - JMP EX32 - LDA EX93+14,1 - STA *+3 - JST STXI - JMP* *+1 - DAC ** -EX32 IRS XR CONTROL OPERATOR LOOP - JMP EX31 CONTINUE -EX34 LDA B IF B = 0 - SUB EXT7 - SZE - JMP EX40 NO, GO TO EX40 - LDA T0EX IF T (0) = 0 - SZE - JMP EX38 NO, GO TO EX38 -EX35 CRA - STA IFLG IFLG = 0 - LDA F - AOA - SMI F . GE. -1 - JMP EX36 YES - JMP* EX00 RETURN - NO -EX36 JST CA00 SCAN - JST OT00 OUTPUT TRIADS - JMP* EX00 RETURN -EX38 JST STXI - LDA B - SUB K109 - STA B - LDA K103 - STA MFL - LDA T0EX - LGL 9 O (I) = T (0) - ADD B I (I) = B+9 - ADD K124 I = I+2 - STA DP+1,1 - JST EX99 DATA POOL CHECK - CRA - STA T0EX T0 = 0 - STA EXT7 T7 = 0 -EX39 LDA L0 - STA A A = L0 - STA IM IM NOT EQ 0 - JMP EX10 -EX40 LDA TC TC 0 , - CAS K5 ='254 (,) IN BCD MODE - JMP *+2 - JMP EX41 - SUB K134 =17 - SZE - JMP EX44 NO, GO TO EX44 -EX41 LDA I -EX42 SUB K102 - STA XR B VS. I (J) - LDA DP+1,1 - ANA K118 - CAS B - JMP *+3 - JMP EX24 EQUAL, GO TO EX24 - JMP* EX00 LESS, RETURN - LDA XR GREATER, REPEAT LOOP - JMP EX42 -EX44 JST IP00 ) - INPUT OPERATOR - JMP EX30 GO TO EX30 -EX46 LDA* A - STA T6EX IF O1(O1(A)) = L(0) - LDA* T6EX - CAS L0 - JMP *+2 - JMP EX34 GO TO EX34 - STA O2 O2 = L0 -EX48 JST ET00 ENTER TRIAD - JMP EX34 -EX50 JST STXI - LDA A A(I) = A - STA DP,1 - LDA IU IU = SUB OR ARR - SLN - JMP EX30 NO, GO TO EX30 - LDA TC - SUB K17 TC = ( - SZE - JMP EX76 NO, GO TO EX76 - LDA B YES, B = B+16 - ADD K109 - STA B - LDA IU IU = ARR - SUB K103 - SZE - JMP EX75 NO, GO TO EX75 - CRA - STA DP,1 A(I) = 0 - STA X4 X4 = 0 - STA T3EX T3 = 0 - STA K T5 = A - LDA D0 - STA T9EX T9 = D0 - LDA A - STA T5EX T5 = A - LDA AT - SUB K105 AT = DUM - SZE - JMP EX74 NO, GO TO EX74 - CRA - STA T2EX YES, T (0) = 0 - JST EX99 DATA POOL CHECK - JST STXI - LDA A - STA DP,1 A(I) = A - LDA K132 OI (I) = A, 11 - LGL 9 - ADD K124 - STA DP+1,1 I=9 -EX54 LDA D0 IF D0 = 1, GO TO EX56 - SUB K101 - SNZ - JMP EX56 - JST EX99 DATA POOL CHECK - JMP *+2 -EX55 IRS K K = K+1 - LDA K - STA XR - LDA X,1 - STA T6EX T6 = X (K) - JST STXI - LDA T6EX - STA DP,1 O(I) = * - LDA K103 I (I) = T3+13 - LGL 9 T3 = T3+16 - ADD T3EX A (A) = T6 - ADD K129 =13 - STA DP+1,1 - ANA K118 - ADD K103 - STA T3EX T3 = A(A) -EX56 JST IV00 INPUT INTEGER VARIABLE - JST EX99 DATA POOL CHECK - JST STXI - LDA A A(I) = A - STA DP,1 - LDA NT - SZE - JMP EX68 CONSTANT ENCOUNTERED - JST UC00 UNINPUT COLUMN - JST DN00 INPUT DO NOT ASSIGN - SNZ - JMP EX57 IM = 0 - SUB K101 - SNZ - JMP EX57 IM * INTEGEH - JST ER00 - BCI 1,SU SUBSCRIPT INCREMENTER NOT A CONSTANT -EX57 JST STXI - LDA K101 - LGL 9 - ADD T3EX - ADD K127 - STA DP+1,1 O(1) = +, I(I) = T3+11 - JST EX99 DATA POOL CHECK -EX58 LDA T9EX - STA D0 RESET D(0) - LDA ID SUBSCRIPT SIZE - SUB K101 ID = ID-1 - STA ID - SNZ IF ZERO, GO TO EX60 - JMP EX60 - LDA K - STA 0 - LDA D0,1 D(K) = 0 - SNZ - JMP EX67 YES - (DUMMY DIMENSION) - IAB - LDA ID - JST IM00 - ADD T2EX - STA T2EX T2 = T2+ID*D(K) -EX60 LDA T9EX - STA D0 RESET D(0) - LDA K - STA 0 - LDA X+2,1 X(K+2) = 0 - SNZ - JMP EX62 YES - FINISHED - LDA K134 =17 - JST TS00 COMMA TEST - LDA D0+1,1 - IAB - LDA D0,1 - JST IM00 - STA D0+1,1 D(K+1) = D(K+1)*D(K) - JMP EX55 -EX62 JST STXI - LDA DP-1,1 DOES O(--2) = * - SSP - LGR 9 - CAS K103 - JMP *+2 - JMP EX66 YES. - SNZ NO. - JMP EX64 O(I-2) = 0 - YES - CAS K132 DOES O(I-2) = A - JMP EX63 - JMP *+2 YES - JMP EX63 - LDA T2EX IS T2 = 0 - SNZ - JMP EX65 YES (DUMMY ARRAY (1,1,1)) -EX63 LDA K101 - STA DP-1,1 01(I-2) = 1 - LDA T2EX A(I) = T2 - STA DP,1 - LDA K137 0='X' ('24), I=2 - STA DP+1,1 - CRA - STA DP+3,1 O1(1+2) = 0 - LDA T5EX - STA DP+2,1 A(I+2) = T5 - JST EX99 DATA POOL CHECK - JST CA00 SCAN - LDA O1 - STA A A = O1 - JST STXA - LDA DP+2,1 S(A) = NON-ZERO - SSM - STA DP+2,1 S(A) = 1 - JMP EX44 -EX64 LDA L0 - STA DP,1 A(I) = L0 - JST EX99 DATA POOL CHECK - JST STXI - JMP EX63 -EX65 LDA I - SUB K104 - STA I I = I-4 - LDA T5EX - STA DP-4,1 A (I) = T5 - JMP EX44 -EX66 LDA I - SUB K102 - STA I I = I-2 - JMP EX62 ASSIGN INT CONSTANT -EX67 JST AI00 - JST STXI SET XR TO I - LDA A - STA DP,1 A(I) = A - LDA K101 - LGL 9 - ADD T3EX - ADD K127 - STA DP+1,1 OI(I) = +, T3+11 - JST EX99 DATA POOL CHECK - JMP EX60 -EX68 LDA TC IS TC - CAS K103 = * - JMP *+2 - JMP *+2 - JMP EX58 NO - LGL 9 - ADD T3EX - ADD K129 =13 - STA DP+1,1 OI(I) = *, T3+13 - JST IR00 INPUT INTEGER VAR/CON - JMP EX56+1 -EX69 CRA SET LISTING FOR OCTAL ADDR - STA A - LDA OMI5 JMP 0 INSTRUCTION - STA DF SET LISTING FOR SYMBOLIC A INSTR, - JST OA00 OUTPUT ABSOLUTE - LDA RPL - STA O2 - LDA K138 - STA P P = H - JST ET00 ENTER TRIAD - JST HS00 TRANSFER HOLLERITH STRING - LDA CRET (A) = C/R - JST OK00 OUTPUT PACK - CRA - STA 0 SET LISTING FOR OCTAL ADDR. - STA A SET LISTING FOR OCTAL ADDR. - LDA O2 - SUB K101 - JST OS00 OUTPUT STRING RPL-1 - JST CH00 INPUT CHARACTER - JST FN00 - JST STXI RESET INDEX TO I - LDA L - STA DP,1 A(I) = L - JMP EX76 -EX74 LDA AF - STA T2EX T2 = AF - JMP EX54 GO TO EX54 -EX75 LDA K134 - STA TC TC = , - JMP EX24 GO TO EX24 -EX76 LDA DP-1,1 - LGR 9 - ANA K133 - SUB K134 - SNZ - JMP EX34 WITHIN AN ARGUMENT LIST - JST ER00 - BCI 1,AG SUBROUTINE OR ARRAY NAME NOT IN ARG. LIST -EX78 LDA K127 -EX79 STA T1EX T (1) = 11 - JMP EX22 -EX80 LDA K129 T (1) = 13 - JMP EX79 -EX81 LDA K106 - STA T1EX T (1) = 6 - JMP EX20 -EX82 LDA K104 T (1) = 4 - JMP EX81+1 -EX83 LDA T0EX T (0) =0 - SZE - JMP EX84 - LDA TC YES, - STA T0EX T (0) = TC - LDA EX92+1 - STA TC TC = - - LDA B - ADD K109 - STA B - STA EXT7 - LDA *+2 - JMP EX79 - DEC -5 -EX84 JST ER00 ERROR - BCI 1,RL MORE THAN 1 RELATIONAL OPERATOR -EX85 LDA F - ADD K102 T (5) = T (5) +2 = B = 0 - STA F - ADD B - SNZ - JMP EX24 - JST ER00 ERROR - BCI 1,EQ MULTIPLE ='S, OR EXPRESSIUN TO LEFT OF = -EX90 OCT 250 ( - OCT 3 * - OCT 5 NOT - OCT 1 + - OCT 2 - - OCT 310 H -EX91 DAC EX12 ( - DAC EX16 * - DAC EX18 NOT - DAC EX26 + - DAC EX26 - - DAC EX69 H -EX92 OCT 1 + - OCT 2 - - OCT 3 * - OCT 4 / - OCT 6 AND - OCT 7 OR - OCT 15 NE - OCT 12 EQ - OCT 14 GT - OCT 10 LT - OCT 13 GE - OCT 11 LE - OCT 16 = - OCT 16 = (ERROR) -EX93 DAC EX78 + - DAC EX78 - DAC EX80 * - DAC EX80 / - DAC EX81 AND - DAC EX82 OR - DAC EX83 NE - DAC EX83 EQ - DAC EX83 GT - DAC EX83 LT - DAC EX83 GE - DAC EX83 LE - DAC EX85 = - DAC EX34 NONE OF THESE -EX95 JST ER00 - BCI 1,OP MURE THAN ONE OPERATOR IN A ROW -EX96 JST ER00 ERROR - BCI 1,PA OPERATOR MUST BE WITHIN PARENTHESES -EX97 JST ER00 ERROR - BCI 1,UO MULTIPLE + OR - SIGNS NOT AS UNARY OPS -* BUMP THE I COUNT BY TWO AND CHECK FOR DATA OVERFLOW -EX99 DAC ** - IRS I - IRS I - LDA I - AOA - CAS L - NOP - JMP AS50 - JMP* EX99 -K133 OCT 77 -K130 DEC -6 -K141 DEC 33 -K PZE 0 -KM8 DEC -8 -* -* -* -* -* ****************** -* *SCAN * -* *TRIAD SEARCH * -* *TEMP STORE CHECK* -* ****************** -T0CA PZE 0 -T1CA PZE 0 -T2CA PZE 0 -T9CA PZE 0 -* THE AOIN TABLE IS PROCESSED FROM THE BOTTOM -* UP AND ENTRIES ARE FORMED FOR INCLUSION -* IN THE TRIAD TABLE, LEVELS ARE USED -* TO CONTROL THE ORDER OF ENTRY INTO -* THE TRIADS. SIGN CONTROL IS ALSO -* ACCOMPLISHED IN THIS ROUTINE. -CA00 DAC ** - LDA L0 - STA ACCP INDICATE EMPTY ACCUM -CA04 JST STXI ESTABLISH I - STA T1CA T1 = I - LDA DP-1,1 - ANA K118 IF I (I-2) = 0, -* OR .LT. I (I) - STA T9CA - LDA DP+1,1 - ANA K118 - CAS T9CA - JMP CA08 GO TO CA08 - NOP - LDA I - SUB K102 - STA I I = I-2 - STA 0 -CA08 LDA DP+3,1 - ERA DP+1,1 - STA T0CA - LDA DP+1,1 - ANA K118 - STA T2CA - LDA DP+1,1 - SSP - LGR 9 P = O (I) - STA P - CAS K102 IF P IS NOT * OR /, GO TO CCA10 - CAS K105 - JMP CA10 - JMP CA10 - JMP CA14 GO T0 CA14 -CA10 LDA T0CA - SMI - JMP CA13 - LDA KM8 - IMA XR - IAB - LDA P - CAS CA90+8,1 - JMP *+2 - JMP *+4 - IRS XR - JMP *-4 - JMP CA45 - LDA CA91+8,1 - STA P - IAB - STA XR -CA13 LDA K130 - IMA XR - IAB - LDA P - CAS CA90+8,1 - JMP *+2 - JMP CA50 - IRS XR - JMP *-4 - IAB - STA XR - IAB - LDA DP+1,1 - JMP *+2 -CA50 CRA - STA T0CA - IAB - STA XR -CA14 LDA DP,1 - STA O1 O1=A(I) - LDA DP+2,1 - STA O2 O2 = A (I+2) - LDA T2CA - SNZ - JMP CA37 IF ZER0, GO TO CA37 - LDA DP-1,1 - SSP - LGR 9 - STA T1CA - LDA DP-1,1 - ANA K118 IF T2 .GT. I (I-2) - SUB T2CA - SPL - JMP CA18 - SZE - JMP CA04 - LDA O2 - SUB ACCP - SZE - JMP CA04 - LDA P - SUB K103 - SMI - JMP CA39 - LDA T1CA - SUB P - SZE - LDA K101 GO TO - ADD K101 P = - OR + - STA P -CA18 LDA I - STA 0 J=I -CA20 LDA DP+2,1 - STA DP,1 AOIN(J) = AOIN(J+2) - LDA DP+3,1 - STA DP+1,1 - SSP - SNZ - JMP CA22 - IRS XR J = J+2 - IRS XR - JMP CA20 -CA22 JST STXI - LDA DP+1,1 - SSP IF O (I) = , - LGR 9 - CAS P - JMP CA24 - CAS K134 - JMP CA24 - JMP CA30 GO TO CA30 -CA24 JST ST00 TRIAD SEARCH - LDA P - CAS K132 IF P = +,*, AND, OR - JMP CA28 - JMP CA37 GO TO CA37 - CAS K107 - JMP CA28 ELSE, GO TO CA26 - JMP CA37 - CAS K106 - JMP CA28 - JMP CA37 - CAS K103 - JMP CA28 - JMP CA37 - CAS K101 - JMP CA26 -* -* -* - JMP CA37 -CA26 CAS K102 - JMP *+2 IF P = - - JMP CA35 GO TO -CA28 LDA O1 - JST TC00 TEMP STORE CHECK -CA30 LDA O2 - JST TC00 TEMP STORE CHECK -CA31 JST ET00 ENTER TRIAD -CA32 JST STXI - LDA O1 - STA DP,1 - LDA DP+1,1 - LRL 15 - LDA T0CA - LGR 15 - LLL 15 - STA DP+1,1 - LDA T2CA IF T2 NOT ZERO, - SZE - JMP CA04 GO TU CA04 - JMP* CA00 ELSE, RETURN -CA35 LDA T0CA - ERA ='100000 - STA T0CA -CA37 LDA O2 - IMA O1 O1 * = O2 - STA O2 - SNZ IF 02 = 0, - JMP CA32 GO TO CA32 -* -* -* - JST ST00 TRIAD SEARCH - LDA T0CA - SMI - JMP CA28 GO TO CA28 - LDA P - JMP CA26 ELSE, GO TO CA26 -CA39 SUB K128 - SNZ IF P = , OR - JMP CA04 - LDA T1CA - SUB K104 - SZE ELSE, - JMP CA18 GO TO CA18 - JMP CA04 -CA45 LDA T1CA - STA I I = T1 - STA T2CA - CRA - STA T0CA * * * * * * * * * * * - STA O2 O2 = C = 0 - SUB K110 P = C - STA P - JMP CA24 GO TO CA24 -* IF THE CURRENT TRIAD (IN WORKING STORAGE) MATCHES -* ANY TRIAD TABLE ENTRY, EXIT WITH THE -* POINTER VALUE OF THE MATCHING ENTRY -* (THIS ACCOMPLISHES ELIMINATION OF REDUNDANT -* SUBEXPRESSION CALCULATIONS. -ST00 DAC ** TRIAD SEARCH - LDA F - ADD K103 - SZE - JMP ST10 GO TO ST10 -ST05 LDA P ELSE, IF P = X - SUB K139 - SNZ - JMP CA31 GO TO CA31 - LDA O1 ELSE, IF 01=ACCP - SUB ACCP - SNZ - JMP CA30 GO TO CA30 - JMP* ST00 ELSE, RETURN -ST10 LDA L0 - STA XR -ST20 LDA XR - SUB K103 - STA XR J = J-2 - SUB L IF J .LT. L - SPL - JMP ST05 GO TO ST05 - LDA O2 - SUB DP,1 IF O1/P/O2 .NE. O1/P/O2(J) - SZE - JMP ST20 GO TO ST20 - LDA DP+2,1 - SSP EXTRACT OFF STORE BIT - SUB P - SZE - JMP ST20 - LDA O1 - SUB DP+1,1 - SZE - JMP ST20 O1 = J - LDA XR - STA O1 - JST STXI ESTABLISH I - JMP CA32 GO T0 CA32 -* IF J IS A REFERENCE TO A TRIAD , THE TEMP -* STORE BIT 0F THE REFERENCED TRIAD IS SET.) -TC00 DAC ** TEMP STORE CHECK - STA XR - LDA ABAR - SUB XR - SMI IS J .GR. ABAR - JMP* TC00 NO. - LDA DP+2,1 YES. - SSM - STA DP+2,1 S(J) = 1 - JMP* TC00 -CA90 OCT 1,2,11,10,13,14,12,15 -CA91 OCT 2,1,13,14,11,10,12,15 -* -* -* ************* -* *ENTER TRIAD* -* ************* -* STORE CURRENT TRIAD INTO THE NEXT TRIAD ENTRY -* LOCATION. -ET00 DAC ** - JST SAV - LDA L - SUB K103 =3 - STA L L=L-3 - STA ACCP SET ACCUM PTR TO LAST TRIAD ENTRY - STA 0 J=L - LDA P - STA DP+2,1 P(J) = P - LDA O1 - STA DP+1,1 O1(J) = O1 - LDA O2 - STA DP,1 O2(J) = O2 - LDA 0 - STA O1 O1=J - JST RST - JMP* ET00 -ACCP DAC ** ACCUM POINTER -* -* -SFTB BSS 36 SUBFUNCTION TABLE -* ************************** -* *GENERATE SUBPRO ENTRANCE* -* ************************** -* OUTPUT SUBPROGRAM ENTRANCE CODE , INCLUDING THE -* CALL TO ARGUMENT ADDRESS TRANSFER. -T0GE PZE 0 -GE00 DAC ** - CRA - STA T0GE - LDA K17 ( TEST - JST TS00 -GE10 JST NA00 INPUT NAME - LDA I IFF I=0, - SNZ - JMP GE20 GO TO GE20 - CAS K141 - NOP - JMP GE30 MAKE ENTRY IN SFTB TABLE - ADD K103 - STA I IF FULL, GO TO GE30 - JST STXA SET XR TO A - LDA DP,1 - IAB - JST STXI ESTABLISH I - IAB - STA SFTB,1 - JST STXA SET XR TO A - LDA DP+1,1 - IAB - JST STXI SET XR TO I - IAB - STA SFTB+1,1 - LDA A - STA SFTB+2,1 - JST STXA SET XR TO A - CRA - STA DP+1,1 CLEAR OLD USACE -GE20 LDA K105 - IAB - LDA RPL - ADD T0GE - ADD K103 (B) = DUM - JST AF00 DEFINE AFT (A=RPL+T0+3) - IRS T0GE T0 = T0+1 - LDA K134 - SUB TC IF TC = , - SNZ - JMP GE10 GO TO GE10 - JST IP00 INPUT OPERATOR - CRA - STA DF - JST OA00 OUTPUT ABS (0) - LDA T0GE - STA ID ID = T0 - LDA K69 - STA NAMF+1 NAMF = AT - JST NF00 FILL IN REMAINING NAME - JST OL00 OUTPUT OBJECT LINK - LDA T0GE - TCA - STA T0GE - CRA - JST OA00 OUTPUT NUMBER OF ARGS - IRS T0GE OUTPUT SPACE FOR ARG. ADDR. - JMP *-3 - JMP* GE00 RETURN -GE30 JST ER00 CONSTR, ERROR - BCI 1,AE -K69 BCI 1,AT AT -* -* **************** -* *EXCHANGE LINKS* -* **************** -* CL SUBA IS INTERCHANGED WITH CL SUBF -EL00 DAC ** - JST STXA - LDA DP,1 - STA EL90 CL (F) == CL (A) - LDA F - STA 0 - JST EL40 - JST STXA - JST EL40 - JMP* EL00 -EL40 DAC ** - LDA DP,1 - IMA EL90 - ANA K118 - IMA DP,1 - ANA K119 - ADD DP,1 - STA DP,1 - JMP* EL40 -EL90 PZE 0 -* -* -* ***************** -* *NON COMMON TEST* -* ***************** -NM00 DAC ** NON-COMMON TEST - LDA AT - SUB K104 - SZE - JMP* NM00 - JST ER00 - BCI 1,CR ILLEGAL COMMON REFERENCE -* -* -* ************************** -* *NON DUMMY OR SUBPRO TEST* -* ************************** -ND00 DAC ** - LDA AT TEST - SUB K105 - SZE - JMP ND10 - JST ER00 - BCI 1,DA ILLEGAL USE OF A DUMMY ARGUMENT - JMP* ND00 -ND10 JST NS00 - JMP* ND00 -* -* -* ***************** -* *INPUT SUBSCRIPT* -* ***************** -SCT0 PZE 0 -SC00 DAC ** - STA SCT0 T0 = (A) - CRA - STA NS - STA S2 NS = S2 = S3 = 0 - STA S3 - LDA K17 (-TEST - JST TS00 -SC10 LDA EBAR - SMI - JMP SC15 EBAR .GR. 0 - JST XN00 EXAMINE NEXT CHAR, - SZE - JMP SC70 IF (A) NON ZERO, -SC15 JST IG00 GO TO SC70 - LDA SCT0 INPUT INTEGER - SZE - SPL - JMP SC60 - LDA ID - SUB K101 - JMP SC30 -SC60 JST AS00 ASSIGN ITEM -SC20 LDA A S (NS+1) = A -SC30 IAB - LDA SC90 - ADD NS - STA SC91 - IAB S(NS + 1) = A - STA* SC91 - LDA NS - AOA - STA NS NS = NS + 1 - SUB K103 - SZE - JMP SC50 MORE SUBSCRIPTS PERMITTED -SC40 JST IP00 )-INPUT OPERATOR - JMP* SC00 RETURN -SC50 LDA TC - SUB K134 - SZE - JMP SC40 TERMINATOR NOT A COMMA - JMP SC10 G0 TO SC10 -SC70 JST IR00 INPUT INT VARIABLE - LDA SCT0 CHECK FOR NON-DUMMY - SNZ VARIABLE DIMENSIONS - JMP SC20 - LDA AT - SUB K105 - SNZ - JMP SC20 - JST ER00 - BCI 1,VD ILLEGAL SYMBOLIC SUBSCRIPT -SC90 DAC S1 -SC91 DAC ** -* -* -* ******************** -* *INPUT LIST ELEMENT* -* ******************** -* IF THE ITEM IS AN ARRAY, PROCESS THE SUBSCRIPT -IL00 DAC ** - JST NA00 INPUT NAME - LDA AT - SUB K105 NON-DUMMY TEST - SZE - JMP *+3 - JST ER00 USAGE ERROR - BCI 1,DD DUMMY ITEM IN AN EQUIV, OR DATA LIST - LDA IU IF IU NOT ARR, - SUB K103 - SZE - JMP IL30 GO TO IL30 - LDA K103 - JST SC00 INPUT SUBSCRIPTS - JST FA00 FETCH ASSIGNS - LDA ND IF ND = NS - SUB NS - SZE S1 = D* (S1 + D1* (S2+D2*S3) - JMP IL10 ELSE, GO TO IL10 - LDA S3 - IAB - LDA D2 - JST IM00 - ADD S2 - IAB - LDA D1 - JST IM00 - ADD S1 - IAB - LDA D0 - JST IM00 - STA S1 - JMP* IL00 RETURN -IL10 LDA NS IF NS NOT 1 - SUB K101 - SZE - JMP IL20 GO TO IL20 - LDA S1 ELSE, 20 - IAB S1 * D0*S1 - LDA D0 - JST IM00 -IL18 STA S1 - JMP* IL00 RETURN -IL20 JST ER00 - BCI 1,ND WRONG NUMBER OF DIMENSIONS IN ARRAY ELEMENT - JMP* IL00 RETURN -IL30 JST TV00 TAG VARIABLE - CRA S1 = 0 - JMP IL18 RETURN -* -* -* ************ -* *FUNCTION * -* *SUBROUTINE* -* ************ -* IF LSTF IS ZERO, THE STATEMENT IS OUT OF ORDER -* FUNCTIONS ARE CHECKED TO ENSURE ARGUMENTS -R1 LDA K101 - STA SFF SFF = 1 -R2 LDA LSTF - SZE IF LSTF = 0 - JMP R2A - JST ER00 ILLEGAL STATEMENT - BCI 1,FS NOT FIRST STATEMENT IN SUBPROGRAM -R2A JST NA00 INPUT NAME - LDA A - STA SBF SBF = A - CRA ADDR=0, S/C CODE =0 - JST ON00 OUTPUT NAME BLOCK TO THE LOADER - LDA MFL - SZE - JST DM00 DEFINE IM - LDA TC - SUB CRET IF IC NOT C/R - SZE - JMP R2C GO TO - LDA SFF IF SFF = 0 - SNZ - JMP R2D GO TO R2D - JST ER00 ERROR - BCI 1,FA FUNCTION HAS NO ARGUMENTS -R2C CRA - STA I I = 0 - JST GE00 GENERATE SUBPROGRAM ENTRY - JMP A1 GO TO C/R TEST -R2D CRA - JST OA00 OUTPUT ABS - JMP C6 GO TO CONTINUE -* -* -* ****************** -* *INTEGER * -* *REAL * -* *DOUBLE PRECISION* -* *COMPLEX * -* *LOGICAL * -* ****************** -* THE MODE FLAG (MFL) IS SET TO THE APPROPRIATE -* VALUE AND ANY ARRAY INFO IS PROCESSED -A3 LDA K101 INTEGER - JMP A7A TMFL = INT -A4 LDA K102 REAL - JMP A7A TMFL = REAL -A5 LDA K106 DOUBLE PRECISION - JMP A7A TMFL = DBL -A6 LDA K105 COMPLEX - JMP A7A TMFL = CPX -A7 LDA K103 LOGICAL -A7A STA MFL TMFL = LOG - LDA LSTF IF LSTF = 0, GO TO A7B (2) - SNZ - JMP A7B ELSE, - LDA CC SAVE CC - STA A790 - CRA - STA ICSW - JST DN00 INPUT DNA - LDA A790 RESTORE CC - STA CC - STA ICSW ICSW = IPL - LDA DFL IF DFL NOT = 0, GO TO A7B - SZE - JMP A7B - LDA TID IF ID = FUNCTI, - SUB A7K GO TO A9 - SNZ SKIP IF NOT 'FUNCTION' - JMP A9 FUNCTION PROCESSOR -A7A5 JST ER00 CONSTRUCTION ERROR - BCI 1,TF 'TYPE' NOT FOLLOWED BY 'FUNCTION' OR LIST -A7K BCI 1,FU CONSTANT FOR 'FUNCTION' CHECK -A7B JST NA00 INPUT NAME - LDA MFL - JST DM00 DEFINE IM - JMP B7 GO TO INPUT DIMENSION -A790 PZE 0 -* -* -* - B2 EXTERNAL -* TAGS NAME AS SUBPROGRAM -B2 JST NA00 EXTERNAL, INPUT NAME - JST TG00 TAG SUBPROGRAM - JMP B1 GO TO , OR C/R TEST -* -* -* ***************** -* *DIMENSION * -* *INPUT DIMENSION* -* ***************** -* PROCESS ARRAYS, PUT DIMENSION INFO IN SPECIAL -* ARRAY POINTER ITEM -B3T0 PZE 0 -B3T1 PZE 0 -B3T2 PZE 0 -B3T3 PZE 0 -B3 JST NA00 -B3A LDA AT IF AT = DUM - SUB K105 (A) = 0 - SZE ELSE (A) = .LT. 0 - SSM -B3B STA B3T0 T0 = (A) - LDA AF - STA B3T3 T3 = AF - LDA A - STA B3T1 T1 = A - LDA AT TEST FOR AT=DUMMY - SUB K105 =5 - SZE SKIP NO-USAGE TEST IF DUMMY - JST NU00 NO USAGE TEST - JST STXA - LDA DP+1,1 IU (A) = ARR - LRL 14 - LDA K103 - LLL 14 - STA DP+1,1 - LDA B3T0 (A) = T0 - JST SC00 INPUT SUBSCRIPT - LDA S1 - STA ID - LDA S2 PLACE SUBSCRIPTS IN ID - STA ID+1 - LDA S3 - STA ID+2 - LDA NS (A) = 0, B = NS - LRL 16 - JST AA00 ASSIGN SPECIAL. - JST STXA - LDA DP+1,1 - LLR 2 - LDA B3T3 - LGL 2 - LRR 2 - STA DP+1,1 DEFINE GF T0 GF(A) - LDA A - STA B3T2 T2 = A - LDA B3T1 - STA A A = T1 - JST STXA - LDA DP+1,1 - LLR 2 - LDA B3T2 - LGL 2 - LRR 2 - STA DP+1,1 DEFINE GF TO GF(A) -B3D LDA TC - SUB K104 IF TC NOT SLASH - SZE - JMP B1 GO TO ,-C/R TEST - LDA A9T2 IF SIDSW = COMMON-4 - SUB B4Z9 - SZE GO T0 B4 (COMMON-0) - JMP B1 ELSE, GO TO ,-C/R TEST - JMP B40 -B7 LDA TC IF TC = ( - SUB K17 - SZE - JMP B3D - JMP B3A -* -* -* ******** -* *COMMON* -* ******** -* INPUT BLOCK NAMES AND LINK THEM WITH THE -* FOLLOWING VAR/ARRAY NAMES, BLOCK NAMES -* ARE LINKED TOGETHER THROUGH THEIR GENERAL FIELDS -B4 LDA K81 - STA ID - STA ID+1 - STA ID+2 - LDA B4Z9 SET SWITCH IN INPUT DIMENSION - STA A9T2 - JST CH00 INPUT CHAR - SUB K9 IF NOT SLASH - SZE GO TO - JMP B4E -B40 JST DN00 INPUT DNA - LDA K104 SLASH TEST - JST TS00 -B4B LRL 32 - LDA K101 (A) = SUB, (B) = 0 - JST AA00 ASSIGN SPECIAL - LDA CFL - SNZ - LDA A - STA CFL - LDA A - STA F - JST FL00 FETCH LINK - SZE - JMP B4D - LDA CFL - STA 0 - LDA DP+1,1 GF(CFL) - IMA A - STA 0 INDEX = A - IMA A - STA DP+1,1 GF(A) = GF(CFL) - LDA CFL - STA 0 INDEX = CFL - LDA A - ADD K122 ='040000 - STA DP+1,1 GF(CFL) = A -B4D JST NA00 INPUT NAME - JST ND00 NON DUMMY/SUBPROG TEST - JST NM00 NON-COMMON TEST - JST EL00 EXCHANGE LINKS - LDA DP,1 - ANA B4F ='107777 - ADD K122 AT(A) = COM (='040000) - STA DP,1 - JMP B7 -B4E JST UC00 UNINPUT COLUMN - JMP B4B -B4Z9 DAC B4D GO TO INPUT DIMENSION -B4F OCT 107777 EXTRACT MASK TO STRIP OFF AT FIELD -* -* -* ************* -* *EQUIVALENCE* -* ************* -* STORE EQUIV INFO IN THE DATA POOL FOR LATER -* PROCESSING BY GROUP EQUIV (PART OF SPECS WRAPUP) -B5 LDA E0 L = NEXT WORD IN EQUIVALENCE TABLE - STA I I=L - SUB K101 (=1) - STA E0 L=L-1 - SUB ABAR - SMI - JMP *+3 - JST ER00 DATA POOL FULL - BCI 1,MO MEMORY OVERFLOW - JST STXI ESTABLISH I - CRA - STA DP,1 DP (I) = 0 -B5B JST CH00 - LDA DP,1 INPUT CHAR - SZE - JMP B5D - LDA TC PUT IN FIRST CHARACTER - LGL 8 PACK INTO DP (I) -B5C STA DP,1 - LDA TC - SUB CRET - SNZ - JMP C6 CHARACTER E C/R - EXIT - LDA DP,1 - ANA K100 - SNZ - JMP B5B WORD NOT FULL - JMP B5 OBTAIN NEW WORD -B5D LDA TC PUT IN SECOND CHARACTER - ERA DP,1 - JMP B5C -* -* -* ********************* -* *RELATE COMMON ITEMS* -* ********************* -* ALL ITEMS LINKED TO A COMMON BLOCK ARE PROCESSED -* AND THEIR INVERSE OFFSETS CALCULATED. THESE -* WILL BE INVERTED LATER TO GIVE TRUE -* POSITION IN THE BLOCK. -C2T0 PZE 0 -C2 LDA CFL - STA A A = F = CFL -C2A CRA - STA C2T0 T0 = 0 - LDA A - STA F F = A -C2B JST FL00 FETCH LINK - SNZ - JMP C2D - LDA D0 - ADD C2T0 T0 = T0 + D0 - STA C2T0 - JST DA00 DEFINE ADDRESS FIELD - JMP C2B -C2D JST FL00 FETCH LINK - SZE - JMP C2F - LDA AF - STA A A = AF - SUB CFL - SZE - JMP C2A AF = CFL. NO - JMP C3 YES - GROUP EQUIVALENCE -C2F LDA C2T0 - SUB AF (A) = T0 - AF - JST DA00 DEFINE AF - LDA IU - SZE - JMP C2D - JST TV00 TAG VARIABLE - JMP C2D -* -* -* ******************* -* *GROUP EQUIVALENCE* -* ******************* -* THE EQUIV GROUPS ARE PROCESSED NOW. ANY COMMON -* USAGE IS CHECKED TO SEE THAT THE ORIGIN -* IS NOT MOVED AND THAT ONLY ONE ITEM IS -* COMMON. -C3T0 PZE 0 -C3T1 PZE 0 -C3T2 PZE 0 -C3T3 PZE 0 -C3T4 PZE 0 -C3T5 PZE 0 -T0C3 EQU C3T0 -T1C3 EQU C3T1 -T2C3 EQU C3T2 -T3C3 EQU C3T3 -T4C3 EQU C3T4 -C3 LDA E0 - STA EBAR EBAR=E(0) = END OF EQUIVALENCE TABLE - LDA L0 - STA E E=L(0) = START OF EUUIVALENCE TABLE - LDA CRET - STA TC -C3B LDA E - STA EP E-PRIME = E - CRA - STA F I = 0 - LDA K102 T4 = STR-ABS - STA C3T4 - JST CH00 INPUT CHARACTER - LDA K17 - JST TS00 (TEST -C3D JST IL00 INPUT LIST ELEMENT - JST SAF - LDA S1 - SUB AF TL = S1-AF - STA C3T1 - LDA A T2 = A - STA C3T2 -C3F LDA F IF I=0, GO TO C3P - SNZ - JMP C3P -C3G LDA F ELSE, - SUB A - SNZ IF A = I, GO TO C3N - JMP C3N -C3H LDA AT - SUB K104 ELSE, - SNZ IF AT = COM, GO TO C3O - JMP C3O -C3H2 LDA T1C3 - ADD AF - STA T0C3 T(0) = AF +T (1) - LDA T4C3 - SUB K104 IF T(4) = 0, GO T0 C3K - SZE - JMP C3K - LDA T3C3 - SUB T0C3 ELSE, - STA T0C3 T(0) = T(3)-T(0) - SMI - JMP C3K - JST ER00 IF T(0)<0, - BCI 1,IC -C3K LDA C3T4 IMPOSSIBLE COMMON EQUIVALENCING - IAB - LDA T0C3 AT (A) = COM - ALS 2 - LGR 2 - JST AF00 - JST FL00 DEFINE AF - JST SAF FETCH LINK - LDA A - SUB C3T2 - SZE IF A .NE. T (2), - JMP C3G GO TO C3G (5) -* - JST EL00 EXCHANGE CL(A) == CL(I) -C3M LDA TC EXCHANGE LINKS (CL(A) WITH CL(F) ) - SUB K134 IF TC = , - SNZ - JMP C3D ELSE, - JST IP00 )-INPUT OPERATOR - LDA TC - SUB K134 IF TC = , OR C/R - SNZ GO TO C3B (1) - JMP C3B - LDA TC - SUB CRET - SNZ - JMP C3B ELSE, - JST ER00 - BCI 1,EC EOUIVALENCE GROUP NOT FOLLOWED BY , OR CR - JMP C3B -C3N LDA T1C3 IF T1 = 0, GO TO C3M - SNZ - JMP C3M -C3N5 JST ER00 ERROR IMPOSSIBLE GROUP - BCI 1,IE IMPOSSIBLE EQUIVALENCE GROUPING -C3O LDA S1 - ADD AF - STA T3C3 - LDA K104 =4 - CAS T4C3 - JMP *+2 - JMP C3N5 - STA T4C3 - LDA F - CAS A IF A = F, GO TO C3M (B) - JMP *+2 - JMP C3M ELSE, - STA A A = I - IMA C3T2 - STA F - CRA T1 = 0 - STA C3T1 - JST FA00 FETCH ASSIGNS - JST SAF - JMP C3H2 GO TO C3H2 -C3P LDA A - STA F - JMP C3H -* -* -* *********************** -* *ASSIGN SPECIFICATIONS* -* *********************** -* NON-COMMON NON-EQUIV ITEMS ARE PROCESSED AFTER -* COMMON BLOCKS ARE OUTPUT (WITH SIZE). -C4T0 PZE 0 -C4T1 PZE 0 -C4B STA A A = 0 -C4C LDA A - ADD K105 I = A = A+5 - STA A - STA F - CAS ABAR - JMP NP35 RETURN TO FIRST NON-SPEC CHECK (POINT 1) - NOP - JST FA00 ELSE, FETCH ASSIGN - LDA AT - SUB K102 IF AT = STR-ABS - SZE IU=VAR, OR ARR, AND - JMP C4C NT = 0 - LDA IU GO TO C4E - SUB K102 ELSE, GO TO C4C - SPL - JMP C4C - LDA NT - SZE - JMP C4C -C4E CRA - STA C4T0 T0 = 0. T1 =-MAX - SUB K111 - STA C4T1 - JST KT00 SET D(0) = NO. OF WORDS PER ITEM -C4F JST SAF - CAS C4T0 - STA C4T0 - NOP - LDA D0 - SUB AF (A) = D(0) - AF - CAS C4T1 - STA C4T1 - NOP - JST FL00 FETCH LINK ( (A)=A - F ) - SZE - JMP C4F GO TO C4F - LDA RPL - ADD C4T0 RPL * RPL + T0 + TL - STA C4T0 - ADD C4T1 TO = RPL-T1 - STA RPL -C4I JST SAF - LDA K101 - IAB (B) = REL - LDA C4T0 (A) = TO-AF - SUB AF - JST AF00 DEFIME AFT - JST FL00 FETCH LINK - SZE IF (A) NOT ZERO, - JMP C4I NOT END OF EQUIVALENCE GROUP - JMP C4C CHECK NEXT ITEM IN ASSIGNMENI TABLE -* -C4L2 LDA FLT1 = LINK LOCATION TO COMMON BLOCK NAME - STA C4T1 -C4L3 LDA A - STA I SAVE A FOR LATER MODIFICATION - JST FL00 FETCH LINK - SNZ - JMP C4M END OF COMMON GROUP - JST STXI SET INDEX TO POINT TO CURRENT ITEM IN -* COMMON GROUP. - LDA DP,1 SET CL FIELD TO POINT AT COMMON BLOCK -* NAME. - ANA K119 ( = '177000) - ADD C4T1 (= LINK LOCATION OF COMMON BLOCK NAME) - STA DP,1 - JMP C4L3 PROCESS NEXT ITEM IN COMMON BLOCK -* -C4 LDA CFL LOC, OF FIRST (BLANK) COMMON BLOCK - STA F -C4L6 STA A - CRA - STA C4T0 -C4L JST FL00 FETCH LINK - SNZ - JMP C4L2 NO MORE ITEMS IN COMMON BLOCK - LDA D0 ELSE, IF TO .LT. DO+AF, - ADD AF - CAS C4T0 T0 = D0 + AF - STA C4T0 - NOP - JMP C4L GO TO C4L -C4M LDA AF - STA F I=AF - LDA C4T0 (A) = T0 - JST DA00 DEFINE AF -*....OUTPUT COMMON BLOCK NAME AND SIZE TO LOADER - LDA AF LENGTH OF COMMON BLOCK - ANA K111 ='37777 - ADD K122 ='40000 (S/C CODE = 1) - JST ON00 OUTPUT NAME BLOCK TO LOADER - LDA F - SUB CFL IF I = CFL - SNZ - JMP C4B - LDA F - JMP C4L6 -* -SAF DAC ** - LDA AF - LGL 2 - ARS 2 - STA AF - JMP* SAF -* -* ************************** -* *DATA STATEMENT PROCESSOR* -* ************************** -* PROCESS VARIABLE LIST .THEN OUTPUT LITERAL ITEMS -* TO APPROPRIATE LOCATIONS. MODES MUST AGREE -T0W4 PZE 0 -T1W4 PZE 0 -G PZE 0 LOWEST INDEX POINT IN LIST -W4 LDA L0 - STA I I=END OF DATA POOL -W4B JST IL00 INPUT LIST ELEMENT - LDA AT D (0) = =WDS/ITEM - SUB K102 - SNZ IF AT = 'STR-ABS' - JMP W4T GO TO - LDA I - STA 0 - LDA S1 S1 * DEFLECTION IF AN ARRAY - ADD AF - STA DP,1 DP(E) = AF + S1 -W4C LDA A - STA DP-1,1 DP (E-1) = A - LDA I - SUB K102 - STA I - STA G - LDA TC IF TC = , - SUB K134 - SNZ - JMP W4B GO TO W4B - LDA K104 - JST TS00 TEST FOR SLASH TERMINATOR - LDA RPL - STA T1W4 - LDA L0 - STA I I= END OF DATA POOL -W4E CRA - STA KPRM K' = KBAR = 0 - STA KBAR -W4F JST DN00 INPUT, DNA - LDA NT - SZE IF NT = 0 - JMP W4G VARIABLE OR ARRAY - LDA TC LAST CHARACTER - CAS K17 ='250 ( =( ) - JMP *+2 - JMP *+3 START OF COMPLEX CONSTANT - JST ER00 ERROR - BCI 1,CN NON-CON DATA - STA SXF SET SXF TO NON-ZERO - JMP W4F FINISH INPUT OF COMPLEX CONSTANT -W4G LDA KBAR MULTIPLY COUNT - SZE - JMP W4K GO TO W4K - LDA TC IF TC NOT * - SUB K103 - SZE - JMP W4L - LDA ID - SUB K101 - STA KBAR KBAR = ID-1 - JST IT00 INTEGER TEST - JMP W4F -W4K LDA KPRM IF K NOT ZERO - SZE - JMP W4M GO TO W4M -W4L LDA KBAR - ALS 1 K ' = E-3* KBAR - TCA - ADD I - STA KPRM -W4M JST STXI SET INDEX = I - LDA DP-1,1 - STA A A = DP (E-1) - LDA IM - STA T0W4 TO = IM - JST FA00 - LDA BDF IF BDF NOT ZERO - SZE - JMP W4S GO TO W4S - JST NM00 NON-COMMON TEST -W4O JST STXI SET INDEX = I - LDA DP,1 - STA RPL RPL = AF - JST FS00 FLUSH - CRA - STA DF DF = 0 - LDA HOLF IS IT HOLLERITH DATA - SZE NO - JMP WHOW YES, GO TO OUTPUT IT - LDA D0 - STA 0 - JMP *,1 SWITCH ON NUMBER OF WORDS TO OUTPUT - JMP W405 - JMP W403 - JMP W404 - LDA TID+2 - JST OA00 - LDA TID+1 - JST OA00 - LDA TIDB+2 - JST OA00 - LDA TIDB+1 - JMP W406 -WHOW LDA D0 (A)=NO. OF WORDS PER ITEM - ALS 1 (A)=NO. OF CHARS, PER ITEM - STA NTID NTID=NO. OF CHARS. TO BE OUTPUT - SUB HOLF - SPL - JMP WERR - LDA ID FIRST WORD - JST WSNG OUTPUT IT - LDA ID+1 2ND WORD - JST WSNG OUTPUT IT - LDA ID+2 3RD WORD - JST WSNG OUTPUT IT - LDA ID+3 4TH WORD - JST OA00 OUTPUT IT - JMP W420 TO CHECK NEXT DATA -* -WSNG PZE 0 - JST OA00 OUTPUT (A) - LDA NTID NO. OF CHARS, REMAINED TO BE OUTPUT - SUB K102 - STA NTID NTID=NTID-2 - SNZ - JMP W420 ALL FINISHED, CHECK NEXT ITEM - JMP* WSNG SOME HOLLERITH CHARS, REMAINED -W403 LDA TID+2 REAL OUTPUT - JST OA00 - LDA TID+1 - JMP W406 -W404 LDA TID+2 DOUBLE PRECISION OUTPUT - JST OA00 - LDA TID+1 - JST OA00 -W405 LDA TID INTEGER OUTPUT -W406 JST OA00 - LDA T0W4 - ERA IM - ANA K105 - SNZ - JMP *+3 -* TO BE OUTPUT, RETURN -WERR JST ER00 - BCI 1,DM DATA AND DATA NAME MODE DO NOT AGREE -W420 LDA I - SUB K102 - STA I I = I-2 - CAS KPRM - NOP - JMP W4M MORE TO DO - SUB G TEST FOR COMPLETE - SZE - JMP W4P - LDA K104 - JST TS00 - LDA T1W4 - STA RPL - JST CH00 INPUT NEXT CHARACTER - SUB K5 ='254 (,) - SZE SKIP IF CHAR = COMMA - JMP A1 CHECK FOR (CR) - JMP W4 PROCESS NEXT DATA GROUP -W4P LDA K134 - JST TS00 - JMP W4E -W4S JST FS00 FLUSH BUFFER IF NECESSARY - LDA AF POSITION WITHIN COMMON BLOCK - LRL 14 - LDA K106 FORMAT BCD OUTPUT - LGL 6 - LLL 6 - STA OCI - IAB - ANA K116 - STA OCI+1 - JST FL00 FETCH LINK - LDA DP+4,1 - SSM - ALR 1 - SSM - ARR 1 - LRL 8 - ERA OCI+1 - STA OCI+1 - LDA DP+3,1 - IAB - LDA DP+4,1 - LLL 8 - STA OCI+2 - LDA DP+2,1 - IAB - LDA DP+3,1 - LLL 8 - STA OCI+3 - LDA DP+2,1 - LGL 2 - ADD K103 - LGL 6 - STA OCI+4 - LDA K128 - STA OCNT - JST STXI I POINTS TO DATA TABLE - LDA DP-1,1 SET A TO VARIABLE - STA A - JST FA00 - JMP W4O -W4T LDA K101 =1 (=REL) - IAB - LDA RPL - JST AF00 DEFINE AFT (AT=REL. AF=RPL) - LDA I SET POINTER IN DATA POOL - STA 0 - LDA RPL - STA DP,1 DP(I) = RPL OF VARIABLE - ADD D0 - STA RPL - JMP W4C -* -* -* ********************************* -* *BLOCK DATA SUBPROGRAM PROCESSOR* -* ********************************* -* SET BLOCK DATA FLAG AND OUTPUT FORCE LOAD CODE -R3 LDA LSTF =0 IF FIRST STATEMENT IN THE SUBPROGRAM - SZE - JMP *+3 - JST ER00 ERROR...NOT FIRST STATEMENT - BCI 1,BL 'BLOCK DATA' NOT FIRST STATEMENT - STA BDF SET BLOCK DATA FLAG ON (NON-ZERO) - JST CH00 INPUT NEXT CHARACTER - JMP A1 CHECK FOR (CR) AND EXIT -* -* -* -* -* -* -* -* *************************** -* *TRACE STATEMENT PROCESSOR* -* *************************** -* SETS TRACE TAG ON VARIABLES OR SETS TRACE FLAG -TRAC JST XN00 EXAMINE NEXT CHARACTER - SZE SKIP IF CHAR, WAS A DIGIT - JMP TRAD JUMP IF CHAR. WAS A LETTER - JST IS00 INPUT STATEMENT NO. - LDA A STATEMENT NO. POINTER - STA TRF SET TRACE FLAG ON - JMP A1 TEST FOR (CR) AND EXIT -* -TRAD JST NA00 INPUT NAME - JST STXA SET INDEX TO NAME ENTRY - LDA DP+4,1 TT(A) TRACE TAG - CHS - STA DP+4,1 - JMP B1 (,) OR (CR) TEST -* (RETURN TO TRAC IF (,) ) -* -* -* -* ******************** -* *OUTPUT OBJECT LINK* -* ******************** -OL00 DAC ** - JST CN00 CALL NAME - CRA - STA DF DF = 0 - LDA ID (A) = IP - JST OA00 OUTPUT +BS -* - JMP* OL00 -* -* ***************** -* *OUTPUT I/O LINK* -* ***************** -* GENERATE I/O DRIVER LINKAGE CODE. NAME OF -* CALLED ROUTINE IS CHANGED IF UNIT DESIGNATOR -* IS A CONSTANT. -OI00 DAC ** - JST IV00 INPUT INT VAR/CON - LDA NT - SNZ IF NT = 0 - JMP OI20 GO TO 0I20 - LDA ID IF ID CR 9 - SUB K126 G0 TU OI20 - SMI - JMP OI20 -* FORM F$RN OR F$WN - LDA NAMF+1 - ANA K116 - ADD ID - ADD K60 ='260 (SP) - STA NAMF+1 -OI10 JST CN00 CALL NAME - JMP* OI00 RETURN -OI20 LRL 32 - LDA OMI7 OUTPUT OA - JST OB00 (LOAD A (UNIT N0.)) - JMP OI10 FO TO OI10 -* -* -* *********** -* *CALL NAME* -* *********** -* SET UP NAME AND GENERATE CODE FOR CALLING IT. -CN00 DAC ** - JST FS00 FLUSH - JST PRSP SET PRINT BUFFER TO SPACES - LDA K147 SET UP OCI FOR CALL - STA OCI - LDA NAMF+1 OCI = NAMF - STA PRI+9 - IAB ALSO TO PRINT BUFFER - LDA NAMF - STA PRI+8 - LRL 8 - STA OCI+1 - LLL 16 - STA OCI+2 - LDA NAMF+2 - STA PRI+10 - IAB - LDA NAMF+1 - LLL 8 - STA OCI+3 - LLL 16 - STA OCI+4 - LDA K128 ='14 - STA OCNT OCNT = 6 - LDA CN90 - STA PRI+5 - LDA CN90+1 - STA PRI+6 - LDA RPL - JST OR80 - DAC PRI - SR2 - JMP *+3 INHIBIT SYMBOLIC OUTPUT - CALL F4$SYM OUTPUT SYMBOLIC LINE, - DAC PRI - IRS RPL RPL = RPL + 1 - JST PRSP SET PRINT BUFFER TO SPACES - JST FS00 FLUSH - JMP* CN00 RETURN -K147 OCT 55000 -CN90 BCI 2,CALL -* ************* -* *OUTPUT PACK* -* ************* -* OUTPUT THE PACK WORD WHEN IT IS FULL. -PKF PZE 0 PACK FLAG -T0OK PZE 0 -OK00 DAC ** - CAS CRET IF (A) = C/R - JMP *+2 - JMP OK30 GO TO OK30 - IRS PKF PKF = PKF + 1 - JMP OK20 IF NON-ZERO, GO TO OK20 -OK10 ADD T0OK (A) = (A) + T0 - LRL 16 - STA DF - IAB - JST OA00 OUTPUT ABS - JMP* OK00 -OK20 LGL 8 - STA T0OK - LDA K123 PKF = - 1 - STA PKF - JMP* OK00 RETURN -OK30 LDA PKF IF PKF = 0 - SNZ - JMP* OK00 RETURN - LDA K8 ELSE (A) = SPACE, - STA PKF - JMP OK10 GO TO OK10 -* -* -* *********** -* *OUTPUT OA* -* *********** -* GENERAL OUTPUT ROUTINE. MAKES CHECKS AGAINST -* THE ASSIGNMENT TABLE ENTRY TO PROCESS DUMMY, -* EXTERNAL, RELATIVE, ABSOLUTE OR STRING -* REFERENCES PROPERLY. -T1OB PZE 0 -OB00 DAC ** - STA FTOP FTOP = (A) - IAB - STA T1OB - JST STXA ESTABLISH A - SNZ IF A = 0 - JMP OB08 GO TO OB08 - JST FA00 FETCH ASSIGNS - LDA SOF SPECIAL OUTPUT FLAT - SZE - JMP OB60 SUBSCRIPT CONSTANT DEFLECTION - LDA AF - STA T1OB T0 = AF - LDA AT - SUB K105 IF AT = 'DUM' - SNZ - JMP OB15 GO TO OB15 - LDA IU - SUB K101 IF IU = 'SUB' - SNZ - JMP OB40 GO TO OB40 -OB06 LDA AT - CAS K104 IF AT = 'COM' - JMP *+2 - JMP OB20 GO TO OB20 - CAS K101 - JMP *+2 IF AT = 'REL' - JMP OB10 GO TO OB10 - LDA K103 - IAB - LDA RPL - JST AF00 DEFINE AF AND AT - LDA AT IF AT = 'STR-RE' - SUB K103 - SNZ - JMP OB10 GO TO OB10 - CRA - STA AF AF = 0 -OB08 LDA K102 - STA DF SET FLAG TO OUTPUT SYMBOLIC - LDA FTOP - JST OA00 OUTPUT ABSOLUTE - JMP* OB00 RETURN -OB10 LDA T1OB - STA AF - LDA FTOP - JST OR00 OUTPUT REL - JMP* OB00 RETURN -OB15 LDA FTOP - CHS REVERSE INDIRECT BIT - STA FTOP - JMP OB10 GO TO OB10 -OB20 JST FS00 OUTPUT COMMON REOUEST - LDA T1OB PACK ADDRESS INTO BLOCK - LRL 14 - LDA FTOP - LGR 10 - ADD K150 - LLL 6 - STA OCI - LLL 8 - STA OCI+1 - JST SAV - JST FL00 - LDA DP+2,1 - STA PRI+13 SET COMMON NAME INTO PRINT BUFFER - LLR 8 - STA OCI+4 - LLL 8 - LDA DP+3,1 - STA PRI+12 SET COMMON NAME INTO PRINT BUFFER - LLR 8 - STA OCI+3 - LLL 8 - LDA DP+4,1 - ANA K111 ='037777 - CAS *+1 LOOK FOR BLANK COMMON - OCT 020240 - ERA K122 - ERA HBIT - STA PRI+11 SET NAME INTO PRINT BUFFER - LLR 8 - STA OCI+2 - LLL 8 - LDA OCI+1 - LLL 8 - STA OCI+1 - LDA K128 ='14 - STA OCNT - JST RST - LDA 0 - STA A RESTORE A TO POINT AT NAME - LDA RPL SET RPL MINUS - SSM TO DISABLE WORD OUTPUT - STA RPL - LDA FTOP OUTPUT WORD TO LIST - JST OR00 SYMBOLIC COMMAND - LDA RPL RESTORE AND - SSP INCREMENT PROGRAM - AOA COUNTER FOR COMMON - STA RPL OUTPUT - JST FS00 CLOSE OUT BLOCK - JMP* OB00 EXIT -OB30 LDA DP+4,1 - SSM - ALR 1 - SSM - ARR 1 - STA NAMF - LDA DP+3,1 - STA NAMF+1 - LDA DP+2,1 - STA NAMF+2 - JST CN00 - JMP* OB00 -OB40 LDA AT - SUB K102 - SNZ - JMP OB30 - JMP OB06 -OB50 OCT 140000 -* -OB60 CRA - STA SOF RESET SPECIAL OUTPUT FLAG - LDA AT ADDRESS TYPE - CAS K105 TEST FOR DUMMY - JMP OB06 PROCESS NORMALLY - JMP OB61 - JMP OB06 PROCESS NORMALLY -OB61 LDA T1OB - STA FTOP - CRA - JMP OB08+1 -* -K150 OCT 700 -* -* -* ************** -* OUTPUT TRIADS* -* ************** -* PROCESSES THE TRIAD TABLE, HANDLES FETCH -* GENERATION AND RELATIONAL OPERATOR CODE -* GENERATION, DRIVES OUTPUT ITEM. ASSIGNS -* AND OUTPUT TEMP STORES. -T0OT PZE 0 -T2OT PZE 0 -T1OT PZE 0 -T3OT PZE 0 TEMP STORE FOR P -OT00 DAC ** - JST SAV - LDA L0 - STA I I = L0 - CRA - STA T0OT T0 = 0 - STA IFLG -OT06 STA T1OT T1 = I -OT10 LDA I - SUB K103 I = I-3 - STA I - STA T2OT T2 = I - SUB L - SPL - JMP OT60 IF FINISHED, GO TO OT60 - JST STXI - LDA DP+2,1 - SSP CHECK P (I) - CAS K139 X - JMP *+2 - JMP OT10 - CAS K138 H - JMP *+2 - JMP OT10 - CAS K142 I - JMP *+2 - JMP OT50 - CAS K143 T - JMP *+2 - JMP OT40 - CAS K151 Q - JMP *+2 - JMP OT35 - STA T3OT SAVE P - LDA DP+1,1 - STA A A = O1(I) - CAS T1OT - JMP *+2 - JMP OT30 - CAS L0 - JMP OT16 - JMP OT99 MAYBE SPECIAL LOAD FOR (A=) STATEMENT - JMP OT16 -OT18 JST STXI - LDA DP,1 - STA A A = O2 (I) - LDA DP+2,1 - SSP - JST OM00 OUTPUT ITEM(P(I),A = 02(I)) -OT22 JST STXI - LDA DP+2,1 - SMI - JMP OT28 - CRA ASSIGN TEMP STOR - STA NT NT = 0 - LDA K102 - STA IU IU = VAR - LDA T0OT - LRL 6 - LDA TCF ID = - LRL 3 TS-IM-TCF-T0 - LDA MFL - STA IM - LLL 9 - JST OR80 - DAC ID - LDA K77 - STA ID - IRS T0OT T0 = T0+1 - JST AS00 ASSIGN ITEM - JST STXI - LDA A - STA DP,1 O2(I) = A - LDA K153 - SSM SURPRESS TRACE OF TEMPORARY STORAGE - JST OM00 OUTPUT ITEM (=,A) -OT28 LDA I - JMP OT06 -OT30 JST STXA - LDA DP+2,1 - SSP IF P (A) = 0 - SZE - JMP OT32 -OT16 LDA K152 GENERATE FETCH - JST OM00 OUTPUT ITEM -OT32 LDA T3OT CHECK FOR RELATIONALS - SUB K125 ='10 - SPL - JMP OT18 NOT LOGICAL OR6RATOR - SUB K106 =6 - SMI - JMP OT18 NOT A LOGICAL QPERATOR - STA 0 SET INDEX = -1 TO -6 - LDA K103 =3 (LOG) - STA MFL SET MODE TO LOGICAL - CRA - STA A SET FOR OCTAL ADDRESS - JMP *+7,1 BRANCH TO OPERATOR PROCESSOR - JMP OT3G .LT. - JMP OT3E .LE. - JMP OT3C .EQ. - JMP OT3B .GE. - JMP OT3A .GT. - LDA OMJ4 .NE. =ALS 16 - JST OA00 OUTPUT ABSOLUTE - LDA OMJ6 =ACA - JMP OT3D -OT3A LDA OMJ7 *TCA - JMP OT3F -OT3B LDA OMK1 =CMA - JMP OT3F -OT3C LDA OMJ4 = ALS 16 - JST OA00 - LDA OMK2 =SSC - JST OA00 OUTPUT ABSOLUTE - LDA OMK3 =AOA -OT3D JST OA00 OUTPUT ABSOLUTE - JMP OT22 -OT3E LDA OMJ2 =SNZ - JST OA00 OUTPUT ABSOLUTE - LDA OMK4 =SSM -OT3F JST OA00 OUTPUT ABSOLUTE -OT3G LDA OMJ5 =LGR 15 - JMP OT3D -* -OT35 LDA DP+1,1 - STA ID - JST NF00 - LDA K78 NAMF = F $AR - STA NAMF+1 - JST OL00 OUTPUT OBJECT LINK - JMP OT18 GO TO OT18 -OT40 LDA DP,1 - ADD DO - STA I I = 02 (I) + DO - JST DQ00 DO TERMINATION -OT45 LDA T2OT - STA I I = T2 - JMP OT28 -OT50 LDA DP,1 - ADD DO I=O2(I)+DO - STA I IF I = DO - SUB DO - SZE GO TO OT45 - JST DS00 DO INITIALIZE - JMP OT45 GO TO OT45 -OT60 JST RST - LDA L0 RESET TRIAD TABLE - STA L - JMP* OT00 -* -OT99 LDA T3OT - SUB K153 CODE FOR = - SZE - JMP OT16 NOT SPECIAL LOAD - STA MFL SPECIAL LOAD, SET MFL=0 - JMP OT18 OUTPUT A STORE -K77 BCI 1,T$ T$ -K78 BCI 1,AR AR -K142 OCT 27 -K143 OCT 30 -K151 OCT 32 -K152 OCT 31 -* ************* -* *OUTPUT ITEM* -* ************* -* -* DRIVES BASIC OUTPUT ROUTINES. HANDLES SPECIAL -* SUBSCRIPT PROCESSING, GENERATES NECESSARY -* MODE CONVERSION CALLS AND HANDLES MODE -* CHECKING. IN-LINE ARITHMETIC CODE IS -* GENERATED WHERE POSSIBLE. OTHERWISE CALLS -* TO ARITHMETIC ROUTINES ARE GENERATED. -* -T0OM PZE 0 -T1OM PZE 0 -T2OM PZE 0 -T8OM PZE 0 -T9OM PZE 0 -TXOM PZE 0 -* -*-------------OUTPUT ITEM -OM00 DAC ** RETURN ADDR - STA T8OM - SSP - STA T0OM R(0)=(A)='P' CODE - CAS K134 - JMP *+2 - JMP OMD1 - LDA TXOM - CAS K101 - JMP OME1 - JMP OME5 -OM05 CRA - STA T1OM T(1)=0 - STA T9OM T(9)=0 - LDA A - STA T2OM T(2)=A - SZE - JMP OM07 - LDA MFL - JMP OM13 -OM07 CAS L0 - JMP *+2 - JMP OML1 - CAS ABAR - JMP OM76 A .LE. ABAR....WITHIN TRIAD TABLE - JMP *+1 -OM10 JST STXA SET INDEX=A - LDA DP,1 - ARS 9 SES IM=MODE OF ITEM - ANA K107 -OM13 STA IM -OM14 LDA MFL SET MFL,IM AS DIGITS INTO NAMF - ALS 8 - ADD IM - ERA OM90 ADD '0''0' - STA NAMF+1 - LDA K130 - STA 0 INDEX=-6 - LDA T0OM - CAS OM50+6,1 CHECK FOR SPECIAL OPERATOR - JMP *+2 '1 - JMP* OM52+6,1 'P'='Q',',','0','A'F', OR 'E' - IRS 0 - JMP *-4 - LDA MFL - SNZ - JMP OM62 SPECIAL LIBRARY FIX FOR ( A= ) - CAS IM CHECK FOR MODE MIXING - JMP *+2 - JMP OMA1 ITEM MODE SAME AS CURRENT MODE -OM20 LDA K103 - JST OM44 CHECK MODE FOR LOG - LDA K102 =2 (MODE CODE FOR REAL) - CAS MFL MODE OF EXPRESSION - JMP *+2 - JMP OM26 IF MODE=REAL, ALLOW COMPLEX MODE MIXING - CAS IM MODE OF ITEM - JMP *+2 - JMP OM26 IF MODE=REAL, ALLOW COMPLEX MODE MIXING - LDA K105 - JST OM44 TEST FOR MODE = COMPLEX -OM26 LDA T0OM OPERATOR BEING PROCESSED - CAS K153 - JMP *+2 - JMP OM36 T(0)='=' (ALLOW INTEGER MODE) - LDA K101 - JST OM44 TEST FOR MODE=INTEGER - LDA IM - CAS MFL - JMP OM38 CONVERT MODE OF ACCUMULATOR - JMP *+1 -OM30 JST NF00 SET LBUF+2 TO SPACES - LDA T0OM - STA 0 - LDA A9X4,1 PICK-UP PRINT CODE FOR 'P' OPERATOR - ARS 6 - ANA K100 ='377 - SNZ - JMP OM46 MODE MIXING ERROR - LGL 8 - ERA OM91 ADD '$' - STA NAMF - LDA K134 - STA T0OM T(0)=',' - JMP OM40 -* -OM36 LDA K105 - JST OM44 CHECK FOR MODE=COMPLEX -OM38 LDA IM - STA MFL - JST NF00 SET LBUF+2 TO SPACES - LDA OM92 'C$' - STA NAMF -OM40 JST CN00 OUTPUT....CALL NAMF - LDA MFL - STA IM SET ITEM MODE TO CURRENT MODE - LDA NAMF - CAS OM96 - JMP OM14 - JMP* OM00 - JMP OM14 OUTPUT ARGUMENT ADDRESS -* -*-----SUBROUTINE TO CHECK FOR ILLEGAL IM OR MFL MODES, -OM44 DAC ** RETURN ADDR, - CAS IM CHECK FOR IM0(A) - JMP *+2 - JMP OM46 ERROR - CAS MFL CHECK FOR MFL=(A) - JMP* OM44 - JMP OM46 ERROR - JMP* OM44 -OM46 JST ER00 NON-RECOVERABLE ERROR...... - BCI 1,MM MODE MIXING ERROR -* -*------SPECIAL 'P' OPERATOR TABLE -OM50 OCT 32 'Q' - OCT 17 ',' - OCT 00 '0' - OCT 22 'A' - OCT 31 *F' - OCT 20 'E' -OM52 DAC OMB3 ('Q') - DAC OMB3 (',') - DAC OMB3 ('0') - DAC OM56 ('A') - DAC OM60 ('F') - DAC OM70 ('E') -* -* -OM56 LDA OMI1 SET T(1) = ADD* - JMP OMB1 -* -OM60 JST STXA SET INDEX = A - LDA DP+1,1 - LGR 14 SET UV=IU(A) - STA IU - JST STXI SET INDEX=I - LDA DP+2,1 P(I) - ANA K133 ='77 - SNZ - JMP OM64 (POSSIBLE DUMMY ARRAY FETCH) -OM62 LDA IM - STA MFL SET CURRENT MODE TO ITEM MODE - LGL 8 - ADD IM - ERA OM90 - STA NAMF+1 - LDA IU - SUB K101 CHECK FOR IU=1 (SUBROUTINE) - SZE - JMP OMA1 - LDA OMI2 SET T(1) = JST - JMP OM66 -OM64 LDA IU - SUB K103 CHECK FOR IV=3 (ARRAY) - SZE - JMP OM62 - LDA K101 SET CURRENT MODE TO INTEGER - STA MFL - LDA OMI3 SET T(1) = LDA* -OM66 STA T1OM - JMP OMB3 -* -OM70 LDA K101 - CAS IM CHECK ITEM MODE EQUALS INTEGER - JMP *+2 - JMP OM74 - LDA K105 CHECK FOR MODE = COMPLEX - JST OM44 - JMP OM20 -OM74 LDA K103 CHECK FOR MODE = LOGICAL - JST OM44 - JMP OM30 OUTPUT SUBROUTINE CALL -* -OM76 JST STXA INDEX=A - LDA DP,1 02(A) - STA T2OM T(2)=02(A) - LDA DP+2,1 P(A) - ANA K133 ='77 - SNZ - JMP OM84 P(A)='0' (SUBSCRIPTED VARIABLE) - CAS K139 - JMP *+2 - JMP OM80 P(A) = 'X' (END OF ARRAY CALCULATION) - CAS K138 - JMP *+2 - JMP OMHW -OM78 LDA T2OM P(4)= 'H' (HOLLERITH DATA) - STA A RESET A - JMP OM10 -* -OM80 JST STXI INDEX=I - LDA T2OM - STA DP+1,1 O1(I) = T(2) - CRA - STA T1OT SET T(1) OF OUTPUT TRIADS TO ZERO - LDA A SAVE A - STA T1OM - CRA SET A=0 (NOT SYMBOLIC) - STA A - LDA RPL - ADD K102 AF = RPL+ 2 - STA AF - LDA OMI4 =ADD INSTRUCTION - JST OR00 OUTPUT RELATIVE - LDA RPL - ADD K102 AF = RPL P+ 2 - STA AF - LDA OMI5 = JMP INSTR, - JST OR00 OUTPUT RELATIVE - LDA T1OM - STA A RESTORE A - STA SOF SET SPECIAL OUTPUT FLAG TO NON-ZERO - CRA = DAC INSTR. - STA T1OM - LDA K101 - STA AT - JMP OM88 -OM84 LDA DP+1,1 O1(A) - STA A A=O1(A) - CAS L0 - JMP *+2 - JMP OM86 A=L(0)....CONSTANT SUBSCRIPT ONLY - LDA OMI0 T(1) = INDIRECT BIT - STA T1OM - JMP OM10 -* -OM86 LDA T2OM A=T(2) - STA A - STA 0 - STA SOF - LDA DP,1 T(2) = 02(A) - STA T2OM -OM88 JST STXA INDEX=A - LDA DP+1,1 O1(A) - STA T9OM T(9)=O1(A) - JMP OM78 -OMHW LDA T2OM - STA AF - CRA - STA A - JST OR00 - JMP* OM00 -* -OM90 OCT 130260 '00' -OM91 OCT 000244 ' $' -OM92 OCT 141644 'C$' -OM93 OCT 152322 'TR' -OM94 OCT 000021 'C' CODE -OM95 OCT 017777 (MASK) -OM96 BCI 1,N$ -OM97 BCI 1,-1 -* -OMA1 LDA IM CHECK FOR IM=LOGICAL - CAS K103 - JMP *+2 - JMP OMC1 IM=LOGICAL - CAS K101 CHECK FOR IM=INTEGER - JMP *+2 - JMP OMA3 IM=INTEGER - JMP OM30 -* -OMA3 LDA T0OM CHECK FOR T,0) = '+' - CAS K103 =3 - JMP *+2 - JMP OMA4 T(0)= '*' - CAS OM94 T(0) = 'C - JMP *+2 - JMP OMA6 OUTPUT 'TCA' - CAS K101 - JMP OMA5 - LDA OMI4 =ADD INSTR. - JMP OMB1 -OMA4 LDA T2OM VALUE OF A - SUB K126 ='12 KNOWN LOCATION OF A FOR 2 - SZE SMP IF MULTIPLIER IS A CONSTANT OF 2 - JMP OM30 COUPLE TO THE MULTIPLY SUBROUTINE - STA A SET A AND AF TO ZERO (FOR LISTING FLAGS) - STA AF - LDA *+3 ALS 1 INSTRUCTION - JST OA00 OUTPUT ABSOLUTE - JMP* OM00 EXIT UUTPUT ITEM - ALS 1 (INSTRUCTION TO BE OUTPUT) -OMA5 CAS K102 CHECK FOR T(0) = '-' - JMP OMA7 - LDA OMI6 =SUB INSTR, - JMP OMB1 -OMA6 CRA - STA A CAUSE OCTAL ADDR LISTING - STA AF - LDA *+3 TCA - JST OA00 OUTPUT ABSOLUTE - JMP* OM00 EXIT - TCA -OMA7 CAS K153 CHECK FOR T(0) = '=' - JMP *+2 - JMP OMA9 OUTPUT A STA INSTR, - SUB K152 CHECK FOR T(0) = 'F' - SZE - JMP OM30 -OMA8 LDA OMI7 =LDA INSTR, - JMP OMB1 -OMA9 LDA OMI8 =STA INSTR, -OMB1 ADD T1OM T(1) = T(1) + INSTR. - STA T1OM -OMB3 LDA T2OM SET A=T(2) - STA A - LDA T9OM OUTPUT INSTR. WITH T(1) AND T(9) - IAB - LDA T1OM - JST OB00 OUTPUT OA - LDA T8OM CHECK FOR T(8) = '=' - CAS K153 ='16 - JMP* OM00 - JMP *+2 - JMP* OM00 EXIT - LDA TRFA POINTER TO FIRST VARIABLE OR ARRAY - STA A PROCESSED IN EXPRESSION - JST TRSE OUTPUT TRACE COUPLING IF REQUIRED - JMP* OM00 EXIT OUTPUT ITEM -* -* -OMC1 LDA T0OM - CAS K152 CHECK FOR T(0) = 'F' - JMP *+2 - JMP OMA8 OUTPUT A LDA INSTR. - CAS K153 CHECK FOR T(0) = '=' - JMP *+2 - JMP OMA9 OUTPUT A STA INSTR, - CAS OM94 CHECK FOR T(0) = 'C' - JMP *+2 - JMP OM30 OUTPUT COMPLEMENT CODING - CAS K106 - JMP *+2 - JMP OMC5 OUTPUT AN ANA INSTR. - CAS K107 - JMP OM46 ERROR - JMP OM30 - JMP OM46 ERR0R -OMC5 LDA OMI9 =ANA INSTR. - JMP OMB1 -OMD1 IRS TXOM T0 = T0+1 - JMP OM05 -OME1 CRA - STA DF DF = 0 - JST OA00 OUTPUT ABSOLUTE -OME5 CRA - STA TXOM T0 = 0 - JMP OM05 -* -TRSE DAC 0 SUBROUTINE TO OUTPUT TRACE COUPLING - JST STXA SET INDEX = A - SZE - LDA DP+4,1 CHECK STATUS OF TRACE TAG - SPL - JMP TRS7 - SR4 - JMP TRS7 - LDA TRF CHECK STATUS OF TRACE FLAG - SNZ - JMP* TRSE -TRS7 JST NF00 SET LBUF TO 'F$', LSUF+2 TO SPACES - LDA OM93 ='TR' - STA NAMF+1 - JST CN00 OUTPUT.....CALL NAMF - JST STXA SET INDEX = A - LDA DP+4,1 - ANA OM95 - STA T1OM - LDA DP+3,1 - STA T8OM - LDA DP+2,1 - STA T9OM - CRA - STA DF - LDA DP,1 MERGE IM WITH ITEM NAME - ARS 9 - LGL 13 - ERA T1OM - JST OA00 OUTPUT ABSOLUTE (FIRST 2 CHAR.) - LDA T8OM - JST OA00 OUTPUT ABSOLUTE (NEXT 2 CHAR.) - LDA T9OM - JST OA00 OUTPUT ABSOLUTE (LAST 2 CHAR.) - JMP* TRSE -* -*.................INSTRUCTION TABLE -OMI0 OCT 100000 INDIRECT BIT -OMI1 OCT 114000 ADD* -OMI2 OCT 020000 JST -OMI3 OCT 104000 LDA* -OMI4 OCT 014000 ADD -OMI5 OCT 002000 JMP -OMI6 OCT 016000 SUB -OMI7 OCT 004000 LDA -OMI8 OCT 010000 STA -OMI9 OCT 006000 ANA -OMJ1 OCT 102000 JMP* -OMJ2 OCT 101040 SNZ -OMJ3 OCT 101400 SMI -OMJ4 ALS 16 -OMJ5 OCT 040461 LGR 15 -OMJ6 OCT 141216 ACA -OMJ7 OCT 140407 TCA -OMK1 OCT 140401 CMA -OMK2 OCT 101001 SSC -OMK3 OCT 141206 AOA -OMK4 OCT 140500 SSM -OMK5 OCT 042000 JMP 0,1 -OMK6 OCT 000000 DAC ** - ALS 1 ALS1 - TCA TCA -OMK7 OCT 176000 STG -OMK9 CAS 0 CAS - STA* 0 - SUB* 0 - DAC* ** - OCT 131001 - OCT 030000 SUBR - CAS* 0 -OMK8 OCT 0 (///) -OML1 LDA K101 - STA AT - JMP OT10 -* -* ************ -* *OUTPUT REL* -* ************ -* ALSO DRIVES SYMBOLIC INSTRUCTION OUTPUT. -OR00 DAC ** - STA FTOP - LDA K102 DF = NON ZER0 - STA DF CODE = 2 -OR10 STA CODE - LDA RPL LIST RPL - SSP - JST OR80 - DAC PRI -OR12 LDA DF IF DF NOT ZERO - SZE - JMP OR20 GO TO OR20 - LDA OR18 ='147703 - STA PRI+5 - LDA OR19 SET 'OCT' INTO PRINT IMAGE - STA PRI+6 - LDA FTOP -OR13 JST OR80 - DAC PRI+8 -OR15 LDA RPL IF RPL PLUS - SMI - JST OW00 OUTPUT WORD - SR2 - JMP *+3 SURPRESS SYMBOLIC OUTPUT - CALL F4$SYM LIST LINE - DAC PRI - JST PRSP SET PRINT BUFFER TO SPACES - JMP* OR00 RETURN -OR18 OCT 147703 (0)(C) -OR19 OCT 152240 (T)(SP) -OR20 JST SAV - LDA OR90 SEARCH OP-CODE LIST - TCA - STA XR PUT BCI IN PRINT IMAGE - LDA FTOP - SSP - SZE - JMP OR24 - LDA AT - CAS K103 - SUB K106 - ADD K102 - CMA - ANA K107 - STA CODE -OR24 LDA FTOP - CAS OR91+NINS,1 - JMP *+2 - JMP *+3 - IRS XR - JMP *-4 - LDA OR92+NINS,1 - STA PRI+5 - LDA OR93+NINS,1 - STA PRI+6 - JST RST - LDA A - SZE - JMP OR30 - LDA AF - ANA K111 MASK OUT HIGH BITS OF ADDRESS - JMP OR13 -OR30 JST STXA - LDA DP,1 - SMI - JMP OR40 - LDA K149 - STA PRI+8 SET =' INTO LISTING - LDA DP,1 CHECK IM (A) - LGL 4 - SPL SKIP IF NOT COMPLEX - JMP *+4 - LGL 2 - SPL SKIP IF INTEGER OR LOGICAL - JMP *+3 - LDA DP+2,1 - JMP *+2 LIST EXPONENT AND PART OF FRACTION - LDA DP+4,1 LIST INTEGER VALUE - JST OR80 CONVERT OCTAL - DAC PRI+9 - JMP OR15 -OR40 LDA DP+4,1 CONVERT AND PACK INTO - ALR 1 - SSM SYMBOLIC IMAGE - ARR 1 - SSM - STA PRI+8 - LDA DP+3,1 - STA PRI+9 - LDA DP+2,1 - STA PRI+10 - JMP OR15 -* *********** -* *OUTPUT ABS* -* *********** -OA00 DAC ** - STA FTOP - LDA OA00 - STA OR00 - CRA - JMP OR10 -* ******************* -* *OUTPUT STRING-RPL* -* ******************* -OS00 DAC 00 - STA AF - LDA OMK7 - STA FTOP - LDA OS00 - STA OR00 SET RETURN INTO OUTPUT REL - LDA K104 - STA CODE - STA STFL STRING FLAG = NON ZERO - JST PRSP SET PRINT BUF. TO SPACES - JMP OR20 JMP-OUTPUT REL FOR SYMBOLIC AND BINARY -OR80 DAC ** - IAB - LDA* OR80 - STA OR89 - CRA - LRR 2 - IRS OR80 - JST OR85 - JST OR85 - JST OR85 - JMP* OR80 -OR85 DAC ** - ADD K140 - LLR 3 - LGL 5 - ADD K140 - LLL 3 - STA* OR89 - IRS OR89 - CRA - JMP* OR85 -OR89 PZE 0 -OR90 DAC NINS -K200 EQU OMI7 -K201 EQU OMI5 -K202 EQU OMI8 -K203 EQU OMI4 -K204 EQU OMI6 -K205 EQU OMJ3 -K206 EQU OMJ1 -K207 EQU OMK5 -OR91 EQU OMI1 -OR92 BCI 22,ADJSLDADJMSULDSTANJMSNSMLLLRACTCCMSSAOSSJMDA - BCI 2,ALTC - BCI 9,STCASTSUDAERSUCA// -OR93 BCI 22,D*T A*D P B A A A P*Z I 1515A A A C A M PXC - BCI 2,S1A - BCI 9,G S A*B*C*R/BRS*/ -NINS EQU 32 -* -PRSP DAC ** SUBR. T0 SET PRINT BUF. T0 SPACES - LDA PRSK =-40 - STA 0 - LDA KASP (SP)(SP) - STA PRI+40,1 - IRS 0 - JMP *-2 - JMP* PRSP EXIT -PRSK OCT 177730 =-40 -* -* ************************************* -* *OUTPUT SUBROUTINE/COMMON BLOCK NAME* -* ************************************ -* OUTPUT AN EXTERNAL REFERENCE NAME. -* -ON00 DAC ** - STA ONT1 SAVE ADDRESS - JST FS00 FLUSH BUFFER IF NECESSARY - JST STXA SET INDEX=A - LDA ONT1 SUBR. ENTRY ADDR. - LRL 14 - STA ONT1 SAVE S/C BITS - LDA ON02 ='600 (=BLOCK CODE NO.) - LLL 6 - STA OCI FILL BUFFER - LRL 8 - JST STXA SET INDEX=A - LDA DP+4,1 FIHST 2 CHAR. 0F NAME - ANA K111 ='037777 - CAS *+1 - OCT 020240 - ERA K122 - ERA HBIT ='140000 - LRR 8 - STA OCI+1 BUFFER - LRL 8 - LDA DP+3,1 SECOND 2 CHAR. OF NAME - LRR 8 - STA OCI+2 BUFFER - LRL 8 - LDA DP+2,1 LAST 2 CHAR. OF NAME - LRR 8 - STA OCI+3 BUFFER - LLL 8 - LGL 2 - ADD ONT1 S/C BITS - LGL 6 - STA OCI+4 BUFFER - CRA SET SIZE = 0 - STA OCI+5 8UFFER - LDA K128 ='14 - STA OCNT SET 8LOCK SIZE (DOUBLED) - JST FS00 FLUSH BUFFER - JMP* ON00 EXIT -ON02 OCT 600 BLOCK CODE NUMBER (6) -ONT1 OCT 0 TEMP STORE -* -K149 BCI 1,=' -K140 OCT 26 -* -OW00 DAC ** - JST SAV - LDA RPL - SUB ORPL - SPL - TCA - CAS K101 - JST FS00 FLUSH BUFFER IF DIFFERENCE IN RPL'S N0T 1 - NOP - LDA OCNT - ADD K103 - CAS K146 - NOP - JST FS00 FLUSH BUFFER - LDA OCNT - ADD K103 - STA OCNT OCNT = OCNT+3 - SUB K103 - ARR 1 OCI (OUTPUT CARD IMAGE) - STA XR - SMI LEFT OR RIGHT POS, - JMP OW20 - JST PU00 - LRL 8 IF BUFFER FULL - IMA OCI,1 - ANA K116 CALL FLUSH (FS0O) - ERA OCI,1 -OW10 STA OCI,1 - IAB - STA OCI+1,1 - LDA PRI+16 - IAB - LDA PRI+14 USE LOW BIT OF PRI+14 DATA - LLL 9 - LGR 1 STRIP OFF HIGH BIT OF BLOCK CODE TYPE NO, - LLL 3 SET DIGITS IN PRI+17, PRI+19 - JST OR80 - DAC PRI+16 - LDA PRI+14 - LRL 6 - LGL 1 SHIFT ADDR. TO RIGHT BY 1 BIT - LLL 5 - JST OR80 SET DIGITS IN PRI+15, PRI+16 - DAC PRI+14 - LDA KASP (SP)(SP) - SR1 - JMP OW14 - STA PRI+15 OVERWRITE BINARY DATA IN - STA PRI+16 PRINT BUFFER WITH SPACES - STA PRI+17 IF NO BINARY LISTING IS WANTED - STA PRI+18 -OW14 STA PRI+14 - JST RST - LDA RPL - STA ORPL ORPL=RPL - CRA - IMA STFL INDICATE WORD WAS KEY TO LOADER - SNZ THEN LEAVE RPL ALONE - IRS RPL RPL = RPL+1 - JMP* OW00 -STFL PZE 0 -OW20 JST PU00 - JMP OW10 -ORPL PZE 0 -PU00 DAC ** - LDA CODE COMBINE CODES TO - CAS K104 =4 - NOP - JMP PU10 - SZE SKIP IF ABS - JMP PU10 JUMP IF REL. - LRL 8 - LDA FTOP -PU08 LRL 4 - STA PRI+14 SAVE FOR LISTING - IAB - STA PRI+16 - LRR 12 RESTORE POSITION - JMP* PU00 -PU10 LRL 4 - LDA AF - LRL 4 - ERA FTOP - JMP PU08 -PU20 LRL 4 - LDA AF - ANA K111 - LRL 4 - IMA AF - ANA K114 - ERA AF - JMP PU08 -K114 OCT 14000 -K146 OCT 117 -* -* -* ****************** -* *FLUSH SUBROUTINE* -* ****************** -FS00 DAC ** - LDA OCNT BUFFER OCCUPANCY SIZE - JST SAV SAVE INDEX REGESTER - SUB K104 CHECK FOR OCNT .GT. 4 - SPL - JMP FS20 SKIP OUTPUT IF BUFFER IS EMPTY - ADD K105 ADD 1/2 AT B14 - ARS 1 DIVIDE BY 2 - TCA - STA OCNT OCNT = -WORDS/BUFFER - SUB K101 =1 - STA PCNT BUFFER SIZE INCLUDING CHECKSUM - LDA OCI FIRST WORD IN BUFFER - LRL 12 - CAS K102 =2 - JMP *+2 - JMP FS30 BLOCK TYPE = 2 (RELOCATABLE CODE) -* EVERY TIME A BLOCK OF OBJECT OUTPUT IS DUMPED, THE FIRST -* 3 WORDS OF THE BLOCK IS INSERTED IN THE SYMBOLIC OUTPUT -* ALONG WITH AN EOB OPERATOR CODE IF SENSE SWITCH 1 1S DOWN. -* TO INHIBIT THIS LINE, REPLACE FROM FS10 TO AND INCLUDING -* FS11 WITH (FS10 CRA ). -FS10 SS1 - JMP FS11 N0 BINARY LISTING UNLESS SSW-1 IS DOWN - CALL F4$SYM - DAC PRI OUTPUT WHATEVER MIGHT BE IN SYMBOLIC BUF. - LDA FS41 =(E)(O) - STA PRI+5 ENTER 'EOB' INTO LISTING - LDA FS41+1 =(B)(SP) - STA PRI+6 - LDA OCI - JST OR80 ENTER FIRST WORD FROM BUFFER INTO LISTING - DAC PRI+8 - LDA OCI+1 - JST OR80 ENTER WORD 2 FROM BUFFER INTO LISTING - DAC PRI+12 - LDA OCI+2 - JST OR80 ENTER WORD 3 FROM BUFFER INTO LISTING - DAC PRI+16 - CALL F4$SYM OUTPUT SYMBOLIC BUFFER - DAC PRI - JST PRSP RESET SYMBOLIC BUFFER TO SPACES -FS11 CRA - STA 0 COMPUTE CHECKSUM -FS12 ERA OCI,1 MERGE BUFFER WORD INTO CHECKSUM - IRS 0 INCREMENT BUFFER POSITION - IRS OCNT DECREMENT BUFFER SIZE - JMP FS12 - STA OCI,1 SET CHECKSUM INTO BUFFER - LDA PCNT = NO. OF WORDS IN BUFFER - IMA 0 - ADD FS40 = OCI+1,1 - CALL F4$OUT PUNCH BUFFER -FS20 LDA RPL SET UP BUFFER FOR NEXT OUTPUT - LRL 8 - ADD K145 =#'2000 (BLOCK CODE 2) - STA OCI - IAB - STA OCI+1 SET FIRST 2 WORDS OF BUFFER - LDA K103 =O - STA OCNT RESET BUFFER OCCUPANCY SIZE - JST RST RESET INDEX REGISTER - JMP* FS00 EXIT -* -FS30 LGL 6 MERGE BUFFER SIZE INTO BLOCK HEADER - SUB OCNT BUFFER SIZE - ADD K101 =1 (ACCOUNT FOR CHECKSUM) - LLR 6 - LGR 6 - LLL 6 BRING IN UPPER HALF OF ADDRESSES - STA OCI STORE INTO BUFFER - JMP FS10 COMPUTE CHECKSUM -* -FS40 DAC OCI+1,1 -FS41 BCI 2,EOB 'EOB' -K145 OCT 20000 BLOCK TYPE 2 CODE -C499 OCT 060000 -* -OCI BSS 40 40 WORD CARD IMAGE INPUT BUFFER -PRI BSS 40 40 WORD PRINT BUFFER - BCI 20, - BSS 30 COMPILER PATCH AREA -* -* *********************** -* *IOS (AND IOL) GO HERE* -* *********************** -* - END A0