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