From: hachti Date: Tue, 29 May 2007 04:42:21 +0000 (+0000) Subject: *** empty log message *** X-Git-Url: http://gitweb.hachti.de/?a=commitdiff_plain;h=faae1561176447b3da7f953fdba7095b777dfeb9;p=h316.git *** empty log message *** --- diff --git a/lib/fortran/src/reboot.asm b/lib/fortran/src/reboot.asm new file mode 100644 index 0000000..a178e48 --- /dev/null +++ b/lib/fortran/src/reboot.asm @@ -0,0 +1,15 @@ +* (REBOOT) RESTART COMPUTER AT LOCATION 1 (BOOT LOADER) +* +* +****** USAGE +* +* JST REBOOT +* +* +* + SUBR REBOOT,RB + REL +RB JMP 1 + JMP 1 +* + END diff --git a/programs/fortran/src/frtn_1_of_5.asm b/programs/fortran/src/frtn_1_of_5.asm new file mode 100644 index 0000000..cba0cee --- /dev/null +++ b/programs/fortran/src/frtn_1_of_5.asm @@ -0,0 +1,1062 @@ +* C210-001-6601 (FRTN) 3C NO.180463000 REV. D +* +* TAPE 1 OF 5 - BEGIN +* +* +* 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. +* +* TAPE 1 OF 5 - END + MOR diff --git a/programs/fortran/src/frtn_2_of_5.asm b/programs/fortran/src/frtn_2_of_5.asm new file mode 100644 index 0000000..8dede02 --- /dev/null +++ b/programs/fortran/src/frtn_2_of_5.asm @@ -0,0 +1,1648 @@ +* TAPE 2 OF 5 - BEGIN +* +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 +* +* TAPE 2 OF 5 - END + MOR diff --git a/programs/fortran/src/frtn_3_of_5.asm b/programs/fortran/src/frtn_3_of_5.asm new file mode 100644 index 0000000..c09adf9 --- /dev/null +++ b/programs/fortran/src/frtn_3_of_5.asm @@ -0,0 +1,1449 @@ +* TAPE 3 OF 5 - BEGIN +* +* +* ************************** +* *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 +* +* +* TAPE 3 OF 5 - END + MOR diff --git a/programs/fortran/src/frtn_4_of_5.asm b/programs/fortran/src/frtn_4_of_5.asm new file mode 100644 index 0000000..db9193f --- /dev/null +++ b/programs/fortran/src/frtn_4_of_5.asm @@ -0,0 +1,1581 @@ +* TAPE 4 OF 5 - BEGIN +* +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 +* +* TAPE 4 OF 5 - END + MOR diff --git a/programs/fortran/src/frtn_5_of_5.asm b/programs/fortran/src/frtn_5_of_5.asm new file mode 100644 index 0000000..5c0d1cf --- /dev/null +++ b/programs/fortran/src/frtn_5_of_5.asm @@ -0,0 +1,1447 @@ +* TAPE 5 OF 5 - BEGIN +* +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