* 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