Forgot your password?
Document Actions
Version of transcription of SAP assembly source code for online viewing
Click here to get the file
File contents
<html>
<head>
<title>
Assembly language (SAP) source code of 4K and 8K drum versions of the
final IBM 704 FORTRAN II compiler
</title>
</head>
<body>
<pre>
REM BINARY AND SYMBOLIC SUBROUTINE LOADER FOR 704 FORTRAN II
rem ------ scanned 9/6/07 304349-VOlume_III.pdf Page 76/960 ------
LIST SYN 32575
TABL SYN 32554
TOOMCH SYN LIST-20
FUL
ORG 0
VR LXA 0,1
SM CPY 2,1
TXI SM,1,-1
TG HTR 0,1
LTM
X RCD
RB CPY LIST-21,1
LB TXI RB,1,-1
R
TXH X,1,-200
LXD M,1
SXD M,1
STZ LIST-20
READ RCD
CPY VR
TRA TEST
HTR READ
END STZ 0,2
TIX END,2,1
TOV PROG
PROG TRA
T
S 24
ADDRS OCT 000000077777
ABS
ORG LIST+1
TEST CLA VR
CPY SM
TMI PASS1 PREFIX IS 4 IF PROGRAM CARD
TZE READ
STZ PRTST SIGNAL END LOADING SEQUENTIAL PROG. CARDS
LXD VR,1
TXL REG,1,31
TXH 0,1,32
STA T
ADD S
STA S
CLA SM
STA U
TRA READ
REG STA R
ARS 15
U PDX 0,4
TXL NR,4,1
TSX LT,2
STA R
NR CAL VR
ARS 18
ADD R
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 77/961 ------
STA TR
LXD VR,2
TR TXL 0,2
STA TA
STA SA
STA SD
STA TD
B STA CP
CAL VR
TXL CP,4,1
CAD LB
CAD RB
CP CAD 0,2
TIX CP,2,1
TXL CT,4,0
TXL READ,4,1
TXL CT,4,2
TXL RL,4,3
CT SLW VR
CLA SM
TZE RT
SUB VR
TZE RT
HPR
RT TXL READ,4,1
TXH SR,4,3
RL LDQ RB
DB CLA LB
LGL 1
SLW LB
TPL AB
TD CLA 0,1
ARS 18
TSX CB,2
ALS 18
SD STD 0,1
AB CLA LB
LGL 1
SLW LB
TPL TV
TA CLA 0,1
TSX CB,2
SA STA 0,1
TV TIX DB,1,1
TRA READ
CB STA R
CLA LB
LGL 1
SLW LB
TMI LTA WILL ADDRESS BE MISLEADING
LT SLN 1 NO, CODE IS 10, TURN ON SENSE LIGHT
LTA CLS R DOES THIS ADDRESS REFER TO PROGRAM OR DATA
ADD T
TPL ADDS
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 78/962 ------
SLT 1 APPEARS TO BE DATA, BUT WHAT WAS CODE
TRA PROGRM ACTUALLY PROGRAM, ADD CURRENT INCREMENT
DATA CLA R IS DATA REFERENCE, DECREMENT
ADM U
TRA 1,2
ADDS SLT 1 APPEARS TO BE PROGRAM, WHAT WAS CODE
TRA DATA ACTUALLY IS DATA REFERENCE, DECREMENT
PROGRM SUB S
TRA 1,2
PASS1 PDX 0,2 - WORD COUNT IN DEC. OF AC
TXL PASS2,2,0 WORD COUNT IS 0, GO TO 2ND PASS
ADD TAG - LENGTH OF SYMB. TABLE IN DEC.
ADD DECTWO TO ALLOW SPACE IN TABLE FOR LOC. + LENGTH
STD STOP STORE NEW LENGTH IN INST. TO STOP RELOC.
SUB M ADDRS. TABLE + 1 - WORD COUNT + LENGTH TAB
STD OVLP STORE L0WEST ADDRS. FOUND, TO COMPARE TO S
ACL VR
SUB DECTWO
ARS 18
DECTWO TIX TXB,2,2
TXB TSX B,4 FORCE IR 4 FOR CHECK SUM, BUT NOT RELOCATE
SR LXD TAG,1 LOAD OLD TABLE LENGTH
CLA PRTST HAS ANOTHER PROGRAM CARD PRECEEDED
TZE ONLY1 THIS ONE
CLA LB YES, LB HAS NAME, RB HAS
STO TABL-1,1 ENTRY POINT
CLA RB
STO TABL,1
TIX NCARDS,1,2 SKIP, COMPARISONS ALREADY DONE
ONLY1 CLA S STORE LOCATION OF TRA VECTOR IN
STZ TABL-1,1
STO TABL,1 SYMBOL TABLE, S HAS ADDRESS ONLY
LXD LB,4
TXH CLAS,4,0
CLA BTMASK
STO TABL-1,1
CLAS CLA LB STORE LENGTH OF VECTOR IN
STD TABL-1,1 SYMBOL TABLE
STA T STORE LENGTH OF ROUTINE IN T
ADD S UPDATE S
STA S
PAX 0,2 COMPARE S TO LOWEST ADDRESS OF TABLE
OVLP TXH TG,2,0 TRA TG, TABLE + INST. OVERLAP
CLA U FIND LOWEST ADDRESS DATA WILL USE
SUB RB
PAX 0,4
PXD 0,4
ARS 18
TZE ACLA
CAS ADDRS
ACLA CLA ADDRS
NOP
STO ADDRS
SUB S
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 79/963 ------
TMI TOOMCH TRA TOOMCH, DATA + INSTR. WILL OVERLAP
NCARDS SXD PRTST,2 SIGNAL TO SEQUENTIAL PROGRAM CARDS
STZ LB MAY COMPLEMENT IF 1 IS FOUND
TXI LTT,1,2 TO GET PAST LOC. + LENGTH OF VECTOR
LTT CLA TABL,1
TSX CB,2 RELOCATE ENTRY POINTS IN TABLE
STA TABL,1
TXI STOP,1,2
STOP TXL LTT,1,0
SXD TAG,1 SAVE LENGTH OF TABLE
M TNX READ,0,TABL
VEC CAL TABL+1,2
TNZ G3
CLA TABL+2,2
STA PROG
TRA PASS2
G3 ANA BTMASK
TNZ PASS2
CLA TABL+1,2
OLDU PDX 0,4 LENGTH OF VECTOR
ARS 18
ADD TABL+2,2 PLUS LOACTION OF VECTOR
STA A
STA AA
STA AAA
STA ABB
NXTVC LXD TAG,1 LENGTH OF SYMBOL TABLE
A CAL 0,4
ANA BTMASK
TZE TIXVEC
ABB CLA 0,4 LOOK FOR FIRST NAME IN TRA VECTOR
NXTNAM CAS TABL+1,1 IN SYMBOL TABLE
TTR TTR G4
TRA FIX
G4 TIX NXTNAM,1,2 LOOK AT NEXT NAME IN TABLE
SAVNAM STO RB
LXD TWTY,1
CMPR CLA LIST,1
TZE STONAM STORE IN FIRST EMPTY CELL
CAS RB IF NEW NAME
TWTY TNX G2,0,20
TRA TIXVEC ALREADY IN TABLE, IGNORE
G2 TIX CMPR,1,1
HTR PASS2 MORE THAN 20 ENTRIES TO BE SEARCHED FOR
STONAM CLA RB
STO LIST,1
STZ LIST+1,1
TRA TIXVEC
FIX CLA TTR
AA STO 0,4
CLA TABL+2,1
AAA STA 0,4
TIXVEC TIX NXTVC,4,1 GET NEXT NAME IN VECTOR
PASS2 TXI TAG,2,2 IR 2 IS 0 AT BEGINING
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 80/964 ------
TAG TXL VEC,2,0
CLA TABL+1 0 IF ALL NAMES WERE FOUND
TNZ SEARCH
TXI END,2,212 CLEARS SYMBOL TABLE, LIST + LOADER
SEARCH HTR READ-1
BTMASK OCT 700000000000
PRTST
END
REM MU LBL 3 0026 CARDS LOWER BINARY LOADER-ONE CARD MULBL301
FUL
LBL3 LXA 0,4 CLEAR IR4 LBL30002
CPY 2,4 COPY LOADER INTO 2,3, ETC LBL30003
TXI 1,4,32767 REPEAT UNTIL LOADER IN LBL30004
HTR 31 MASK FOR WORD COUNT LBL30005
LTM END OF CARD, LEAVE TRAPPING MODE LBL30006
RCD SELECT CARD READER LBL30007
CPY 0 9L IN 0 AND MQ LBL30008
LLS 17 WORD COUNT IN AC ADDRESS LBL30009
ANA 3 EXTRACT WORD COUNT (=WC) LBL30010
CPY 1 9R IN 1 (CHECK SUM) LBL30011
TZE 0 IF WC=0, HAVE TRANSFER CARD, GO TO IT LBL30012
PAX 0,4 IF WC NOT 0, PUT IT IN IR4 LBL30013
ADD 0 (WC+LA) IN AC ADDRESS (LA=LOAD ADDRESS) LBL30014
STA 16 PLANT (WC+LA) AS CPY ADDRESS LBL30015
STA 17 AND AS ACL ADDRESS LBL30016
CAL 0 PREPARE FOR LOGICAL SUM LBL30017
CPY 0,4 COPY WORD FORM BINARY CARD LBL30018
ACL 0,4 AND ADD IT TO LOGICAL SUM LBL30019
TIX 16,4,1 REPEATING UNTIL DONE LBL30020
SLW 2 FORM (CARD SUM) - (CHECK SUM) LBL30021
CLA 2 X LBL30022
SUB 1 X LBL30023
TZE 5 IF 0, PROCEED TO NEXT CARD LBL30024
HTR 5 IF NOT 0, HALT, PROCEED ON START LBL30025
END 0 LBL30026
REM TAPE DUPLICATING PROGRAM F2TCVP
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 71/955 ------
ORG 24
DUP000 REW SOURCE
REW OBJECT
RTT TURN OFF RTT TRIGGER
TXH
LXD DUP020,7 INITIALIZE INDEX REGISTERS TO 27
RDS SOURCE READ 1-CS FROM SOURCE
DUP010 CPY RECORD+27,1
TXI DUP010,1,-1
DUP020 HTR 0,0,27 MACHINE ERROR
IOD EOR-DELAY
RTT
HTR DUP000 RTT ERROR-- TRY AGAIN
WRS OBJECT WRITE 1-CS ONTO OBJECT
DUP030 CPY RECORD+27,2
TIX DUP030,2,1
IOD
RTT TURN OFF RTT TRIGGER
DUP031 TXH DUP170,0,0
BST OBJECT
RDS OBJECT READ BACK 1-CS FROM OBJECT
DUP040 CPY DUMMY
TRA DUP050
HTR
TRA DUP060 EOR
DUP050 CLA RECORD+27,4
CAS DUMMY
HTR DUP000 WORD COMP. FAILS-READING
TXI DUP040,4,-1
HTR DUP000 FROM OBJECT
DUP060 TXH DUP280,4,0 ERROR-INCOMPLETE OBJECT RECORD
IOD
RTT
HTR DUP000 RTT ERROR READING BACK OBJECT 1-CS
DUP070 LXD DUP031,7 INITIALIZE INDEX REG TO 0
PXD CLEAR AC
DUP071 RDS SOURCE READ SOURCE 1ST/2ND FILE RECORD
CPY RECORD,1
TXI DUP090,1,-1
DUP080 TRA DUP160 EOF
HTR MACNINE ERROR
DUP090 CAD RECORD,1
TXI DUP090,1,-1
HTR MACHINE ERROR
COM EOR
ACL RECORD
COM
TZE DUP100
HTR DUP290 CKSM FAILS READING SOURCE 1ST/2ND FILE
DUP100 IOD
RTT
HTR DUP300 RTT ERROR-BST AND TRY AGAIN
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 72/956 ------
SXD DUP120,1
SXD DUP150,1
WRS OBJECT WRITE OBJECT 1ST/2ND FILE RECORD
DUP110 CPY RECORD,2
TXI DUP120,2,-1
DUP120 TXH DUP110,2,**
DUP121 IOD
RTT TURN OFF RTT TRIGGER
TXH
BST OBJECT
RDS OBJECT READ BACK OBJECT 1ST/2ND FILE RECORD
DUP130 CPY DUMMY
TRA DUP140
HTR MACHINE ERROR
TRA DUP150 EOR
DUP140 CLA RECORD,4
CAS DUMMY
HTR DUP310 C0MP. ERROR ON 1ST/2ND FILE RECORD
TXI DUP130,4,-1
HTR DUP310 DITTO
DUP150 TXH DUP320,4,** ERROR-INCOMPLETE OBJECT RECORD
IOD
RTT
HTR DUP310 RTT ERROR-BST AND TRY AGAIN
TRA DUP070
DUP160 IOD
RTT
HTR DUP340 RTT ERROR - BST TWICE ON SOURCE
WEF OBJECT WRITE 1ST EOF
IOD
RTT TURN OFF RTT TRIGGER
TXH
CLA DUP031
STA DUP080
TRA DUP070
DUP170 IOD
RTT
HTR DUP340 RTT ERROR- BST TWICE ON SOURCE
WEF OBJECT WRITE 2ND EOF
DUP171 IOD
RTT TURN OFF RTT TRIGGER
TXH
DUP180 LXD DUP031,7 INITIALIZE INDEX REG TO 0
PXD CLEAR AC
DUP181 RDS SOURCE READ SOURCE 3RD FILE RECORD
CAD RECORD,1
TXI DUP190,1,-1
TRA DUP270 EOF
HTR MACHINE ERROR
DUP190 CPY RECORD,1 CPY CKSM INTO RECORD+1
TXI DUP200,1,-1
DUP200 CAD RECORD,1
TXI DUP200,1,-1
HTR MACHINE ERROR
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 73/957 ------
COM EOR
ACL RECORD+1
COM
TZE DUP210
HTR DUP350 CKSM FAILS READING SOURCE 3RD FILE
DUP210 IOD
RTT
HTR DUP350 RTT ERROR-BST
SXD DUP230,1
SXD DUP260,1
WRS OBJECT WRITE OBJECT 3RD FILE RECORD
DUP220 CPY RECORD,2
TXI DUP230,2,-1
DUP230 TXH DUP220,2,**
DUP231 IOD
RTT TURN 0FF RTT TRIGGER
TXH
BST OBJECT
RDS OBJECT READ BACK OBJECT 3RD FILE RECORD
DUP240 CPY DUMMY
TRA DUP250
HTR MACHINE ERROR
TRA DUP260 EOR
DUP250 CLA RECORD,4
CAS DUMMY
HTR DUP360 COMP. ERROR ON 3RD FILE
TXI DUP240,4,-1
HTR DUP360 ERROR- INCOMPLETE OBJECT RECORD
DUP260 TXH DUP370,4
IOD
RTT
HTR DUP360 RTT ERROR-BST
TRA DUP180
DUP270 IOD
RTT
HTR DUP390 RTT ERROR - BST TWICE
WEF OBJECT WRITE 3RD FILE EOF
FILE40 LXD DUP031,7 DUPLICATE FILE 4
PXD
RDS SOURCE READ SOURCE FILE 4 RECORD
FILE41 CPY RECORD,1
TXI FILE41,1,-1
TRA FILE47 EOF
IOD EOR
RTT
HTR FIL4E1 RTT ERROR - BST AND TRY AGAIN
SXD FILE43,1
SXD FILE46,1
WRS OBJECT WRITE OBJECT 4TH FILE RECORD
FILE42 CPY RECORD,2
TXI FILE43,2,-1
FILE43 TXH FILE42,2,**
FILE50 IOD
RTT TURN OFF RTT TRIGGER
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 74/958 ------
TXH
BST OBJECT
RDS OBJECT READ BACK OBJECT 4TH FILE RECORD
FILE44 CPY DUMMY
TRA FILE45
HTR MACHINE ERROR
TRA FILE46 EOR
FILE45 CLA RECORD,4
CAS DUMMY
HTR FIL4E2 COMP. ERROR ON 4TH FILE RECORD
TXI FILE44,4,-1
HTR FIL4E2 COMP. ERROR ON 4TH FILE RECORD
FILE46 TXH FIL4E4,4,** ERROR - INCOMPLETE OBJECT RECORD
IOD
RTT
HTR FIL4E2 RTT ERROR - BST AND TRY AGAIN
TRA FILE40
FILE47 IOD
RTT
HTR FIL4E3 RTT ERROR - BST TWICE ON SOURCE
WEF OBJECT WRITE 4TH FILE EOF
REW SOURCE
REW OBJECT
RTT
TXH
HTR FINAL STOP.
DUP280 HTR DUP000
DUP290 RTT
TXH
DUP300 BST SOURCE
TRA DUP070
DUP310 LXD DUP031,4
TRA DUP121
DUP320 HTR DUP330
DUP330 RTT
TXH
BST SOURCE
BST OBJECT
TRA DUP070
DUP340 BST SOURCE
BST SOURCE
RDS SOURCE
TRA DUP071
DUP350 BST SOURCE
TRA DUP171
DUP360 LXD DUP031,4
TRA DUP231
DUP370 HTR DUP380
DUP380 BST SOURCE
BST OBJECT
TRA DUP171
DUP390 BST SOURCE
BST SOURCE
RDS SOURCE
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 75/959 ------
TRA DUP181
FIL4E1 BST SOURCE
TRA FILE40
FIL4E2 LXD DUP031,4
TRA FILE50
FIL4E3 BST SOURCE
BST SOURCE
RDS SOURCE
TRA FILE40+2
FIL4E4 HTR FIL4E5
FIL4E5 RTT
TXH
BST SOURCE
BST OBJECT
TRA FILE40
SOURCE SYN 149
OBJECT SYN 145
RECORD SYN 300
DUMMY SYN 299
END 24
REM MU LBL 3 0026 CARDS LOWER BINARY LOADER-ONE CARD MULBL301
FUL
LBL3 LXA 0,4 CLEAR IR4 LBL30002
CPY 2,4 COPY LOADER INTO 2,3, ETC LBL30003
TXI 1,4,32767 REPEAT UNTIL LOADER IN LBL30004
HTR 31 MASK FOR WORD COUNT LBL30005
LTM END OF CARD, LEAVE TRAPPING MODE LBL30006
RCD SELECT CARD READER LBL30007
CPY 0 9L IN 0 AND MQ LBL30008
LLS 17 WORD COUNT IN AC ADDRESS LBL30009
ANA 3 EXTRACT WORD COUNT (=WC) LBL30010
CPY 1 9R IN 1 (CHECK SUM) LBL30011
TZE 0 IF WC=0, HAVE TRANSFER CARD, GO TO IT LBL30012
PAX 0,4 IF WC NOT 0, PUT IT IN IR4 LBL30013
ADD 0 (WC+LA) IN AC ADDRESS (LA=LOAD ADDRESS) LBL30014
STA 16 PLANT (WC+LA) AS CPY ADDRESS LBL30015
STA 17 AND AS ACL ADDRESS LBL30016
CAL 0 PREPARE FOR LOGICAL SUM LBL30017
CPY 0,4 COPY WORD FORM BINARY CARD LBL30018
ACL 0,4 AND ADD IT TO LOGICAL SUM LBL30019
TIX 16,4,1 REPEATING UNTIL DONE LBL30020
SLW 2 FORM (CARD SUM) - (CHECK SUM) LBL30021
CLA 2 X LBL30022
SUB 1 X LBL30023
TZE 5 IF 0, PROCEED TO NEXT CARD LBL30024
HTR 5 IF NOT 0, HALT, PROCEED ON START LBL30025
END 0 LBL30026
REM FNEDT2 REVISED FORTRAN EDITING PROGRAM EDT 0001
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 57/941 ------
REM EDT 0002
ORG 32 EDT 0003
REW 1 REWIND EDT 0004
REW 5 TAPES EDT 0005
CAL IDEOF INITIALISE THIS CARD EDT 0006
SLW THISCD TO END FILE EDT 0007
TSX ONE2CS,4 TSX TO TRANSCRIBE SPECIAL FIRST RCD EDT 0008
REENTR CAL THISCD MAIN LOOP REENTRY EDT 0009
ALS 3 MOVE THIS CARD EDT 0010
SLW LASTCD INTO LAST CARD EDT 0011
RCD READ EDT 0012
LXD ZERO14,1 THE NEXT CARD EDT 0013
A1 CPY CDBUF,1 INTO EDT 0014
TXI A1,1,-1 CARD BUFFER EDT 0015
A2 HTR A2 FALSE END OF FILE IN READING CARD EDT 0016
CAL CDBUF TEST EDT 0017
COM EDT 0018
STD A4 EDT 0019
CAL CDBUF CHECK EDT 0020
LXD ZERO14,1 EDT 0021
A3 TXI A4,1,-1 EDT 0022
A4 TXL A5,1,* SUM EDT 0023
ACL CDBUF+1,1 EDT 0024
TRA A3 EDT 0025
A5 COM EDT 0026
ACL CDBUF+1 EDT 0027
COM EDT 0028
TZE A6 EDT 0029
HPR CHECK SUM ERROR IN READING CARD EDT 0030
A6 CAL CDBUF SET UP EDT 0031
ARS 33 THIS CARD EDT 0032
STA THISCD AND EDT 0033
ORA LASTCD SITUATION EDT 0034
SLW SITWD WORD EDT 0035
LXA ZERO14,1 TABLE SEARCH EDT 0036
A7 CAL TABLE+14,1 EDT 0037
LRS 18 FOR EDT 0038
CAS SITWD EDT 0039
TRA A8 SITUATION EDT 0040
TRA A9 EDT 0041
A8 TIX A7,1,1 EDT 0042
ILLEGL HTR ILLEGL SEARCH FAILED. ILLEGAL SITUATION. EDT 0043
A9 LLS 18 EDT 0044
STA A10 EDT 0045
A10 TRA * EDT 0046
REM EDT 0047
REM THERE FOLLOW THE 8 POSSIBLE SITUATION SUBROUTINES EDT 0048
REM EDT 0049
EOFEND TSX LB,4 SEQUENCE EOF-END EDT 0050
EOFMR TSX SAVE,4 SEQUENCE EOF-MR EDT 0051
TSX CLEAR,4 EDT 0052
TSX READ,4 EDT 0053
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 58/942 ------
TRA REENTR E0T 0054
EOFNR TSX SAVE,4 SEQUENCE EOF-NR E0T 0055
TSX CLEAR,4 EDT 0056
TRA REENTR EDT 0057
PRGEND TSX WRITE,4 SEQUENCE PROG-END EDT 0058
TSX LB,4 MR-END EDT 0059
PRGEOF TSX WRITE,4 SEQUENCE PR0G-EOF EDT 0060
WEF 145 MR-EOF EDT 0061
TRA REENTR EDT 0062
PRGPRG TSX MOVE,4 SEQUENCE PROG-PROG EDT 0063
TRA REENTR MR-PR0G, NR-PROG EDT 0064
PRGMR TSX WRITE,4 SEQUENCE PROG-MR EDT 0065
TSX SAVE,4 MR-MR EDT 0066
TSX CLEAR,4 EDT 0067
TSX READ,4 EDT 0068
TRA REENTR EDT 0069
PRGNR TSX WRITE,4 SEQUENCE PROG-NR EDT 0070
TSX SAVE,4 MR-NR EDT 0071
TSX CLEAR,4 EDT 0072
TRA REENTR EDT 0073
TABLE EOFEND,0,39 TABLE OF SITUATIONS EDT 0074
EOFMR,0,33 EDT 0075
EOFNR,0,34 EDT 0076
PRGEND,0,7 EDT 0077
PRGEOF,0,4 EDT 0078
PRGPRG,0,0 EDT 0079
PRGMR,0,1 EDT 0080
PRGNR,0,2 EDT 0081
PRGEND,0,15 EDT 0082
PRGEOF,0,12 EDT 0083
PRGPRG,0,8 E0T 0084
PRGMR,0,9 EDT 0085
PRGNR,0,10 EDT 0086
PRGPRG,0,16 EDT 0087
ZERO14 14 EDT 0088
IDEOF 4 EDT 0089
THISCD EDT 0090
LASTCD EDT 0091
SITWD EDT 0092
CDBUF SYN 8 EDT 0093
REM THERE FOLLOW THE 7 SUBROUTINES EDT 0094
REM ONE2CS, LB, SAVE, CLEAR, READ, WRITE, MOVE EDT 0095
REM EDT 0096
ONE2CS RTT TRANSCRIBES EDT 0097
NOP SPECIAL EDT 0098
RTB 5 IST RECORD EDT 0099
LXD ZERO14,1
LXA ZEROTW,2
RCD
CS1 CPY MAINBF,1
TXI CS1,1,-1
HTR *
TIX CS1-1,2,1
LXD ZERO14,1
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 59/943 ------
WTB 1
CS2 CPY MAINBF,1
TXI CS3,1,-1
CS3 TXH CS2,1,-27
IOD
TRA 1,4
ZEROTW 2
REM EDT 0124
LB RCD PRESSES LOAD CARDS BUTTON EDT 0125
CPY 0 EDT 0126
CPY 1 EDT 0127
TRA 0 EDT 0128
REM EDT 0129
SAVE CAL CDBUF+2 SAVES CONTROL INFORMATION EDT 0130
SLW EIGHTL FROM MR OR NR CARD EDT 0131
STA NEWBEG EDT 0132
CAL CDBUF+3 EDT 0133
SLW EIGHTR EDT 0134
TRA 1,4 EDT 0135
EIGHTL EDT 0136
EIGHTR EDT 0137
NEWBEG EDT 0138
REM EDT 0139
CLEAR PXD 0,0 CLEARS MAIN BUFFER EDT 0140
LXA BUFSIZ,1 EDT 0141
CL1 SLW 0,1 EDT 0142
TIX CL1,1,1 EDT 0143
TRA 1,4 EDT 0144
BUFSIZ -MAINBF EDT 0145
REM EDT 0I46
READ RTT READS RECORD EDT 0147
NOP FROM EDT 0148
RTB 5 1NSTER TAPE EDT 0149
PXD 0,0 INTO MAIN BUFFER EDT 0I50
LXD ZERO14,1 EDT 0I51
CPY CHKSUM EDT 0152
TRA RD1 EDT 0153
TRA READ EDT 0154
RD1 CAD FSTWD EDT 0155
ANA ADDMK EDT 0156
SUB NEWBEG E0T 0157
TMI RD6 E0T 0158
COM EDT 0159
RD2 PAX 0,1 EDT 0160
CAL FSTWD EDT 0161
RD3 TXL RD7,1,MAINBF-1 EDT 0162
CAD MAINBF-1,1 E0T 0163
RD4 TXI RD3,1,-1 E0T 0164
L1 HTR 1 FALSE EOF IN READING MASTER TAPE EDT 0165
RD5 RQL 255 EDT 0166
RQL 255 EDT 0167
RTT EDT 0I68
TRA RD8 EDT 0169
COM EDT 0170
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 60/944 ------
ACL CHKSUM EDT 0171
COM EDT 0172
TNZ RD8 EDT 0173
TRA 1,4 EDT 0174
RD6 ADD L1 EDT 0175
TRA RD2 EDT 0176
RD7 CAD 0 EDT 0I77
TRA RD4 EDT 0I78
TRA L1 EDT 0179
TRA RD5 EDT 0180
RD8 BST 5 EDT 0181
HTR READ ERROR IN READING MASTER TAPE EDT 0182
CHKSUM EDT 0183
FSTWD EDT 0184
ADDMK -1 EDT 0185
REM EDT 0186
WRITE CLA EIGHTR WRITES RECORD FROM MAIN BUFFER EDT 0187
SUB NEWBEG INTO SECONDARY TAPE EDT 0188
TMI 1,4 EDT 0189
ALS 18 EDT 0190
COM EDT 0191
STD WR2 EDT 0192
STD WR4 EDT 0193
LXD ZERO14,3 EDT 0194
CAL EIGHTL EDT 0195
WR1 ACL MAINBF,1 EDT 0196
TXI WR2,1,-1 EDT 0197
WR2 TXH WR1,1,* EDT 0198
SLW CHKSUM EDT 0199
WTB 1 EDT 0200
CPY CHKSUM EDT 0201
CPY EIGHTL EDT 0202
WR3 CPY MAINBF,2 EDT 0203
TXI WR4,2,-1 EDT 0204
WR4 TXH WR5,2,* EDT 0205
TRA 1,4 EDT 0206
WR5 TXH WR3,2,MAINBF EDT 0207
HTR 1,4 TRYING TO WRITE TOO LONG A RECORD EDT 0208
REM EDT 0209
MOVE CAL CDBUF MOVES A PROGRAM CARD FROM EDT 0210
COM THE CARD BUFFER INTO THE EDT 0211
STD MV3 CORRECT PART OF THE MAIN BUFFER EDT 0212
LXD ZERO14,1 EDT 0213
CAL CDBUF EDT 0214
ANA ADDMK EDT 0215
SUB NEWBEG EDT 0216
TMI MV5 EDT 0217
COM EDT 0218
MV1 PAX 0,2 EDT 0219
MV2 TXI MV3,1,-1 EDT 0220
MV3 TXL MV6,1,* EDT 0221
CAL CDBUF+1,1 EDT 0222
TXL MV4,2,MAINBF-1 EDT 0223
SLW MAINBF-1,2 EDT 0224
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 61/945 ------
MV4 TXI MV2,2,-1 EDT 0225
MV5 ADD L1 EDT 0226
TRA MV1 EDT 0227
MV6 TRA 1,4 EDT 0228
REM EDT 0229
MAINBF MAIN BUFFER STARTS HERE EDT 0230
END 32 EDT 0231
REM 704 FORTRAN SELF LOADING RECORD 1 TO CS.
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 005/005 ------
FUL
LXA 0,1
CPY 2,1
TXI 1,1,1
CPY 25,1
HTR 3
TZE 0
COM
ACL 2
COM
TRA 23
RTT
IOD
HTR 0
TXI 13,1,-1
CAD 0,1
CAL 15
STA 22
ARS 18
STA 13
CAL 15
CPY 15
CPY 2
RTB 1
LXD 23,1
CPY 3
LTM
BST 145
END
FUL
ORG 0
PTW 0,,2 CONTROL WORD
OCT -203422000526 CHECKSUM
PZE80110,,0342 ORIGIN, ENTRY POINT
PZE80416 LAST LOCATION
ABS
REM FORTRAN II CARD-TO-TAPE
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 006/006 ------
ORG 72
BEGIN RCD 1
LXD ADD01,1
LXD ADD02,2
ADD23 CPY L9ROW COPY 92
TXL ADD03,
TRA 2,4 EOF TR
ADD03 STQ DATA1 STORE 9L
SXD ADD01,1
SXD ADD02,2
LXD ADD04,1
CPY R9ROW COPY 9R
STQ DATA2 STORE 9R
TSX SUB1,2 EXIT ENTRY1 SUB1
ADD01 TXL ADD05 RETURN1
ALS 1 RETURN2
ADD02 TXL ADD06 EXIT TO ENTRY2 SUB1
ADD05 CPY DATA3
STQ DATA1
CPY DATA4 COPY RIGHT
STQ DATA2
TSX SUB1,2
ADD04 TXL ADD07,0,8 RETURN1
ALS 3 RETURN2
TXL ADD08
ADD07 CAL L9ROW
SLW DATA1
CAL R9ROW
SLW DATA2
ADD14 TXL ADD09,1,1
ADD15 CPY L9ROW
TXL ADD10
ADD12 HTR BEGIN EOF
TXL ADD11 EOR
ADD10 CAL L9ROW
ANA DATA1
TNZ ADD12
CAL L9ROW
ORS DATA1
CPY R9ROW
CAL R9ROW
ANA DATA2
TNZ ADD12
CAL R9ROW
ORS DATA2
TNX ADD13,1,1
TSX SUB1,2
TXL ADD14 RETURN1
TXL ADD08 RETURN2
ADD09 CAL DATA3
ORA DATA1
SLW DATA3
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 007/007 ------
CPY DATA5
ANA DATA5
SLW DATA1
CAL DATA4
ORA DATA2
SLW DATA4
CPY DATA6
ANA DATA6
SLW DATA2
ADD13 TSX SUB1,2
TXL ADD15 RETURN1
ALS 4 RETURN2
TXL ADD08
ADD11 CAL DATA1
SLW L9ROW
CAL DATA3
COM
ANA DATA5
ANS DATA1
CAL DATA2
SLW R9ROW
CAL DATA4
COM
ANA DATA6
ANS DATA2
TSX SUB1,2
TXL ADD16 RETURN1
SLW DATA0 RETURN2
ALS 2
ACL DATA0
ALS 1
TXL ADD08
ADD16 CAL DATA3
SWT 6
TRA ADD34
ADD32 TXL ADD31
ADD33 WTD 5
TRA ADD29
ADD34 WTD 2
ADD29 ORA DATA5
ORA L9ROW
COM
SLW DATA1
CAL DATA4
ORA DATA6
ORA R9ROW
COM
SLW DATA2
TSX SUB1,2
TXL ADD17 RETURN1
SLW DATA0 RETURN2
ALS 1
ACL DATA0
ALS 4
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 008/008 ------
TXL ADD08
ADD17 LXD ADD01,1
LXD ADD02,2
TRA 3,4
SUB1 SXD ADD18,1
SLN 1
CAL 1,4
ADD CONS1
LDQ DATA1
ADD22 STA ADD06
STA ADD08
TXH ADD19,1,1
STQ DATA0 INDEX=1
CAL DATA0
TZE ADD20
ADD19 LXA CONS1,1
ADD21 PXD 12 CLEAN ACC
LGL 1 1ST IN ACC
ALS 5 100000
LGL 1 1000001
ALS 5 100000100000
LGL 1 1000001000001
ALS 5
LGL 1
ALS 5
LGL 1
ALS 5
LGL 1
TRA 2,2 1000001000001000001000001000001
ADD08 ACL 0,1 ADDRESS COMPUTED AT ADD22 IN ADDRESS
ADD06 SLW 0,1 ENTRY2 ADDRESS PREV. COMPUTED AT ADD22
TIX ADD21,1,1
LXD ADD18,1
ADD20 SLT 1
TRA 1,2 OFF
LDQ DATA2 SENSE LIGHT ON
CAL 1,4
ADM ADD21
ADD18 TXL ADD22,0,** IR1 STORED IN DECREMENT
CONS1 HTR 6
DATA0 HTR
DATA1 HTR 9L ROW
DATA2 HTR 9R ROW
DATA3 HTR
DATA4 HTR
DATA5 HTR
DATA6 HTR
L9ROW HTR
R9ROW HTR
START REW 2
SLN 0
ADD27 RCD 1
TSX ADD23,4
HTR RECOR
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 009/009 ------
TXL ADD24 RETURN3
SLN 2 RETURN4
LXD ADD25,4
ADD26 CPY BLOCK,4
TIX ADD26,4,1
ADD25 TXL ADD27,0,12
ADD24 SLT 2
TRA ADD28 OFF
SWT 6
TRA ADD30
WEF 5
REW 5
ADD28 RTB 1
CPY RECOR
TRA ADD28
TRA 4 EOF
REW 1
RTB 1
RTB 1
TSX 4,4
RECOR HTR
BLOCK BES 11
ADD31 REW 5
CLS ADD32
STO ADD32
CAL DATA3
TRA ADD33
ADD30 WEF 2
REW 2
TRA ADD28
END
FUL
ORG 0
PTW 0,,2 CONTROL WORD
MTW BEGIN+STOP,,BEGIN CHECKSUM
PZE BEGIN,,BEGIN ORIGIN, ENTRY POINT
PZE STOP LAST LOCATION
ABS
REM EXAMPLE OF DIAGNOSTIC CALLER FOR 704 FORTRAN II
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 85/969 ------
REM
REM RECNBR IS SYNONYMOUS WITH THE NUMBER OF THE RECORD T0 WHICH
REM THE DIAGNOSTIC CALLER PERTAINS. REC*** IS THE FORTRAN RECORD
REM NUMBER ASSIGNED TO THE DIAGNOSTIC CALLER.
REM BEGIN IS SYNONYMOUS WITH THE LOAD ADDRESS OF THE DIAGNOSTIC
REM CALLER. BEG**** HAS THE SAME VALUE AS BEGIN.
REM
RECNBR SYN 115 REC ***
BEGIN SYN84000 REC ****
ORG BEGIN CALL DIAG FROM FILE CD1 1
SXD 0,2 CD1 2
LXD MEM,1 CD1 3
LXD FILTST,2 * FILES TO BE SPACED OVER CD1 4
WDR 4 0 TO 2047 WRITTEN ON DRUM 4 CD1 5
COPY CPY 2048,1 CD1 6
TIX COPY,1,1 NEXT TIME LOOP WILL COPY INTO 25 CD1 7
TXI A,1,2022 UNTIL END OF RECORD SKIP CD1 S
TRA 26 IGNORE RECORD NUMBER CD1 9
A RTB 1 CD1 10
CPY BEGIN SPACE OVER RECORDS IN THIS FILE CD1 11
FILTST TNX A,0,3 CD1 12
TRA B HAVE ALL 3 FILES BEEN SPACED OVER CD1 13
MEM HTR RECNBR,0,2048 CD1 14
B TIX A,2,1 NO, GO BACK TO A CD1 15
CLA MEM CD1 16
STA 2 CD1 17
RTB 1 YES, READ IN MAIN DIAGNOSTIC CD1 18
STOP TRA COPY CD1 19
END CD1 20
FUL
ORG 0
PTW 0,,2 CONTROL WORD
MTW81410,,0210 CHECKSUM
PZE80210,,0210 ORIGIN, ENTRY POINT
PZE81200 LAST LOCATION
ABS
REM AST
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 010/010 ------
REM ************* FORTRAN II SECTION SIX ************************F6R00010
REM FORTRAN 2 RECORD 0003 - CIT TO SAP CONVERSION. F6R00011
REM F6R00012
REM CIT TO SAP CONVERSION F6R00020
ZERO EQU 113 F6R00030
ONE EQU 114 F6R00040
SW1 EQU 127 F6R00050
SW2 EQU 128 F6R00060
ORG 136 F6R00030
START CLA ONE F6R00040
CAS SW2 F6R00050
TRA ADD01 SW2 EQUAL ZERO, ASSUME SWITCH TWO UP, F6R00060
TRA LIB1 SW2 EQUAL ONE, ASSUME SWITCH TWO DOWN, F6R00070
SWT 2 EQUAL TWO. TEST SWITCH TWO F6R00080
TRA ADD01 F6R00090
LIB1 REW 4 SW TWO DOWN. F6R00100
WEF 2 F6R00110
LXD ADD02,2 SET READ ERROR COUNTER. F6R00120
ADD02 TXI ADD03,0,5 F6R00130
ADD05 BST 4 F6R00140
ADD03 RTB 4 READ TAPE 4 F6R00150
LXA DATA1,1 F6R00160
ADD04 CPY REC03,1 CPY INTO REC-1, REC-2,--- F6R00170
TXI ADD04,1,1 F6R00180
TRA ADD01 END OF FILE ON TAPE 4. F6R00190
ARS 255 F6R00200
ARS 0255 F6R00210
RTT F6R00220
TIX ADD05,2,1 IF ERROR. F6R00230
SXD ADD06,1 SAVE COUNT OF NO. OF WORDS READ IN. F6R00240
LXA ADD07,1 SET XR1=0 F6R00250
IN207 SXD ADD08,1 SAVE XR1. F6R00260
CAL RECOR,1 STORE SL IN DATA2 F6R00270
SLW DATA2 STORE OP IN DATA3 F6R00280
CAL REC03,1 F6R00290
SLW DATA3 F6R00300
CAL REC02,1 STORE SA IN DATA4 F6R00310
SLW DATA4 F6R00320
CAL REC01,1 STORE RA IN DATA5 F6R00330
SLW DATA5 F6R00340
LDQ DATA6 F6R00350
STQ E1005 STORE BLANKS IN E1006,1007,1010,1005 F6R00360
STQ E1006 F6R00370
STQ E1007 F6R00380
STQ E1010 F6R00390
CAL DATA2 TEST SYMBOLIC LOCATION. F6R00400
TZE ADD09 IF ZERO, GO TO ADD09. F6R00410
LRS 30 NOT ZERO. SEE IF SL(1) EQUAL ZERO. F6R00420
TZE ADD10 SL(1) EQUAL ZERO, GO TO ADD10. F6R00430
SUB DATA7 SL(1) NOT EQUAL ZERO. SEE IF EQUAL 15. F6R00440
TNZ ADD11 SL(1) NOT EQUAL 15, GO TO ADD11 F6R00450
CAL DATA6 SL(1) EQUAL 15. PUT BLANKS IN AC AND F6R00460
TRA ADD12 GO TO ADD12 F6R00470
ADD11 ADD DATA7 RESOTRE SL(1) IN AC. F6R00480
SUB LIB3 F6R00490
TZE LIB2 IF SL(1)=$, GO TO LIB2 F6R00500
ADD LIB3 F6R00510
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 011/011 ------
SUB LIB5 F6R00520
TZE LIB6 IF SL(1)=(, GO TO LIB6 F6R00530
ADD LIB5 F6R00540
SUB DATA7 F6R00550
TPL ME1 GO TO ME1 IF SL(1) GREATER THEN 15 (I.E.,ALPHA-F6R00560
ADD DATA7 F6R00570
RQL 1 SL(1) LESS THEN 15, NOT ZERO, ASSEMBLE SYMBOL. F6R00580
TSX SUB1,1 AND GO TO SUB1 (TIV TYPE ENTRY). F6R00590
TRA ADD12 F6R00600
ME1 CAL DATA2 F6R00610
TRA ADD12 F6R00620
ADD10 LGL 13 IFN. ASSEMBLE SYMBOL AND GO TO SUB2. F6R00630
TSX SUB2,1 F6R00640
ADD09 LGL 36 SYMBOLIC LOC EQUAL ZERO. PUT BLANKS IN ACC. F6R00650
ADD12 SLW E1003 STORE ACC. IN E1003. F6R00660
IN245 LDQ DATA3 SELECT OP IN MQ. F6R00670
CLS DATA8 F6R00680
LGL 18 F6R00690
STQ E0777 STORE DECREMENT IN E0777. F6R00700
LDQ DATA6 LOAD MQ WITH BLANKS F6R00710
LGL 6 F6R00720
ALS 6 F6R00730
STO E1004 STORE IN E1004. F6R00740
CAS DATA9 IS OP EQUAL OCT. F6R00750
TRA ADD13 OP LESS THEN OCT F6R00760
TRA ADD14 OP EQUAL OCT. GO TO ADD14. F6R00770
CAS DAT10 OP GREATER THEN OCT. SEE IF OP=BCD. F6R00780
TRA ADD13 F6R00790
TRA ADD15 OP EQUAL BCD. GO TO ADD15. F6R00800
ADD13 LDQ DATA4 OP NOT BCD OR OCT. F6R00810
PXD SELECT SA IN MQ. F6R00820
LGL 6 F6R00830
TNZ IN301 SA(1) NOT EQUAL ZERO. GO TO IN301. F6R00840
LGL 12 SA(1) EQUAL ZERO. TEST FOR INTERNAL F6R00850
TNZ IN310 FORMULA NUMBER TYPE. IF YES, GO TO IN310. F6R00860
LDQ DATA6 SA(1),SA(2),SA(3) EQUAL ZERO. LOAD MQ WITH F6R00870
CLA DATA5 TEST FOR NOW-ZERO TAG OR RELATIVE ADDRESS. F6R00880
TNZ IN446 NOT EQUAL ZERO. GO TO IN446 F6R00890
CLA E0777 RA EQUAL ZERO. TEST FOR NON-ZERO DECREMENT. F6R00900
TNZ IN320 NOT ZERO, GO TO IN320 F6R00910
CAL DT713 ZERO, OR A BLANK TO RT-HAND END OF E1004. F6R00920
ORS E1004 F6R00930
TRA IN367 F6R00940
IN301 CAS DATA8 TEST IF SA(1)=16. F6R00950
TRA IN313 GREATER THEN 16(TRUE SYMBOL). GO TO IN313. F6R00960
TSX 4,4 EQUAL IS ERROR. F6R00970
TSX SUB1,1 LESS THEN 16 (TIV ENTRY TYPE). GO TO SUB1. F6R00980
LRS 30 RETURN FROM SUB1. F6R00990
RQL 1 F6R01000
TRA IN313 F6R01010
IN310 TSX SUB2,1 INTERNAL FORMULA NO. TYPE. F6R01020
PXD F6R01030
LGL 6 F6R01040
IN313 ORS E1004 F6R01050
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 012/012 ------
STQ E1000 F6R01060
CAL DT713 F6R01070
ORS E1000 F6R01080
LDQ E1000 F6R01090
IN320 CAL IN313 F6R01100
TSX IN403,1 F6R01110
CLA DATA5 SELECT RELATIVE ADDRESS. F6R01120
ARS 18 F6R01130
TZE IN335 RA EQUAL ZERO, GO TO IN335 F6R01140
LDQ DATA6 RA NOT EQUAL ZERO, LOAD MQ WITH BLANKS AND F6R01150
TSX IN422,1 GO TO IN422 F6R01160
CLA DATA5 SET ACC. EQUAL RA. F6R01170
TPL IN333 IF RA POSITIVE, GO TO IN333. F6R01180
CAL DT714 IF RA NEGATIVE, SELECT OCTAL 40 (MINUS) F6R01190
TRA IN334 AND GO TO IN334. F6R01200
IN333 CAL DATA8 SELECT OCTAL 20 (PLUS) F6R01210
IN334 TSX IN416,1 F6R01220
IN335 CLA DATA5 SET ACC. EQUAL RA. ANA OCTAL 77777 F6R01230
ANA DATA1 F6R01240
TNZ IN344 IF NOT ZERO, GO TO IN344. F6R01250
CLA E0777 ZERO. TEST IF E0777 EQUAL ZERO. F6R01260
TZE IN363 IF ZERO, GO TO IN363. F6R01270
LDQ DT711 NOT ZERO, LOAD MQ WITH 0 IN 1ST CHARAC, REST F6R01280
TRA IN352 AND GO TO IN 352 F6R01290
IN344 LDQ DT710 F6R01300
CAS DT722 F6R01310
TRA IN351 F6R01320
TRA IN351 F6R01330
LDQ DATA6 F6R01340
IN351 TSX IN422,1 F6R01350
IN352 CLA DT712 F6R01360
TSX IN416,1 F6R01370
CLA E0777 F6R01380
TZE IN363 F6R01390
ARS 18 F6R01400
LDQ DATA6 F6R01410
TSX IN422,1 F6R01420
CLA DT712 F6R01430
TSX IN416,1 F6R01440
IN363 PXD 6 F6R01450
LDQ DATA6 F6R01460
LGL 36,2 F6R01470
IN366 ORS * F6R01480
IN367 WTD 2 F6R01490
LXA IN363,1 F6R01500
IN371 CPY E1011,1 F6R01510
TIX IN371,1,1 F6R01520
IOD F6R01530
LXD ADD08,1 F6R01540
TXI ADD06,1,4 F6R01550
ADD06 TXL IN207,1,* F6R01560
LXD ADD02,2 F6R01570
ADD08 TXI ADD03,0,* F6R01580
IN401 TXL IN412,2,30 IF SHIFT LESS THEN OR EQUAL 30, GO TO SELECT F6R01590
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 013/013 ------
CAL IN417 SHIFT GREATER THEN 30. PREPARE TO MODIFY ADDRES F6R01600
IN403 ADD DT723 COMPUTE ADDRESS FOR STORING WORD. F6R01610
STA IN417 F6R01620
STA IN366 F6R01630
STA IN410 F6R01640
PXD CLEAR ACC. F6R01650
IN410 SLW * STORE ZERO IN WORD. F6R01660
PDX 0,2 SET XR2 EQUAL TO ZERO F6R01670
IN412 LGL 6 SELECT CHARACTER F6R01680
CAS DT713 IS CHARACTER BLANK. F6R01690
TRA IN416 NO. F6R01700
TRA 1,1 YES, RETURN TO PROGRAM F6R01710
IN416 ALS 30,2 NO, SHIFT CHARACTER F6R01720
IN417 ORS * F6R01730
PXD F6R01740
TXI IN401,2,6 ADJUST XR2 SHIFT AND GO TO IN401. F6R01750
IN422 STQ E1002 F6R01760
SXD DT772,1 F6R01770
IN424 LRS 35 F6R01780
PDX 0,1 F6R01790
SLW E1001 F6R01800
IN427 DVP DT721 F6R01810
ALS 0,1 F6R01820
ORS E1001 F6R01830
STQ E1000 F6R01840
CLA E1000 F6R01850
TZE IN437 F6R01860
CLM 0 F6R01870
TXI IN427,1,-6 F6R01880
IN437 CAL E1001 F6R01890
LDQ E1002 F6R01900
LGL 1 F6R01910
IN442 LDQ E1002 F6R01920
LRS 6,1 F6R01930
LXD DT772,1 F6R01940
TRA 1,1 F6R01950
IN446 ARS 18 F6R01960
TZE IN320 F6R01970
TSX IN422,1 F6R01980
CLA DATA5 F6R01990
TPL IN455 F6R02000
CAL DT714 F6R02010
TRA IN457 F6R02020
IN455 PXD F6R02030
LGL 6 F6R02040
IN457 ORS E1004 F6R02050
CAL IN313 F6R02060
TSX IN403,1 F6R02070
TRA IN335 F6R02080
ADD15 LDQ DATA4 F6R02090
CAL DATA8 F6R02100
TQP IN470 F6R02110
ADD DATA8 F6R02120
LRS 0 F6R02130
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 014/014 ------
IN470 ORS E1004 F6R02140
ALS 3 F6R02150
LGL 3 F6R02160
ALS 3 F6R02170
LGL 3 F6R02180
ALS 3 F6R02190
LGL 3 F6R02200
ALS 3 F6R02210
LGL 3 F6R02220
ALS 3 F6R02230
LGL 3 F6R02240
ALS 3 F6R02250
LGL 3 F6R02260
SLW E1005 F6R02270
ALS 3 F6R02280
LGL 3 F6R02290
ALS 3 F6R02300
LGL 3 F6R02310
ALS 3 F6R02320
LGL 3 F6R02330
ALS 3 F6R02340
LGL 3 F6R02350
ALS 3 F6R02360
LGL 3 F6R02370
ALS 3 F6R02380
LGL 3 F6R02390
SLW E1006 F6R02400
TRA IN367 F6R02410
ADD14 CLA DATA4 F6R02420
SUB DT717 F6R02430
TNZ IN532 F6R02440
CAL DAT10 F6R02450
SLW E1004 F6R02460
TRA ADD15 F6R02470
IN532 CAL DT723 F6R02480
ORS E1004 F6R02490
CAL DATA4 F6R02500
SLW E1005 F6R02510
CAL DATA6 F6R02520
SLW E1006 F6R02530
TRA IN367 F6R02540
SUB1 SXD DT703,1 SAVE XR1 FOR RETURN F6R02550
PAX 0,4 STORE CHARACTER IN XR4 F6R02560
SUB DATA7 IS CHARACTER *. F6R02570
TNZ IN550 NO, GO TO IN 550. F6R02580
CAL DT716 YES, SELECT *. F6R02590
LDQ DATA6 LOAD MQ WITH BLANKS. F6R02600
TRA IN313 GO TO IN 313. F6R02610
LIB2 TRA RPCH1 F6R02620
TRA ADD12 F6R02630
LIB3 BCD 100000$ F6R02640
LIB4 BCD 1$ F6R02650
LIB5 BCD 100000( F6R02660
LIB6 CAL DATA2 F6R02670
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 015/015 ------
TRA ADD12 F6R02680
IN550 CAL DT770,4 SELECT APPROPRIATE NUMERIC OR ALPHABETIC F6R02690
ALS 6 CHARACTER. F6R02700
ORA DT771 FOLLOWED BY LEFT PARENTHESIS F6R02710
ALS 24 AND SHIFT INTO PROPER POSITION. F6R02720
SLW E1000 F6R02730
LXA IN565,3 F6R02740
RQL 12 F6R02750
PXD 0 F6R02760
LGL 3 TAG BITS INTO ACC. ADDRESS F6R02770
TNZ IN565 TAG BITS EQUAL ZERO. NO, GO TO IN565 F6R02780
IN562 TNX IN575,1,1 YES. IF FINISHED WITH WORD, GO TO IN 575 F6R02790
LGL 5 NOT FINISHED WITH WORD. TEST ADDRESS BITS F6R02800
TZE IN562 ADDRESS BITS ZERO. F6R02810
IN565 PAX 4,4 ADDRESS BITS NOT ZERO. F6R02820
CAL DT770,4 SELECT CHARACTER. F6R02830
TNX IN576,1,1 F6R02840
ALS 22,2 SHIFT INTO PROPER POSITION . F6R02850
ORS E1000 F6R02860
PXD F6R02870
LGL 5 F6R02880
TXI IN565,2,6 ADJUST SHIFT. F6R02890
IN575 CAL DT713 F6R02900
IN576 LDQ DATA6 F6R02910
LGL 22,2 F6R02920
ORA E1000 F6R02930
LXD DT703,1 F6R02940
TRA 1,1 F6R02950
SUB2 STO E1000 F6R02960
LGL 8 F6R02970
PXD 0 F6R02980
LRS 29 F6R02990
DVP DT721 F6R03000
TNZ IN612 F6R03010
CAL DT713 IF SUBSIDIARY NO. IS ZERO, SELECT A BLANK F6R03020
IN612 SLW E1002 F6R03030
LGL 36 F6R03040
SXD DT772,1 F6R03050
PAX 0,1 F6R03060
CAL IN756,1 SELECT ALPHABETIC CHARACTER. F6R03070
ALS 6 F6R03080
ORA E1002 F6R03090
LDQ DATA6 F6R03100
LGL 24 F6R03110
SLW E1002 F6R03120
CLA E1000 F6R03130
TRA IN424 F6R03140
ADD07 HTR 0 F6R03150
ADD01 WEF 2 F6R03160
REW 4 F6R03170
REW 2 F6R03180
RTB 1 F6R03190
TRA 4 F6R03200
DT703 HTR 0 F6R03210
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 016/016 ------
DAT10 OCT 604623636000 F6R03220
DATA9 OCT 602223246000 F6R03230
DATA6 OCT 606060606060 F6R03240
DT707 OCT 336060606060 F6R03250
DT710 OCT 636060606060 F6R03260
DT711 OCT 006060606060 F6R03270
DT712 OCT 73 F6R03280
DT713 OCT 60 F6R03290
DT714 OCT 40 F6R03300
DATA8 OCT 20 F6R03310
DT716 OCT 54 F6R03320
DT717 OCT 777777777777 F6R03330
DATA7 OCT 17 F6R03340
DT721 OCT 12 F6R03350
DT722 OCT 5 F6R03360
DT723 OCT 1 F6R03370
DATA1 OCT 77777 F6R03380
DT725 OCT 71 F6R03390
OCT 70 F6R03400
OCT 67 F6R03410
OCT 66 F6R03420
OCT 65 F6R03430
OCT 64 F6R03440
OCT 63 F6R03450
OCT 62 F6R03460
DT735 OCT 51 F6R03470
OCT 50 F6R03480
OCT 47 F6R03490
OCT 46 F6R03500
OCT 45 F6R03510
OCT 44 F6R03520
OCT 43 F6R03530
OCT 42 F6R03540
OCT 41 F6R03550
OCT 31 F6R03560
OCT 30 F6R03570
OCT 27 F6R03580
OCT 26 F6R03590
OCT 25 F6R03600
OCT 24 F6R03610
OCT 23 F6R03620
OCT 22 F6R03630
IN756 OCT 21 F6R03640
OCT 11 F6R03650
OCT 10 F6R03660
OCT 7 F6R03670
OCT 6 F6R03680
OCT 5 F6R03690
OCT 4 F6R03700
OCT 3 F6R03710
OCT 2 F6R03720
OCT 1 F6R03730
DT770 OCT 0 F6R03740
DT771 OCT 34 F6R03750
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 017/017 ------
DT772 HTR 0 F6R03760
DATA2 HTR 0 F6R03770
DATA3 HTR 0 F6R03780
DATA4 HTR 0 F6R03790
DATA5 HTR 0 F6R03800
E0777 HTR 0 F6R03810
E1000 HTR 0 F6R03820
E1001 HTR 0 F6R03830
E1002 HTR 0 F6R03840
E1003 HTR 0 F6R03850
E1004 HTR 0 F6R03860
E1005 HTR 0 F6R03870
E1006 HTR 0 F6R03880
E1007 HTR 0 F6R03890
E1010 HTR 0 F6R03900
E1011 HTR 0 F6R03910
HTR 0 F6R03920
HTR 0 F6R03930
HTR 0 F6R03940
E1015 HTR 0 F6R03950
REC BES 100 F6R03960
RPCH1 LLS 6 F6R03961
SUB LIB3 F6R03962
TZE LIB2A F6R03963
CAL LIB4 SINGLE DOLLAR SIGN F6R03964
TRA ADD12 F6R03965
LIB2A CAL DOL2 DOUBLE DOLLAR SIGN. F6R03966
TRA ADD12 F6R03967
DOL2 BCD 1$$ F6R03968
REC01 SYN REC-4 F6R03979
REC02 SYN REC-3 F6R03980
REC03 SYN REC-2 F6R03990
RECOR SYN REC-1 F6R04000
END F6R04010
REM EXAMPLE OF DIAGNOSTIC CALLER FOR 704 FORTRAN II
rem ------ scanned 9/6/07 304349-Volume_III.pdf Page 85/969 ------
REM
REM RECNBR IS SYNONYMOUS WITH THE NUMBER OF THE RECORD T0 WHICH
REM THE DIAGNOSTIC CALLER PERTAINS. REC*** IS THE FORTRAN RECORD
REM NUMBER ASSIGNED TO THE DIAGNOSTIC CALLER.
REM BEGIN IS SYNONYMOUS WITH THE LOAD ADDRESS OF THE DIAGNOSTIC
REM CALLER. BEG**** HAS THE SAME VALUE AS BEGIN.
REM
RECNBR SYN *** REC ***
BEGIN SYN **** REC ****
ORG 0 FORCE NEW MASTER RECORD MR 1
HTR BEGIN,0,BEGIN CARD FOR EDITOR, NEEDS MR 2
HTR STOP 9 ROW, COL. 3 PUNCH MR 3
ORG BEGIN CALL DIAG FROM FILE CD1 1
SXD 0,2 CD1 2
LXD MEM,1 CD1 3
LXD FILTST,2 * FILES TO BE SPACED OVER CD1 4
WDR 4 0 TO 2047 WRITTEN ON DRUM 4 CD1 5
COPY CPY 2048,1 CD1 6
TIX COPY,1,1 NEXT TIME LOOP WILL COPY INTO 25 CD1 7
TXI A,1,2022 UNTIL END OF RECORD SKIP CD1 S
TRA 26 IGNORE RECORD NUMBER CD1 9
A RTB 1 CD1 10
CPY BEGIN SPACE OVER RECORDS IN THIS FILE CD1 11
FILTST TNX A,0,3 CD1 12
TRA B HAVE ALL 3 FILES BEEN SPACED OVER CD1 13
MEM HTR RECNBR,0,2048 CD1 14
B TIX A,2,1 NO, GO BACK TO A CD1 15
CLA MEM CD1 16
STA 2 CD1 17
RTB 1 YES, READ IN MAIN DIAGNOSTIC CD1 18
STOP TRA COPY CD1 19
END CD1 20
REM AST
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 018/018 ------
REM ************* FORTRAN II SECTION SIX ************************F6S00010
REM FORTRAN 2 RECORD 005 - ON-LINE PRINT. F6S00011
REM F6S00012
REM MODIFICATIONS TO TPH1 TO PRINT WITH F6S00020
REM SENSE SWITCH CHANGES F6S00030
ORG 136 F6S00040
REW 2 F6S00050
LXD FILES,1 F6S00060
CLA ONE F6S00070
CAS SW2 TEST SENSE SWITCH TWO. F6S00080
TRA LIB1 UP F6S00090
TRA ASKER DOWN F6S00100
SWT 2 F6S00110
LIB1 TNX CARDS,1,1 UP, ANY FILES TO DO. GO RETURN TO LOADER IF NOT F6S00120
ASKER CLA ONE SWITCH 2 DOWN (OR UP BUT FILES TO DO) F6S00130
CAS SW3 TEST SENSE SWITCH THREE. F6S00140
TRA FILES UP, GO TO RETURN TO LOADER F6S00150
TRA LIB2 DOWN F6S00160
SWT 3 F6S00170
FILES TXI CARDS,,3 UP, GO RETURN TO LOADER F6S00180
LIB2 SXD COUNT,1 SWITCH THREE DOWN. F6S00190
WPR TO PRINT FILE OF TAPE TWO. F6S00200
SPR 1 F6S00210
COUNT TXI PRINT F6S00220
PARTS LXD COUNT,1 F6S00230
TIX ASKER,1,1 F6S00240
CARDS RTB 1 RETURN TO LOADER F6S00250
TRA 4 F6S00260
ME8 HTR 5 F6S00270
PRINT RTT F6S00280
NOP F6S00290
ME9 LXD ME8,4 F6S00300
I113 LXD I117,2 SET RECORD LENGTH EQUAL 20 F6S00310
SLN 1 TURN ON SENSE LIGHT 1 F6S00320
RTD 2 SELECT TAPE TWO IN BCD MODE F6S00330
I116 CPY D65,2 AND COPY RECORD. F6S00340
I117 TXL I132,,20 F6S00350
TRA PARTS END OF FILE. F6S00360
I121 TXI I122,2,1 F6S00370
I122 PXD 0,2 F6S00380
RTT TEST TAPE CHECK. F6S00390
TXL I134,0,0 ERROR. F6S00400
I125 ADD I131 PRINT THIS RECORD. F6S00410
STD I130 F6S00420
TSX I143,4 F6S00430
I130 HTR D41+1 F6S00440
I131 TXL ME9,0,D65 F6S00450
I132 TIX I116,2,1 NEXT WORD BUT NO F6S00460
TXL I122,0,0 MORE THEN 20. F6S00470
I134 TIX I136,4,1 TEST FOR ANOTHER TRY. F6S00480
TSX 4,4 F6S00490
I136 BST 2 TRY AGAIN. F6S00500
TXL I113,0,0 F6S00510
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 019/019 ------
I143 CLA 1,4 SUBSTITUTE CODING. F6S00520
STD I302 F6S00530
ARS 18 F6S00540
ADD I302 F6S00550
STA I161 F6S00560
STA I211 F6S00570
SUB 1,4 F6S00580
SXD I302,4 F6S00590
PAX 0,4 F6S00600
SXD I155,4 F6S00610
I155 TXH 0,0,* F6S00620
WPR SELECT PRINTER F6S00630
CLA I301 FIND LAST NON-BLANK GROUP. F6S00640
LXD I224,4 F6S00650
I161 CAS *,4 F6S00660
TXI I165,4,-1 F6S00670
I163 TXI I161,4,1 F6S00680
TXI I165,4,-1 F6S00690
I165 SXD I230,4 STORE END TEST. F6S00700
SXD I242,4 F6S00710
SXD I172,4 F6S00720
SXD I271,4 F6S00730
LXD I155,4 F6S00740
I172 TNX I176,4 F6S00750
TXL I175,4,12 F6S00760
SPR 8 FIRST CYCLE. F6S00770
I175 LXD I155,4 INITIALIZE GROUP COUNT. F6S00780
I176 LXA I203,2 INITIALIZE LEFT SETUP. F6S00790
LXD I245,1 F6S00800
CLA ONE F6S00810
CAS SW4 F6S00820
TRA I201 F6S00830
TRA LIB5 F6S00840
SWT 4 F6S00850
I201 TXL I203,0,* F6S00860
LIB5 NOP F6S00870
I203 PXD F6S00880
I204 SLW D41,1 CLEAR CARD IMAGE. F6S00890
SLW D21,1 F6S00900
TIX I204,1,1 F6S00910
I207 CAL I303 INITIALIZE COLUMN INDICATOR. F6S00920
I210 SLW 0 F6S00930
I211 LDQ *,4 OBTAIN GROUP. F6S00940
SXD I201,4 STORE GROUP COUNT. F6S00950
LXA I215,4 SET CHARACTER COUNT. F6S00960
I214 PXD F6S00970
I215 LGL 6 F6S00980
PAX 0,1 F6S00990
CAL 0 POSITION COLUMN INDICATOR. F6S01000
ARS 6,4 F6S01010
TIX I245,1,16 TEST FOR DIGIT. F6S01020
TXH I250,1,15 TEST FOR Y-Z ONE F6S01030
ORS D36,3 STORE DIGIT. F6S01040
I224 TIX I214,4,1 COUNT CHARACTERS. F6S01050
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 020/020 ------
I225 ARS 1 SHIFT AND TEST COLUMN. F6S01060
LXD I201,4 RESTORE GROUP COUNT. F6S01070
TXI I230,4,-1 COUNT GROUPS. F6S01080
I230 TXL I232,4 TEST FOR LAST NON-BLANK GROUP. F6S01090
TNZ I210 TEST FOR END OF ROW. F6S01100
I232 CAL D23,2 FORM TRUE 8,4 F6S01110
ORS D26,2 AND 3 ROWS AND F6S01120
ORS D33,2 MOVE 8,4 AND 8,3 F6S01130
SLW D24,2 ROWS. F6S01140
CAL D22,2 F6S01150
ORS D26,2 F6S01160
ORS D32,2 F6S01170
SLW D23,2 F6S01180
I242 TXL I265,4 TEST FOR END. F6S01190
TXH I265,2,15 TEST FOR RIGHT HALF. F6S01200
TXI I207,2,16 INITIALIZE RIGHT HALF. F6S01210
I245 TIX I253,1,16 TEST FOR 16/CH/32 F6S01220
TXH I256,1,15 TEST FOR X-ZONE F6S01230
ORS D36,3 STORE DIGIT. F6S01240
I250 ORS D40,2 STORE Y-ZONE. F6S01250
TIX I214,4,1 COUNT CHARACTERS. F6S01260
I252 TXL I225 OBTAIN NEXT GROUP. F6S01270
I253 TIX I261,1,16 TEST FOR 32/CH/48. F6S01280
TXH I224,1,15 TEST FOR BLANK. F6S01290
ORS D36,3 STORE DIGIT. F6S01300
I256 ORS D37,2 STORE X-ZONE. F6S01310
TIX I214,4,1 COUNT CHARACTERS. F6S01320
I260 TXL I225 OBTAIN NEXT GROUP. F6S01330
I261 ORS D36,2 STORE 0-ZONE. F6S01340
ORS D36,3 STORE DIGIT. F6S01350
TIX I214,4,1 COUNT CHARACTERS. F6S01360
TXL I225 F6S01370
I265 LXD I300,1 COPY LOOP. F6S01380
I266 CPY D41,1 CARD IMAGE COPIES. F6S01390
CPY D21,1 F6S01400
TIX I266,1,1 COUNT COPIES. F6S01410
I271 TXH I276,4 TEST FOR SECOND CYCLE. F6S01420
LXD I252,1 NO, RELOAD INDEX REGISTERS F6S01430
LXD I260,2 AND RETURN. F6S01440
LXD I302,4 F6S01450
TRA 2,4 F6S01460
I276 WPR SELECT PRINTER AGAIN. F6S01470
SPR 9 SECOND CYCLE. F6S01480
I300 TXL I176,0,12 CONVERT REST OF LINE F6S01490
I301 BCD 1 F6S01500
I302 HTR 1 F6S01510
I303 MZE F6S01520
BES 40 F6S01530
D21 HTR 0 F6S01540
D22 HTR 0 F6S01550
D23 HTR 0 F6S01560
D24 HTR 0 F6S01570
D25 HTR 0 F6S01580
D26 HTR 0 F6S01590
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 021/021 ------
D27 HTR 0 F6S01600
D30 HTR 0 F6S01610
D31 HTR 0 F6S01620
D32 HTR 0 F6S01630
D33 HTR 0 F6S01640
D34 HTR 0 F6S01650
D35 HTR 0 F6S01660
D36 HTR 0 F6S01670
D37 HTR 0 F6S01680
D40 HTR 0 F6S01690
D41 HTR 0 F6S01700
D65 BES 20 F6S01710
ZERO EQU 113 F6R00030
ONE EQU 114 F6R00040
SW1 EQU 127 F6R00050
SW2 EQU 128 F6R00060
SW3 EQU 129
SW4 EQU 130
END F6S01720
REM ************* FORTRAN II SECTION SIX ************************F6T00010
REM ----------- SCANNED 10/8/06 304349-Volume_I.pdf Page 022/022 --------
REM FORTRAN 2 RECORD 007 - TAPE 3,7 TO 2,6. F6T00011
REM F6T00012
ZERO EQU 113
ONE EQU 114
SW1 EQU 127
SW2 EQU 128
REM DUMP TAPE2 ONTO TAPE6 AND TAPE3 ONTO F6T00020
REM TAPE7 IF BATCH COMPILING F6T00030
ORG 136 F6T00030
REW 2 REWIND TAPES TWO AND THREE. F6T00040
REW 3 F6T00050
LXD ZERO,1 F6T00060
SWT 6 TEST SENSE SWITCH 6 TO SEE IF BATCH COMPILING.F6T00070
TRA FINI UP. DO NOT DUMP TAPES BUT GO TO FINI. F6T00080
A11 RTT F6T00090
NOP F6T00100
A6 LXD SEVEN,4 SET READ ERROR COUNTER. F6T00110
A2 LXD ZERO,2 F6T00120
RTD 2 READ A RECORD OF TAPE TWO. F6T00130
A1 CPY REC-1,2 F6T00140
TXI A1,2,1 F6T00150
TRA EOF EOF F6T00160
ARS 255 F6T00170
ARS 253 F6T00180
RTT F6T00190
TRA ERROR ERROR F6T00200
TXI NEXT2,2,-1 F6T00210
NEXT2 SXD A4,2 SAVE WORD COUNT OF RECORD TO USE WHEN WRITING.F6T00220
LXD ZERO,2 ONTO TAPE6 F6T00230
WTD 6 WRITE RECORD JUST READ ONTO TAPE SIZE F6T00240
A3 CPY REC-1,2 F6T00250
TXI A4,2,1 F6T00260
A4 TXL A3,2,* F6T00270
IOD F6T00280
TRA A11 GO READ NEXT RECORD FROM TAPE TWO. F6T00290
SEVEN 0,0,5 F6T00300
ERROR BST 2 READ ERROR PROCEDURE. F6T00310
TIX A2,4,1 F6T00320
TSX 4,4 F6T00330
ER HTR ER F6T00340
EOF WEF 6 AT END OF FILE ONE TAPE TWO. WRITE END OF FILE.F6T00350
TXI A5,1,1 F6T00360
REM ON TAPE SIX. F6T00370
A5 TXH TEST2,1,1 TWO FILES DONE. YES, GO TEST SWITCH TWO. F6T00380
RTD 2 NO F6T00390
TRA A6 F6T00400
TAPE7 CLA ONE TEST SENSE SWITCH ONE. F6T00410
CAS SW1 F6T00420
TRA EOF3+1 F6T00430
TRA A7 F6T00440
SWT 1 F6T00450
TRA EOF3+1 F6T00460
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 023/023 ------
A7 LXD SEVEN,4 DOWN. SET READ ERROR COUNTER. F6T00470
A12 LXD ZERO,2 ONTO TAPE7 F6T00480
RTB 3 READ A RECORD FROM TAPE THREE F6T00490
A8 CPY REC-1,2 F6T00500
TXI A8,2,1 F6T00510
TRA EOF3 EOF OF FILE. F6T00520
ARS 255 F6T00530
ARS 255 F6T00540
RTT F6T00550
TRA ERR3 ERROR. F6T00560
TXI NEXT1,2,-1 F6T00570
NEXT1 SXD A10,2 SAVE WORD COUNT OF RECORD. F6T00580
LXD ZERO,2 F6T00590
WTB 7 WRITE THE RECORD ONTO TAPE SEVEN. F6T00600
A9 CPY REC-1,2 F6T00610
TXI A10,2,1 F6T00620
A10 TXL A9,2,* TEST END OF RECORD. F6T00630
IOD F6T00640
RTT F6T00650
NOP F6T00660
TRA A7 GO READ NEXT RECORD. F6T00670
ERR3 BST 3 F6T00680
TIX A12,4,1 READ ERROR PROCEDURE. F6T00690
TSX 4,4 F6T00700
ERR4 HTR ERR4 F6T00710
EOF3 WEF 7 AT EOF ON 3, WRITE EOF ON 7. F6T00720
RTB 1 F6T00730
RTB 1 F6T00740
RTB 1 F6T00750
FINI REW 2 REWINDS TAPES 2,3, AND 4 AND F6T00760
REW 3 RETURNS TO LOADER, F6T00770
REW 4 F6T00780
RTB 1 F6T00790
TRA 4 F6T00800
TEST2 CLA ONE AFTER 2ND FILE FROM 2 TO 6, F6T00810
CAS SW2 TEST SENSE SWITCH 2. F6T00820
TRA TAPE7 F6T00830
TRA WT3 F6T00840
SWT 2 F6T00850
TRA TAPE7 UP. GO TEST SWITCH 1. F6T00860
WT3 LXD A5,1 DOWN. RESET INDEX REGISTER 1 TO 1. F6T00870
CLA WT3-1 CHANGE A5 TRANSFER ADDRESS TO TAPE7. F6T00880
STA A5 F6T00890
TRA A6 F6T00900
BSS 40 F6T00910
REC BES 500 F6T00920
END F6T00930
REM SUCCESSFUL COMPILATION RECORD F1SC0010
REM ----------- SCANNED 10/8/06 304349-Volume_I.pdf Page 024/024 --------
REM CONTROL IS RETURNED TO THIS RECORD AT THE COMPLETION OF A F1SC0020
REM SINGLE PROBLEM COMPILATION, OR AT THE END OF BATCH F1SC0030
REM COMPILATION. TAPE 1 IS REWOUND AND A LOAD BUTTON F1SC0040
REM SEQUENCE IS EXECUTED AT THE CARD READER. F1SC0050
REM AN INSTALLATION MAY CHANGE THIS RECORD TO SUIT ITS OWN F1SC0060
REM OPERATING NEEDS. F1SC0070
REM F1SC0080
REM MASTER RECORD CARD = F0090000. F1SC0090
ORG 24 F1SC0100
START LTM F1SC0110
REW 1 F1SC0120
RCD 209 CARD READER LOAD BUTTON SEQUENCE. F1SC0130
CPY 0 F1SC0140
TRA SECCPY F1SC0150
HTR 32767 CARD READER EMPTY, HALT. F1SC0160
SECCPY CPY 1 F1SC0170
TRA 0 F1SC0180
END 24 F1SC0190
REM SOURCE PROGRAM ERROR RECORD. THIS RECORD TESTS SL3 AND SL6 F1SPE010
REM ----------- SCANNED 10/8/06 304349-Volume_I.pdf Page 025/025 --------
REM TO DETERMINE IF A CARD READER LOAD BUTTON SEQUENCE IS TO BE F1SPE020
REM EXECUTED, OR IF THE NEXT PROGRAM IS TO BE COMPILED. SL3-ON F1SPE030
REM IF TAPE 5 CANNOT BE READ OR EOF ON TAPE 5 BEFORE END CARD F1SPE040
REM IS FOUND. SS6-ON IF IN BATCH COMPILE MODE. F1SPE050
REM F1SPE060
REM MASTER RECORD CARD = F0100000. F1SPE070
ORG 24 F1SPE080
LTM F1SPE090
SLT 1 SL1-ON IF PROGRAM TO BE RE-TRIED. F1SPE100
TRA SS6TST F1SPE110
TRA SKIPCM SKIP TO COMMON RECORD F1SPE120
SS6TST SWT 6 SS6-ON IF IN BATCH MODE. F1SPE130
TRA READCD SINGLE COMPILATION. READ CARD READER SEQ. F1SPE140
SLT 3 ON IF END CARD ERROR FOUND BY BATCH MONITOR F1SPE150
TRA SKIPBM SKIP TO BATCH MONITOR RECORD F1SPE160
REW 6 F1SPE170
READCD REW 4 F1SPE180
REW 3 F1SPE190
REW 2 F1SPE200
REW 1 F1SPE210
RCD 209 CARD READER LOAD BUTTON SEQUENCE. F1SPE220
CPY 0 F1SPE230
TRA SECCPY F1SPE240
HTR 32767 CARD READ EMPTY. F1SPE250
SECCPY CPY 1 F1SPE260
TRA 0 F1SPE270
SKIPCM RTB 1 SKIP OVER FILE 1 MARK TO BATCH MONITOR. F1SPE280
RTB 1 SKIP OVER BATCH MONITOR RECORD F1SPE290
SKIPBM RTB 1 AND/OR SKIP MACHINE ERROR RECORD F1SPE300
TRA 4 TO 1-CS TO READ NEXT RECORD F1SPE310
END 24 F1SPE320
REM MONITOR PROGRAM FOR BATCH COMPILATION F1BM0010
REM ----------- SCANNED 10/8/06 304349-Volume_I.pdf Page 026/026 --------
REM MASTER RECORD CARD F0120000 F1BM0020
ORG 24 F1BM0030
START SWT 6 TEST SW6, UP = SINGLE PROBLEM, F1BM0040
TRA ADD93+1 SKIP OVER MACHINE ERROR RECORD AND GO TO SEC1F1BM0050
SLN 0 TURN OFF LIGHTS F1BM0060
ADD01 LXA L(5),4 COUNTER FOR 5 TRIES TO READ TAPE 5. F1BM0070
CAL BLANKS F1BM0080
SLW BUFFER-1 F1BM0090
SLW BUFFER-2 F1BM0100
RTT TURN OFF INDICATOR F1BM0110
NOP F1BM0120
ADD015 RTD 5 F1BM0130
LXA L(14),3 ASSUME 14 WORDS PER RECORD F1BM0140
ADD02 CPY BUFFER,1 F1BM0150
TRA ADD03 F1BM0160
TRA ADD90 EOF F1BM0170
TRA ADD04 EOR F1BM0180
ADD03 TIX ADD02,1,1 F1BM0190
ADD04 ARS 255 F1BM0200
ARS 255 F1BM0210
RTT TEST TAPE INDICATOR F1BM0220
TRA ADD80 ON, PREPARE TO READ AGAIN F1BM0230
WTD 2 OFF, WRITE THIS RECORD ON TAPE 2 F1BM0240
ADD05 CPY BUFFER,2 F1BM0250
TIX ADD05,2,1 F1BM0260
IOD F1BM0270
RTT F1BM0280
NOP F1BM0290
ADD70 TXH ADD71,0 ROUTINE TO RESTORE PRINTER CARRIAGE AND PRINTF1BM0300
TSX PRINT,C FIRST STATEMENT OF CURRENT SOURCE PROGRAM F1BM0310
PZE RESTR,0,BUFFER F1BM0320
WPR F1BM0330
WPR F1BM0330
WPR F1BM0330
WPR F1BM0330
WPR F1BM0330
CLS ADD70 CHANGE TXH TO TXL F1BM0350
STO ADD70 F1BM0360
ADD71 SLN 1 SL1-ON IF AT LEAST 1 SOURCE STATMENT ON TP 2 F1BM0370
PXD 0,0 EXITS F1BM0380
LDQ BUFFER-14 TEST FOR COMMENT CARD F1BM0390
LGL 6 F1BM0400
SUB L(C) F1BM0410
TZE ADD01 YES, GO READ NEXT TAPE RECORD F1BM0420
LGL 24 DISCARD FORMULA NUMBER F1BM0430
PXD 0,0 F1BM0440
LGL 6 F1BM0450
TZE ADD06 TEST FOR CONTINUATION CARD F1BM0460
SUB BLANK F1BM0470
TNZ ADD01 YES, GO READ NEXT TAPE RECORD F1BM0480
ADD06 LXA L(12),1 THIS RECORD IS OF FIRST CARD OF F1BM0490
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 027/027 ------
LXA L(7),2 FORTRAN STATEMENT. PREPARE TO TEST F1BM0500
CLA BUFFER FOR END(..,..,..,..,..) CARD F1BM0510
STO BUFFER-2 POSITION ENDMARK F1BM0520
LDQ BUFFER-13 F1BM0530
TSX SUB1,4 F1BM0540
SUB L(E) TEST FIRST CHAR FOR E F1BM0550
TNZ ADD01 F1BM0560
TSX SUB1,4 F1BM0570
SUB L(N) TEST SECOND CHAR FOR N F1BM0580
TNZ ADD01 F1BM0590
TSX SUB1,4 F1BM0600
SUB L(D) TEST THIRD CHAR FOR D F1BM0610
TNZ ADD01 F1BM0620
TSX SUB1,4 F1BM0630
SUB L(() TEST FOURTH CHAR FOR ( F1BM0640
TNZ ADD01 F1BM0650
TSX SUB1,4 F1BM0660
TSX SUB1,4 F1BM0670
SUB COMMA TEST SIXTH CHAR FOR , F1BM0680
TNZ ADD01 F1BM0690
TSX SUB1,4 F1BM0700
TSX SUB1,4 F1BM0710
SUB COMMA TEST EIGHTH CHAR FOR , F1BM0720
TNZ ADD01 F1BM0730
TSX SUB1,4 F1BM0740
TSX SUB1,4 F1BM0750
SUB COMMA TEST TENTH CHAR FOR , F1BM0760
TNZ ADD01 F1BM0770
ADD93 WEF 2 THIS IS END CARD, TERMINATE FILE F1BM0780
RTB 1 SKIP OVER MACHINE ERROR RECORD. F1BM0790
TRA 4 GO TO 1-CS FOR SECTION ONE F1BM0800
ADD80 BST 5 TAPE ERROR F1BM0810
TIX ADD015,4,1 F1BM0820
TSX PRINT,4 F1BM0830
TP5ERR,0,TP5END F1BM0840
SPROER SLN 3 SL3-ON IF TAPE CANNOT BE READ OR END CARD F1BM0850
BSTRTN BST 1 TROUBLE. F1BM0860
BST 1 BACKSPACE SYSTEM TAPE TO SOURCE PROGRAM ERRORF1BM0870
BST 1 RECORD. F1BM0880
TRA 4 CALL IN 1 - CS. F1BM0890
ADD90 SLT 1 IS THERE A PROBLEM TO BE COMPILED F1BM0900
TRA ADD91 FINISHED, REWIND ALL TYPES F1BM0910
TSX PRINT,4 F1BM0920
ENDCD,0,CDTEND F1BM0930
REW 5 F1BM0940
TRA SPROER F1BM0950
ADD91 BST 1 F1BM0970
REW 6 F1BM0974
REW 5 F1BM0976
TSX PRINT,C F1BM0980
REMA,0,ENDA F1BM0990
TSX PRINT,C F1BM1000
HTR RESTR,0,RESTR+1 F1BM1010
TQO *+1 F1BM1020
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 028/028 ------
TRA BSTRTN F1BM1030
SUB1 PXD 0,0 SUBROUTINE TO BRING NEXT NON BLANK F1BM1040
TIX ADD50,2,1 CHAR OF BUFFER REGION TO AC. F1BM1050
LXA L(6),2 F1BM1060
LDQ BUFFER,1 F1BM1070
TXI ADD50,1,-1 F1BM1080
ADD50 LGL 6 F1BM1090
CAS BLANK F1BM1100
TRA ADD51 F1BM1110
TRA SUB1 F1BM1120
ADD51 CAS ENDMK F1BM1130
TRA 1,4 F1BM1140
TRA ADD01 F1BM1150
TRA 1,4 F1BM1160
RESTR BCD 11 F1BM1165
BUFFER BES 14 F1BM1170
OCT 777777777777 F1BM1180
ENDMK OCT 77 F1BM1190
L(3) 3 F1BM1200
L(5) 5 F1BM1210
L(6) 6 F1BM1220
L(7) 7 F1BM1230
L(12) 12 F1BM1240
L(14) 14 F1BM1250
L(C) BCD 100000C F1BM1260
BLANKS BCD 1 F1BM1270
BLANK BCD 100000 F1BM1280
L(E) BCD 100000E F1BM1290
L(N) BCD 100000N F1BM1300
L(D) BCD 100000D F1BM1310
L(() BCD 100000( F1BM1320
COMMA BCD 100000, F1BM1330
TP5ERR BCD 90 TAPE 5 CONTAINING SOURCE SUBPROGRAM READ 5 TIMES F1BM1340
BCD 9 UNSUCCESSFULLY. TAPE 5 NOW POSITIONED AT RECORD WHICH F1BM1350
BCD 3 CANNOT BE READ. F1BM1360
TP5END BSS 0 F1BM1370
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 029/029 ------
ENDCD BCD 90 END CARD MISSING OR MISPUNCHED FOR LAST SUBPROGR F1BM1380
BCD 3AM BEING COMPILED. F1BM1390
CDTEND BSS 0 F1BM1400
REMA BCD 71 F1BM1410
BCD 6 THE LAST PROBLEM HAS BEEN PROCESSED. F1BM1420
ENDA BSS 0 F1BM1430
REM F1BM1450
REM PRINT CONTROL SUBROUTINE. F1BM1460
A EQU 1 F1BM1470
B EQU 2 F1BM1480
C EQU 4 F1BM1490
PRINT BSS 0 F1BM1500
RAN CLA 1,4 F1BM1510
STA RNA F1BM1520
ARS 18 F1BM1530
STO RNB F1BM1540
SXD RNC,4 F1BM1550
RN40 CLA RNA F1BM1560
ADD RND F1BM1570
CAS RNB F1BM1580
NOP F1BM1590
TRA RN50 F1BM1600
ALS 18 F1BM1610
ADD RNA F1BM1620
STO RAN10 F1BM1630
TSX WOT,C F1BM1640
RAN10 HTR F1BM1650
CLA RAN10 F1BM1660
ARS 18 F1BM1670
SUB RNE F1BM1680
STA RN20 F1BM1690
SUB RNE F1BM1700
STA RN30 F1BM1710
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 030/030 ------
STA RNA F1BM1720
CLA BLNKS F1BM1730
RN20 STO F1BM1740
RN30 STO F1BM1750
TRA RN40 F1BM1760
RN50 CLA RNB F1BM1770
ALS 18 F1BM1780
ADD RNA F1BM1790
STO RN60 F1BM1800
TSX WOT,C F1BM1810
RN60 HTR F1BM1820
LXD RNC,C F1BM1830
TRA 2,C F1BM1840
RNA HTR F1BM1850
RNB HTR F1BM1860
RNC HTR F1BM1870
RND HTR 20 F1BM1880
RNE HTR 1 F1BM1890
REM F1BM1900
REM PRINT SUBROUTINE. F1BM1910
WOT SXD X1,1 F1BM1920
SXD X2,2 F1BM1930
CLA 1,4 PRINT ROUTINE F1BM1940
STA T5 X F1BM1950
STD X4 X F1BM1960
ARS 18 X F1BM1970
ADD X4 X F1BM1980
STA PR2 X F1BM1990
STA CI9 X F1BM2000
SUB 1,4 B-A+1 IN AC F1BM2010
TZE 2,4 F1BM2020
TMI 2,4 F1BM2030
SXD X4,4 F1BM2040
L11 PAX 11,4 F1BM2050
SXD PR6,4 F1BM2060
CAL WP INITIALIZE SWITCH F1BM2070
STO WP X F1BM2080
PR6 TXH T4 F1BM2090
T4 WPR F1BM2100
Z2 TXL S3 F1BM2110
OZ2 TXL F1BM2120
SP4 SPR 4 F1BM2130
TXL RPR+2 F1BM2140
S3 CLS WP SET SWITCH FOR MASKING F1BM2150
STO WP CHARACTER FROM TYPE WHEEL 1 F1BM2160
T5 CAL * OBTAIN FIRST CHARACTER F1BM2170
ARS 30 X F1BM2180
TZE SP4 DOUBLE SPACE IF ZERO F1BM2190
CAS YZONE TEST FOR SPACE SUPPRESS F1BM2200
TXL BK NO F1BM2210
TXL RPR+1 SUPPRESS SPACE F1BM2220
BK CAS BNK TEST FOR BLANK F1BM2230
TXL DIGF NO F1BM2240
TXL RPR+2 BLANK F1BM2250
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 031/031 ------
DIGF SPR 10 SET CHANNEL SKIP F1BM2260
ANA MK MASK OUT ZONE F1BM2270
MK PAX 15,1 OBTAIN SPR COMBINATION F1BM2280
TXI N2,1,1 X F1BM2290
N2 TNX N3,1,8 X F1BM2300
SPR 8 X F1BM2310
N3 TNX N4,1,4 X F1BM2320
SPR 4 X F1BM2330
N4 TNX N5,1,2 X F1BM2340
SPR 2 X F1BM2350
N5 TNX RPR,1,1 X F1BM2360
SPR 1 X F1BM2370
RPR WPR F1BM2380
SPR 5 SUPPRESS SPACE F1BM2390
CLA BLNKS FIND LAST NON-BLANK GROUP F1BM2400
LXD CI4,4 X F1BM2410
PR2 CAS 0,4 X F1BM2420
TXI PR1,4,-1 X F1BM2430
TXI PR2,4,1 X F1BM2440
TXI PR1,4,-1 X F1BM2450
PR1 SXD CI6,4 STORE END TEST F1BM2460
SXD CI8,4 X F1BM2470
SXD PR8,4 X F1BM2480
SXD WP4,4 X F1BM2490
LXD PR6,4 X F1BM2500
PR8 TNX PR5,4 F1BM2510
TXL PR3,4,12 F1BM2520
SPR 8 FIRST CYCLE F1BM2530
PR3 LXD PR6,4 INITIALIZE GROUP COUNT F1BM2540
PR5 LXA PR7,2 INITIALIZE LEFT SETUP F1BM2550
LXD YZ1,1 CLEAR CARD IMAGE F1BM2560
PR7 PXD X F1BM2570
PR4 SLW LT,1 X F1BM2580
SLW RT,1 X F1BM2590
TIX PR4,1,1 X F1BM2600
CIR CAL COL1 INITIALIZE COLUMN INDICATOR F1BM2610
CI2 SLW COL X F1BM2620
CI9 LDQ 0,4 OBTAIN GROUP F1BM2630
SXD OZ2,4 STORE GROUP COUNT F1BM2640
LXA Q6,4 SET CHARACTER COUNT F1BM2650
CI1 PXD F1BM2660
Q6 LGL 6 F1BM2670
PAX 0,1 F1BM2680
CAL COL POSITION COLUMN INDICATOR F1BM2690
ARS 6,4 X F1BM2700
TIX YZ1,1,16 TEST FOR DIGIT F1BM2710
TXH YZ2,1,15 TEST FOR Y-ZONE F1BM2720
CI5 ORS D,3 STORE DIGIT F1BM2730
CI4 TIX CI1,4,1 COUNT CHARACTERS F1BM2740
CI3 ARS 1 SHIFT AND TEST COLUMN F1BM2750
LXD OZ2,4 RESTORE GROUP COUNT F1BM2760
TXI CI6,4,-1 COUNT GROUPS F1BM2770
CI6 TXL CI7,4 TEST FOR LAST NON-BLANK GROUP F1BM2780
TNZ CI2 TEST FOR END OF ROW F1BM2790
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 032/032 ------
CI7 CAL 8.3,2 FORM TRUE 8.4 F1BM2800
ORS D-8,2 AND 3 ROWS AND F1BM2810
ORS D-3,2 MOVE 8.4 AND 8.3 F1BM2820
SLW 8.2,2 ROWS F1BM2830
CAL 8.4,2 FORM TRUE 8.4 F1BM2840
ORS D-8,2 X F1BM2850
ORS D-4,2 X F1BM2860
SLW 8.3,2 X F1BM2870
CI8 TXL WP,4 TEST FOR END F1BM2880
TXH WP,2,15 TEST FOR RIGHT HALF F1BM2890
TXI CIR,2,16 INITIALIZE RIGHT HALF F1BM2900
YZ1 TIX XZ1,1,16 TEST FOR 16/CH/32 F1BM2910
TXH XZ2,1,15 TEST FOR X-ZONE F1BM2920
ORS D,3 STORE DIGIT F1BM2930
YZ2 ORS Y,2 STORE Y-ZONE F1BM2940
TIX CI1,4,1 COUNT CHARACTERS F1BM2950
X1 TXL CI3 OBTAIN NEXT GROUP F1BM2960
XZ1 TIX OZ1,1,16 TEST FOR 32/CH/48 F1BM2970
TXH CI4,1,15 TEST FOR BLANK F1BM2980
ORS D,3 STORE DIGIT F1BM2990
XZ2 ORS X,2 STORE X-ZONE F1BM3000
TIX CI1,4,1 COUNT CHARACTERS F1BM3010
X2 TXL CI3 OBTAIN NEXT GROUP F1BM3020
OZ1 ORS Z,2 STORE 0-ZONE F1BM3030
ORS D,3 STORE DIGIT F1BM3040
TIX CI1,4,1 COUNT CHARACTERS F1BM3050
TXL CI3 F1BM3060
WP TXH WP9 INVERTED TO TXL IF PROGRAM CARRIAGE CONTROL F1BM3070
TXL WP7 NO PROGRAM F1BM3080
WP9 LXD WP2,1 MASK OUT FIRST COL. OF CARD IMAGE F1BM3090
CAL MK2 X F1BM3100
ANS ANS LT,1 X F1BM3110
TIX ANS,1,1 X F1BM3120
WP7 LXD Z2,1 COPY LOOP F1BM3130
CRAN CPY LT-12,1 F1BM3140
CPY RT-12,1 X F1BM3150
TXI T2,1,-1 F1BM3160
T2 TXH CRAN,1,-12 F1BM3170
CAL WP RESET SWITCH FOR SECOND CYCLE F1BM3180
STO WP X F1BM3190
WP4 TXH WP5,4 F1BM3200
LXD X1,1 NO, RELOAD INDEX REGISTERS AND RETURN F1BM3210
LXD X2,2 X F1BM3220
WT2 LXD X4,4 X F1BM3230
L2 TRA 2,4 X F1BM3240
RPR2 WPR F1BM3250
TXL PR2-2 F1BM3260
WP5 WPR F1BM3270
SPR 9 SECOND CYCLE F1BM3280
WP2 TXL PR5,0,12 CONVERT REST OF LINE F1BM3290
BLNKS BCD 1 F1BM3300
X4 HTR F1BM3310
YZONE OCT 20 F1BM3320
BNK OCT 60 F1BM3330
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 033/033 ------
MK2 OCT 377777777777 F1BM3340
COL1 MZE F1BM3350
COL BSS 1 F1BM3360
RT BES 16 F1BM3370
8.5 BSS 1 F1BM3380
8.4 BSS 1 F1BM3390
8.3 BSS 1 F1BM3400
8.2 BSS 1 F1BM3410
D BES 9 F1BM3420
Z BSS 1 F1BM3430
X BSS 1 F1BM3440
Y BSS 1 F1BM3450
LT SYN Y+1 F1BM3460
8.4L SYN LT-14 F1BM3470
8.4R SYN RT-14 F1BM3480
BSS 27 F1BM3490
END 24 F1BM3500
REM MACHINE ERROR RECORD. THIS RECORD HALTS TO PERMIT OPERATOR F1ME0010
REM ----------- SCANNED 10/8/06 304349-Volume_I.pdf Page 034/034 --------
REM INTERVENTION. IF THE SAME SOURCE PROGRAM IS TO BE RE-TRIED, F1ME0020
REM OPERATOR SHOULD PRESS START. IF NEXT SOURCE PROGRAM IS TO BEF1ME0030
REM COMPILED, THE OPERATOR MUST MANUALLY TURN SL1-ON, AND PRESS F1ME0040
REM START. F1ME0050
REM F1ME0060
REM MASTER RECORD CARD = F0130000. F1ME0070
ORG 24 F1ME0080
HTR NEXTIN F1ME0090
NEXTIN SLT 1 F1ME0100
TRA 4 GO TO 1 - CS TO REPEAT PROBLEM. F1ME0110
BST 1 BACKSPACE OVER MACHINE ERROR RECORD. F1ME0120
BST 1 BACKSPACE OVER BATCH MONITOR F1ME0130
TRA 4 TO 1-CS TO READ NEXT RECORD. F1ME0160
END 24 F1ME0170
REM PST
REM ----------- SCANNED 10/8/06 304349-Volume_I.pdf Page 035/035 --------
REM APPLIED PROGRAMMING, IBM , L. MAY AND A. S. NOBLE JR.
REM 704 FORTRAN II / SECTONR ONE. 29 OCT 58
REM
REM SECTION 1= READS IN AND CLASSIFIES STATEMENTS. FOR ARITHMETIC4F10000
REM FORMULAS, COMPILES THE OBJECT (OUTPUT) INSTRUCTIONS. FOR 4F10001
REM NONARITHMETIC STATEMENTS INCLUDING INPUT-OUTPUT, DOES A 4F10002
REM PARTIAL COMPILATION, AND RECORDS THE REMAINING INFORMATION 4F10003
REM IN TABLES. 4F10004
REM THE FIVE MAJOR DIVISIONS OF SECTION 1 ARE= 4F10005
REM COMMON, STATES A, B, C, AND D. COMMON REMAINS IN LOWER MEMORY4F10006
REM THROUGHTOUT SECTION1. STATE A READS IN AND CLASSIFIES ALL 4F10007
REM STATEMENTS, AND TREATS NONARITHMETIC STATEMENTS. STATES B, 4F10008
REM C, AND D TREAT ARITHMETIC FORMULAS. 4F10009
REM 4F10010
REM SECTION 1 / COMMON = 4F10011
REM 704 FORTRAN MASTER RECORD CARD / COMMON = F0140000. 4F10012
ORG 0 4F100121
PZE ORGCOM,,1TOCS 4F100122
PZE ORGA-1 4F100123
REM 4F10013
REM PART 1 / WORKING STORAGE, BUFFERS, AND TABLE PARAMETERS= 4F10014
REM EIFNO AND SENSE SWITCH SIMULATORS. 4F10015
REM TAPE TABLE BUFFERS. 4F10016
REM TAPE TABLE PARAMETERS - INTET. 4F10017
REM DRUM TABLE PARAMETERS. 4F10018
REM FORSUB COUNT AND BUFFER. 4F10019
REM CIB BUFFER AND PARAMETERS. 4F10020
REM REMAINING WORKING STORAGE. 4F10021
REM PART 2 / CONSTANTS USED BY SECTION ONE. 4F10022
REM PART 3 / SUBROUTINES USED BY SECTION ONE= 4F10023
REM NAME FUNCTION 4F10024
REM C0150,2 SCAN, AND CONVERT NUMERICS. 4F10025
REM C0160,2 SCAN CHARACTERS. 4F10026
REM C0180,2 CONVERT NUMERICS. 4F10027
REM C0190X,4 INITIALIZE C0190 TO 1ST WORD OF F. 4F10028
REM C0390,4 INSERT CHARACTER. 4F10029
REM C0190,4 OBTAIN NEXT NON-BLANK CHAR IN AC. 4F10030
REM C1T00,4 COMPILED INSTRUCTION TABLE ENTRIES.4F10031
REM DIM.SR,4 DIMENSION TABLE SEARCH. 4F10032
REM DRTABS(,4) DRUM TABLE ENTRIES. 4F10033
REM GETIFN,4 GET INTERNAL FORMULA NUMBER. 4F10034
REM JIF(GIF),4 JUMPS (GETS) IFN IN SL AND TL. 4F10035
REM MTR000 MONITOR STATES FROM DRUM. 4F10036
REM RA000,4 COMPUTER RELATIVE ADDRESS. 4F10037
REM RDRX,4 READ DRUM INTO BUFR. 4F10038
REM SR6DC1,1 CONVERT 6 BCD DIGITS TO 1 BINARY. 4F10039
REM SS000,4 SCAN AND PROCESS SUBSCRIPTS. 4F10040
REM SUBX00,4 ADD BLANKS TO SUBROUTINE NAMES. 4F10041
REM TESTFX,1 TEST FOR FIXED OR FLOATING POINT. 4F10042
REM TEST..,4 TEST CHARACTER IN AC. 4F10043
REM TET00,1 TAPE TABLE ENTRIES. 4F10044
REM 4F10045
REM DIAG DIAGNOSTIC CALLERS. 4F10046
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 036/036 ------
REM 4F10047
REM THE FOLLOWING CONVENTIONS ARE USED IN THIS LISTING= 4F10048
REM 4F10049
REM ** IN THE ADDRES, TAG, OR DECREMENT OF AN INSTRUCTION 4F10050
REM INDICATES THAT THIS FIELD WILL BE MODIFIED BY THE PROGRAM. 4F10051
REM * IN COL/36 INDICATES THE INSTRUCTION IS A TRANSFER OUT OF 4F10052
REM THIS LOGICAL BLOCK OR SUBROUTINE. 4F10053
REM C IN COL/34 INDICATES THE INSTRUCTION WAS CORRECTED. 4F10054
REM P IN COL/32 INDICATES THE INSTRUCTION WAS INSERTED (PATCH). 4F10055
REM 4F10056
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10057
REM 4F10058
REM COMMON/1-WORKING STORAGE, BUFFERS, AND TABLE PARAMETERS= 4F10059
ORGCOM ORG 24 4F10060
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10061
REM 4F10062
REM EIFNO AND SENSE SWITCH SIMULATORS. 4F10063
EIFNO PZE **,,** EXTERNAL,,INTERAL FORMULA NUMBER. 4F10064
ENDI1 PZE 2 SIMULATOR FOR SENSE SWITCH 1. 4F10065
ENDI2 PZE 2 SIMULATOR FOR SENSE SWITCH 2. 4F10066
ENDI3 PZE 2 SIMULATOR FOR SENSE SWITCH 3. 4F10067
ENDI4 PZE 2 SIMULATOR FOR SENSE SWITCH 4. 4F10068
ENDI5 PZE 2 SIMULATOR FOR SENSE SWITCH 5. 4F10069
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10070
REM 4F10071
REM BUFFERS USED BY TET00 FOR THE TAPE TABLES. 4F10072
TEIFNO BSS 10 EXTERNAL,,INTERNAL FORMULA NUMBERS.4F10073
TDO BSS 10 DO STATEMENTS. 4F10074
TIFGO BSS 10 IF AND GO TO STATEMENTS. 4F10075
TRAD BSS 10 IF AND GO TO TRANSFER ADDRESSES. 4F10076
FORTAG BSS 10 INDEXES TO TAU AND SIGMA TABLES. 4F10077
FORVAR BSS 10 RIGHT - NON-SUB. FX. PT. VARIABLES.4F10078
FORVAL BSS 10 LEFT - NON-SUB. FX. PT. VARIABLES.4F10079
FRET BSS 10 FREQUENCY STATEMENTS. 4F10080
EQUIT BSS 10 EQUIVALENCE STATEMENTS. 4F10081
CLOSUB BSS 10 NAMES OF SUBROUTINES. 4F10082
FORMAT BSS 10 FORMAT STATEMENTS. 4F10083
SUBDEF BSS 10 SUBROUTINE DEFINITION STATEMENTS. 4F10084
COMMON BSS 10 UPPER MEMORY STORAGE STATEMENTS. 4F10085
HOLARG BSS 10 HOLLERITH ARGUMENTS FOR SUBROUTINE.4F10086
NONEXC BSS 10 NON-EXECUTED STATEMENTS. 4F10087
TSTOPS BSS 10 STOP STATEMENTS. 4F10088
CALLFN BSS 10 1ST / LAST IFN FOR CALL STATEMENTS.4F10089
FMTEFN BSS 10 TABLE OF FORMAT EXTERNAL FORMNOS. 4F10090
REM END OF THE TAPE TABLE BUFFERS. 4F10091
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10092
REM 4F10093
REM INTET/ TABLE PARAMETERS USED BY TET00, WHERE 4F10094
REM O = ORIGIN OF TABLE BUFFER, 4F10095
REM B = BUFFER CAPACITY, 4F10096
REM A = ADDRESS OF TABLE ENTRY, 4F10097
REM E = ENTRY LENGTH IN WORDS, 4F10098
REM C = COUNT OF BLOCKS PUT ON TAPE, 4F10099
REM P = PORTION OF BUFFER THAT IS FULL,4F10100
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 037/037 ------
REM 4F10101
INTET PZE TEIFNO,,10 00) 0,,B. 4F10102
PZE EIFNO,,1 A,,E. 4F10103
PZE **,,** C,,P. 4F10104
REM 4F10105
PZE TDO,,10 01) 0,,B. 4F10106
PZE 1C,,5 A,,E. 4F10107
PZE **,,** C,,P. 4F10108
REM 4F10109
PZE TIFGO,,10 02) 0,,B. 4F10110
PZE 1C,,2 A,,E. 4F10111
PZE **,,** C,,P. 4F10112
REM 4F10113
PZE TRAD,,10 03) 0,,B. 4F10114
PZE 1G,,1 A,,E. 4F10115
PZE **,,** C,,P. 4F10116
REM 4F10117
PZE FORTAG,,10 04) 0,,B. 4F10118
PZE G,,1 A,,E. 4F10119
PZE **,,** C,,P. 4F10120
REM 4F10121
PZE FORVAR,,10 05) 0,,B. 4F10122
PZE G,,2 A,,E. 4F10123
PZE **,,** C,,P. 4F10124
REM 4F10125
PZE FORVAL,,10 06) 0,,B. 4F10126
PZE G,,2 A,,E. 4F10127
PZE **,,** C,,P. 4F10128
REM 4F10129
PZE FRET,,10 07) 0,,B. 4F10130
PZE 1G,,1 A,,E. 4F10131
PZE **,,** C,,P. 4F10132
REM 4F10133
PZE EQUIT,,10 08) 0,,B. 4F10134
PZE 1C,,2 A,,E. 4F10135
PZE **,,** C,,P. 4F10136
REM 4F10137
PZE CLOSUB,,10 09) 0,,B. 4F10138
PZE G,,1 A,,E. 4F10139
PZE **,,** C,,P. 4F10140
REM 4F10141
PZE FORMAT,,10 10) 0,,B. 4F10142
PZE G,,2 A,,E. 4F10143
PZE **,,** C,,P. 4F10144
REM 4F10145
PZE SUBDEF,,10 11) 0,,B. 4F10146
PZE 1G,,1 A,,E. 4F10147
SBDFCN PZE **,,** C,,P. 4F10148
REM 4F10149
PZE COMMON,,10 12) 0,,B. 4F10150
PZE 1G,,1 A,,E. 4F10151
PZE **,,** C,,P. 4F10152
REM 4F10153
PZE HOLARG,,10 13) 0,,B. 4F10154
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 038/038 ------
PZE 1G,,1 A,,E. 4F10155
PZE **,,** C,,P. 4F10156
REM 4F10157
PZE NONEXC,,10 14) 0,,B. 4F10158
PZE EIFNO,,1 A,,E. 4F10159
PZE **,,** C,,P. 4F10160
REM 4F10161
PZE TSTOPS,,10 15) 0,,B. 4F10162
PZE EIFNO,,1 A,,E. 4F10163
PZE **,,** C,,P. 4F10164
REM 4F10165
PZE CALLFN,,10 16) 0,,B. 4F10166
PZE CALLNM,,1 A,,E. 4F10167
PZE **,,** C,,P. 4F10168
REM 4F10169
PZE FMTEFN,,10 17) 0,,B. 4F10170
PZE SET,,1 A,,E. 4F10171
PZE **,,** C,,P. 4F10172
REM 4F10173
BSS 3 EXPANSION SPACE INTET. 4F10174
REM END OF TAPE TABLE PARAMETERS. 4F10175
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10176
REM 4F10177
REM ....IX/ TABLE PARAMETERS USED BY DRTABS, WHERE 4F10178
REM ARG1 = 1ST LOCATION OF ARGUMENT, 4F10179
REM L = LENGTH OF ARGUMENT IN WORDS,4F10180
REM TDA = LOC. OF NEXT DRUM ENTRY, 4F10181
REM N = NO. OF ENTRIES ON DRUM, 4F10182
REM *** = TXL FOR ENTRY SUM TABLES, 4F10183
REM *** = TXH FOR BLOCK SUM TAB(FLCN),4F10184
REM FDA = LOC. OF 1ST DRUM ENTRY, 4F10185
REM K = BUFFER CAPACITY IN ENTRIES, 4F10186
REM DBL = K*(L+1) FOR ENTRY SUM TABLE,4F10187
REM DBL = K*L+1 FOR BLOCK SUM TABLE,4F10188
REM J = DRUM CAPACITY IN ENTRIES, 4F10189
REM I = 5 - DRUM NUMBER. 4F10190
REM 4F10191
PZE G+1,,1 FIXCON) ARG1+L,,L 4F10192
PZE FIXCON,,** TDA,,N 4F10193
TXLOP TXL FIXCON,,50*1 *** FDA,,K*L 4F10194
PZE 50*2,,100 DBL,,J 4F10195
FXCNIX TXI ALT,,5-2 TXI ATL,,I 4F10196
REM 4F10197
PZE G+1,,1 FLOCON) ARG1+L,,L 4F10198
PZE FLOCON,,** TDA,,N 4F10199
TXHOP TXL FLOCON,,50*1 *** FDA,,K*L 4F10200
PZE 50*1+1,,450 DBL,,J 4F10201
FLCNIX TXI ALT,,5-2 TXI ATL,,I 4F10202
REM 4F10203
PZE E+3+2,,2 TAU1 ) ARG1+L,,L 4F10204
PZE TAU1,,** TDA,,N 4F10205
TXL TAU1,,25*2 *** FDA,,K*L 4F10206
PZE 25*3,,100 DBL,,J 4F10207
TAU1IX TXI ALT,,5-4 TXI ATL,,I 4F10208
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 039/039 ------
REM 4F10209
PZE E+3+4,,4 TAU2 ) ARG1+L,,L 4F10210
PZE TAU2,,** TDA,,N 4F10211
TXL TAU2,,12*4 *** FDA,,K*L 4F10212
PZE 12*5,,90 DBL,,J 4F10213
TAU2IX TXI ALT,,5-4 TXI ATL,,I 4F10214
REM 4F10215
PZE E+3+6,,6 TAU3 ) ARG1+L,,L 4F10216
PZE TAU3,,** TDA,,N 4F10217
TXL TAU3,,8*6 *** FDA,,K*L 4F10218
PZE 8*7,,75 DBL,,J 4F10219
TAU3IX TXI ALT,,5-4 TXI ATL,,I 4F10220
REM 4F10221
PZE E+11+1,,1 SIGMA1) ARG1+L,,L 4F10222
PZE SIGMA1+2,,1 TDA,,N 4F10223
TXL SIGMA1,,30,* *** FDA,,K*L 4F10224
PZE 30*2,,30 DBL,,J 4F10225
SIG1IX TXI ALT,,5-2 TXI ATL,,I 4F10226
REM 4F10227
PZE 1C+2,,2 DIM1 ) ARG1+L,,L 4F10228
PZE DIM1,,** TDA,,N 4F10229
ORGDM1 TXL DIM1,,0 *** FDA,,K*L 4F10230
PZE 0,,100 DBL,,J 4F10231
DIM1IX TXI DIMALT,,5-3 TXI ATL,,I 4F10232
REM 4F10233
PZE 1C+2,,2 DIM2 ) ARG1+L,,L 4F10234
PZE DIM2,,** TDA,,N 4F10235
ORGDM2 TXL DIM2,,0 *** FDA,,K*L 4F10236
PZE 0,,100 DBL,,J 4F10237
DIM2IX TXI DIMALT,,5-3 TXI ATL,,I 4F10238
REM 4F10239
PZE 1C+3,,3 DIM3 ) ARG1+L,,L 4F10240
PZE DIM3,,** TDA,,N 4F10241
ORGDM3 TXL DIM3,,0 *** FDA,,K*L 4F10242
PZE 0,,100 DBL,,J 4F10243
DIM3IX TXI DIMALT,,5-3 TXI ATL,,I 4F10244
REM END OF DRUM TABLE PARAMETERS. 4F10245
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10246
REM 4F10247
REM COUNT AND BUFFER FOR TABLE OF FUNCTION NAMES AND DEGREES. 4F10248
BK BSS 1 FORSUB COUNTER. 4F10249
FORSUB BSS 100 NAMES AND DEGREES OF FUNCTIONS. 4F10250
REM END OF FUNCTION COUNT AND BUFFER. 4F10251
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10252
REM 4F10253
REM PARAMETERS AND BUFFER FOR COMPILED INSTRUCTION TABLE. 4F10254
BS PZE ,,100 CIB CAPACITY (4 * 25). 4F10255
EC PZE ,,** ENTRY COUNT = NO. WORDS IN CIB. 4F10256
BBOX PZE ,,** 2S COMPLEMENT OF THE ENTRY COUNT. 4F10257
CIB BSS 100 COMPILED INSTRUCTION BUFFER. 4F10258
REM END OF CIT PARAMETERS AND BUFFER. 4F10259
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10260
REM 4F10261
REM ALL OF THE ABOVE BUFFERS AND PARAMETERS ARE USED BY 1 PRIME. 4F10262
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 040/040 ------
ORG 576 4F102625
ERASE BSS 5 COMMON WORKING STORAGE. 4F10263
1C BSS 5 COMMON WORKING STORAGE. 4F10264
1G BSS 1 COMMON WORKING STORAGE. 4F10265
2G BSS 1 COMMON WORKING STORAGE FOR STATE A.4F10266
3G BSS 1 4F10267
1H BSS 1 4F10268
2H BSS 1 4F10269
3LBAR BSS 1 STORAGE USED BY ARITHMETIC. 4F10270
ARERAS BSS 1 STORAGE USED BY ARITHMETIC. 4F10271
ARGCNT MZE 4,,1 ARGUMENT COUNTER USED BY C30,C32. 4F10272
ARGCTR BSS 1 STORAGE USED BY ARITHMETIC. 4F10273
CALLNM PZE **,,** 4F10274
CHSAVE BSS 1 WORKING STORAGE USED BY ROYCNV. 4F10275
DIMSAV BSS 1 WORKING STORAGE USED BY SS000. 4F10276
E BSS 14 WORKING STORAGE USED BY SS000. 4F10277
EPSM3 BSS 3 4F10278
EPS BSS 1 EPSILON - VARIABLE USED BY RA000. 4F10279
E1C BSS 1 COMMON WORKING STORAGE. 4F10280
EFN BSS 1 EXTERNAL FORMULA NUMBER (F-1). 4F10281
F BSS 111 ASSEMBLED STATEMENT REGION. 4F10282
FIRSTC BSS 1 USED BY SS000,TESTFX,C3000. 4F10283
FSNAME BSS 1 NAME OF FUNCTION. 4F10284
FT BSS 12 SOURCE PROGRAM INPUT BUFFER. 4F10285
G BSS 2 4F10286
GTAG BSS 1 VARIABLE USED BY IOT, RA. 4F10287
HOLCNT BCD 1H(0000 WORKING STORAGE USED BY C3300. 4F10288
I BSS 1 4F10289
LEFT BSS 3 STORAGE USED BY ARITHMETIC. 4F10290
LENGTH PZE **,,** 4F10291
NBAR BSS 1 STORAGE USED BY ARITHMETIC. 4F10292
N2 BSS 1 4F10293
OPNWRD BSS 1 ERASEABLE USED BY STATE D. 4F10294
PHI(I) PZE **,,** 4F10295
RAT PZE 8,,** VARIABLE USED BY IOT. 4F10296
RESIDU BSS 1 REMAINDER OF F-REGION WORD.(C0190) 4F10297
SET PON ** 4F10298
SL BSS 1 4F10299
SYMBOL BSS 1 WORKING STORAGE USED BY SS000. 4F10300
TL PZE 31*8,,** 4F10301
TLINE PZE ** VARIABLE USED BY IOT. 4F10302
REM END OF COMMON WORKING STORAGE, BUFFERS, AND PARAMETERS. 4F10303
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10304
REM 4F10305
REM COMMON/2-CONSTANTS USED BY SECTION ONE= 4F10306
REM 4F10307
TEN OCT 12 (1010) - CTEST-11 4F10308
ENDMK OCT 77 111111 - CTEST-10 4F10309
OPEN OCT 74 ( - CTEST-9 4F10310
COMMA OCT 73 , - CTEST-8 4F10311
CLOS OCT 34 ) - CTEST-7 4F10312
EQUAL OCT 13 = - CTEST-6 4F10313
11Z OCT 40 - - CTEST-5 4F10314
SLASH OCT 61 / - CTEST-4 4F10315
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 041/041 ------
POINT OCT 33 . - CTEST-3 4F10316
12Z OCT 20 + - CTEST-2 4F10317
STAR OCT 54 * - CTEST-1 4F10318
CTEST BSS 0 ADDRESS USED FOR INDEXING ABOVE. 4F10319
REM 4F10320
L(0) BCD 1000000 0 4F10321
L(1) BCD 1000001 1 4F10322
L(2) BCD 1000002 2 4F10323
L(3) BCD 1000003 3 4F10324
L(4) BCD 1000004 4 4F10325
L(5) BCD 1000005 5 4F10326
L(6) BCD 1000006 6 4F10327
L(7) BCD 1000007 7 4F10328
L(8) BCD 1000008 8 4F10329
L(9) BCD 1000009 9 4F10330
MINUS OCT 14 - 4F10331
L(C) BCD 100000C C 4F10332
L(F) BCD 100000F F 4F10333
L(H) BCD 100000H H 4F10334
CHAR2 OCT 32 CONSTANT USED BY CD000. 4F10335
L(O) BCD 100000O O (ALPHABETIC) 4F10336
CHAR3 OCT 52 CONSTANT USED BY CD000. 4F10337
SPECOP OCT 53 00000$ 4F10338
BLANK OCT 60 0000000000060 4F10339
L(S) BCD 100000S S 4F10340
L(T) BCD 100000T T 4F10341
L(X) BCD 100000X X 4F10342
L(Z) BCD 100000Z Z 4F10343
PM OCT 72 RECORD MARK (ILLEGAL) -CD000 4F10344
BIT29 OCT 100 4F10345
A81 DEC 81 CONSTANT USED BY IOT. 4F10346
L(96) OCT 140 USED BY C0500. 4F10347
L(112) OCT 160 USED BY C0400. 4F10348
MASK3 OCT 777 -ARITHMETIC. 4F10349
1E9 OCT 1000 ADDRESS=8 4F10350
L(A() BCD 10000A( INTERNAL FLO-PT VARIABLE PREFIX. 4F10351
L(H() BCD 10000H( 4F10352
L(I() BCD 10000I( INTERNAL FIX-PT VARIABLE PREFIX. 4F10353
SAPSYM OCT 6212 4F10354
IFSYM OCT 6712 4F10355
CALLER OCT 7112 4F10356
MASK2 OCT 77777 2**15-1 -ARITHMETIC. 4F10357
2E17 OCT 400000 TAG=4 4F10358
2E18 OCT 1000000 DECREMENT=1 4F10359
DECR1 PZE 1,,1 CONSTANT USED BY DRTABS. 4F10360
ABTAG2 OCT 1000002 CONSTANT USED BY C3200. 4F10361
D2 PZE ,,2 CONSTANT USED BY IOT. 4F10362
ABTAG3 OCT 2000004 CONSTANT USED BY C3200. 4F10363
D3CN PZE ,,3 CONSTANT USED BY IOT. 4F10364
BETAD2 OCT 3077775 3*2**18+(-3) -ARITHMETIC. 4F10365
D6 PZE ,,6 CONSTATN USED BY IOT. 4F10366
FSIND PZE ,,16 4F10367
DEC17 PZE ,,17 4F10368
DEC18 PZE ,,18 4F10369
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 042/042 ------
PZ OCT 32000000 PLUS ZERO -CD000. 4F10370
MASK5 OCT 37777600 -ARITHMETIC. 4F10371
FNIND PZE ,,32 4F10372
DEC35 PZE ,,35 4F10373
MZ OCT 52000000 MINUS ZERO -CD000. 4F10374
NGTBIT OCT 000200000000 4F10375
BTA PZE ,,144 CONSTANT USED BY IOT. 4F10376
BDA PZE 0,0,192 CONSTANT USED BY IOT. 4F10377
5BLANS BCD 10 006060606060 4F10378
E( BCD 1100000 -ARITHMETIC. 4F10379
I( BCD 1200000 -ARITHMETIC. 4F10380
A( BCD 1300000 -ARITHMETIC. 4F10381
P( BCD 1400000 -ARITHMETIC. 4F10382
O( BCD 1600000 -ARITHMETIC. 4F10383
X( BCD 1700000 -ARITHMETIC. 4F10384
BETAD1 OCT 77775077775 (-3(*2**18+(-3) -ARITHMETIC. 4F10385
1BAR OCT 77777000000 (2**15-1)*2**18DECREMENT MASK. 4F10386
15P DEC 1585 CONSTANT USED BY IOT. 4F10387
PROCTR OCT 176060606060 4F10388
ADPLUS OCT 200000000000 ADDITION SIGN -ARITHMETIC. 4F10389
FLOVAR BCD 1A(0000 A( INTERNAL FLOATING PT. 4F10390
FXFX BCD 1EXP(1 4F10391
FLFX BCD 1EXP(2 4F10392
FLFL BCD 1EXP(3 4F10393
FIXVAR BCD 1I(0000 I( INTERNAL FIXED PT. VARIABLE. 4F10394
MINUS0 MZE 0 4F10395
DECMI2 MZE ,,2 4F10396
ADSPOP OCT 530000000000 $00000 4F10397
DOLSGN OCT 536000000000 CONSTANT USED BY C32000 4F10398
ADSTAR OCT -140000000000 MULTIPLUCATION SIGN -ARITHMETIC. 4F10399
STRSTR OCT -145400000000 EXPONENTIATION SIGN -ARITHMETIC. 4F10400
BLANKS BCD 1 606060606060 4F10401
MASK1 OCT -377777700000 -(2**20-U.***15 -ARITHMETIC. 4F10402
MASK4 OCT -377777777737 -ARITHMETIC 4F10403
ALL1 OCT -377777777777 END OF STATMENT WORD. 4F10404
REM 4F10405
L(ADD) BCD 1ADD000 SYMBOLIC OPERATION CODE. 4F10406
L(ALS) BCD 1ALS000 SYMBOLIC OPERATION CODE. 4F10407
L(ANA) BCD 1ANA000 SYMBOLIC OPERATION CODE. 4F10408
L(ARS) BCD 1ARS000 SYMBOLIC OPERATION CODE. 4F10409
L(BSS) BCD 1BSS000 SYMBOLIC OPERATION CODE. 4F10410
L(CAL) BCD 1CAL000 4F10411
L(CHS) BCD 1CHS000 SYMBOLIC OPERATION CODE. 4F10412
L(CLA) BCD 1CLA000 SYMBOLIC OPERATION CODE. 4F10413
L(CLM) BCD 1CLM000 SYMBOLIC OPERATION CODE. 4F10414
L(CLS) BCD 1CLS000 SYMBOLIC OPERATION CODE. 4F10415
L(CPY) BCD 1CPY000 4F10416
L(DCT) BCD 1DCT000 SYMBOLIC OPERATION CODE. 4F10417
L(DED) BCD 1DED000 4F10418
L(DVP) BCD 1DVP000 SYMBOLIC OPERATION CODE. 4F10419
L(FAD) BCD 1FAD000 SYMBOLIC OPERATION CODE. 4F10420
L(FDP) BCD 1FDP000 SYMBOLIC OPERATION CODE. 4F10421
L(FMP) BCD 1FMP000 SYMBOLIC OPERATION CODE. 4F10422
L(FSB) BCD 1FSB000 SYMBOLIC OPERATION CODE. 4F10423
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 043/043 ------
L(HPR) BCD 1HPR000 SYMBOLIC OPERATION CODE. 4F10424
L(LDA) BCD 1LDA000 4F10425
L(LDQ) BCD 1LDQ000 SYMBOLIC OPERATION CODE. 4F10426
L(LLS) BCD 1LLS000 SYMBOLIC OPERATION CODE. 4F10427
L(LRS) BCD 1LRS000 SYMBOLIC OPERATION CODE. 4F10428
L(LXD) BCD 1LXD000 SYMBOLIC OPERATION CODE. 4F10429
L(MPY) BCD 1MPY000 SYMBOLIC OPERATION CODE. 4F10430
L(MSE) BCD 1MSE000 SYMBOLIC OPERATION CODE. 4F10431
L(ORA) BCD 1ORA000 SYMBOLIC OPERATION CODE. 4F10432
L(PSE) BCD 1PSE000 SYMBOLIC OPERATION CODE. 4F10433
L(PXD) BCD 1PXD000 SYMBOLIC OPERATION CODE. 4F10434
L(OPR) BCD 1OPRO00 SYMBOLIC OPERATION CODE. 4F10435
L(QXD) BCD 1QXD000 SYMBOLIC OPERATION CODE. 4F10436
L(STA) BCD 1STA000 SYMBOLIC OPERATION CODE. 4F10437
L(STO) BCD 1STO000 SYMBOLIC OPERATION CODE. 4F10438
L(STQ) BCD 1STQ000 SYMBOLIC OPERATION CODE. 4F10439
L(SUB) BCD 1SUB000 SYMBOLIC OPERATION CODE. 4F10440
L(SXD) BCD 1SXD000 SYMBOLIC OPERATION CODE. 4F10441
L(TIX) BCD 1TIX000 4F10442
L(TOV) BCD 1TOV000 SYMBOLIC OPERATION CODE. 4F10443
L(TQO) BCD 1TQO000 SYMBOLIC OPERATION CODE. 4F10444
L(TRA) BCD 1TRA000 SYMBOLIC OPERATION CODE. 4F10445
L(TSX) BCD 1TSX000 SYMBOLIC OPERATION CODE. 4F10446
L(UFA) BCD 1UFA000 SYMBOLIC OPERATION CODE. 4F10447
REM END OF COMMON CONSTANTS USED BY SECTION ONE. 4F10448
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10449
REM 4F10450
REM COMMON/3-SUBROUTINES USED BY SECTION ONE* 4F10451
REM 4F10452
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10453
REM 4F10454
REM C0150,2/ CALLS=C0190,DIAG,C0180,C0160. CALLER=C0100. 4F10455
REM C0150 INSPECTS 1ST NB CHAR STARTING IN MQ. IF NUMERIC, SETS I4F10456
REM = 0, AND CONVERTS SUCCESSIVE NUMERICS TO BINARY. IF NON- 4F10457
REM NUMERIC, SETS I = -O, AND PACKS INTO 1G SUCCESSIVE CHARACTERS4F10458
REM UNTIL A ,()= OR ENDMK IS MET, AND LEFT IN THE AC. 4F10459
C0150 SXD C015X,2 SAVE THE C(XR2). 4F10460
TSX C0190,4 * TEST 1ST NON-BLANK CHARACTER 4F10461
CAS L(9) FOR NUMERIC OR NON-NUMERIC. 4F10462
C015X TXI C0151,0,** IF NON-NUMERIC, TRANSFER. 4F10463
NOP IF NUMERIC, THEN 4F10464
TSX C0180,2 * GO CONVERT TO BINARY. 4F10465
STO 2G SAVE NEXT NON-NUERIC CHARACTER. 4F10466
CLA L(0) PREPARE TO SET I TO +0. 4F10467
FWA TXI C0152,0,** GO SET I FOR NUMERIC. 4F10468
C0151 TSX C0160,2 * ASSEMBLE NON-NUMERICS IN 1G. 4F10469
STO 1G SAVE PUNCTUATION MARK, AND 4F10470
CLS L(0) PREPARE TO SET I TO -0. 4F10471
C0152 STO I SET I = +0, OR -0. 4F10472
CLA 2G PICKUP NEXT CHARACTER, 4F10473
LXD C015X,2 RESTORE THE C(XR2), AND 4F10474
TRA 1,2 * RETURN TO CALLER. 4F10475
REM END OF PROGRAM C0150. 4F10476
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10477
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 044/044 ------
REM 4F10478
REM C0160,2/ CALLS=C0190,DIAG. CALLERS=C0100,C0200,C1000,C1200, 4F10479
REM C1500,C3000,C3100,C0150. 4F10480
REM C0160 ASSEMBLES LEFT-ADJUSTED IN 1G, THE CHAR IN THE AC AND 4F10481
REM SUCCESSIVE NB CHARS STARTING IN THE MQ, UNTIL A ,()= OR ENDMK4F10482
REM IS MET AND LEFT IN THE AC. ALSO MARKS END OF WORD WITH A 4F10483
REM BLANK, IF LESS THEN 6 CHARACTERS. 4F10484
C0160 SXD C016X,2 SAVE THE C(XR2), AND 4F10485
LXA L(0),2 SET XR2 TO CONTROL SHIFTING. 4F10486
STZ 1G CLEAR WORKING STORAGE. 4F10487
C0161 LXA CTESTX,4 TEST 4F10488
C0162 CAS CTEST,4 CHARACTER 4F10489
C016X TXI C0163,0,** IN THE AC 4F10490
TXI C0165,0 AGAINST 4F10491
C0163 TIX C0162,4,1 ALL PUNCTUATIONS. 4F10492
TXL C0164,2,30 IF SYMBOL EXCEEDS 6 CHARACTERS, 4F10493
TSX DIAG,4 * GO TO THE DIAGNOSTIC. 4F10494
C0164 ALS 30,2 BUILD LEFT-ADJUSTED 4F10495
ORS 1G SYMBOL IN WORKING STORAGE. 4F10496
TSX C0190,4 * GET NEXT NB CHARACTER IN THE AC. 4F10497
TXI C0161,2,6 UPDATE SHIFT COUNT, AND CONTINUE. 4F10498
C0165 TXH C0167,2,0 IF PUNCTUATION IS 1ST CHARACTER. 4F10499
C0166 TSX DIAG,4 * OR ILLEGAL, GO TO THE DIAGNOSTIC. 4F10500
C0167 TXL C0166,4,5 IF LEGAL PUNCTUATION, THEN 4F10501
STO 1H SAVE, AND 4F10502
CLA BLANK ADD A BLANK 4F10503
ALS 30,2 TO SYMBOLS THAT ARE LESS 4F10504
ORS 1G THEN 6 CHARACTERS IN LENGTH. 4F10505
CLA 1H PICKUP PUNCTUATION MARK, 4F10506
LXD C016X,2 RESTORE THE C(XR2), AND 4F10507
TRA 1,2 * RETURN TO CALLER. 4F10508
REM END OF PROGRAM C0160. 4F10509
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10510
REM 4F10511
REM C0180,2/ CALLS=C0190,DIAG. CALLERS=C0100,C0200,C0300,C0400, 4F10512
REM C1000,C1100,C1200,C1400,C1500,C0150. 4F10513
REM C0180 CONVERTS SUCCESSIVE NUMERICS STARTING IN THE MQ TO 4F10514
REM BINARY, PLACES RESULT IN 1G, AND LEAVES 1ST NON-NUMERIC IN 4F10515
REM THE AC. 1ST NUMERIC IS ASSUMED TO BE ALREADY IN THE AC. 4F10516
C0180X TSX C0190,4 * OBTAIN 1ST NUMERIC IN THE AC. 4F105165
C0180 STO 1G PLACE 1ST NUMERIC IN 1G. 4F10517
TSX C0190,4 * EXAMINE NEXT NON-BLANK CHARACTER, 4F10518
CAS L(9) AND IF NON-NUMERIC, THEN 4F10519
TRA 1,2 * RETURN TO CALLER. 4F10520
NOP IF NUMERIC, THEN 4F10521
STO 2G SAVE DIGIT IN 2G. 4F10522
CLA 1G MULTIPLY 4F10523
ALS 2 C(1G) 4F10524
ADD 1G BY 4F10525
ALS 1 10, 4F10526
ADD 2G AND ADD CURRENT DIGIT. 4F10527
DCF TXI C0180,0,-F REPEAT PROCESS FOR NEXT CHARACTER. 4F10528
REM END OF PROGRAM C0180. 4F10529
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10530
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 045/045 ------
REM 4F10531
REM C0190X,4/ CALLERS=CD000,CB000,CC000,C0300,C3300. 4F10532
REM C0190X INITIALIZES C0190 TO OBTAIN 1ST WORD OF FORMUAL IN F. 4F10533
C0190X CLA DCF SET FORMULA WORD 4F10534
STD FWA ADDRESS = -(F-REGION ADDRESS), 4F10535
SXD CHCTR,0 SET CHARACTER COUNT = 0, 4F10536
TRA 1,4 * RETURN TO MAIN ROUTINE. 4F10537
REM END OF PROGRAM C0190X. 4F10538
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10539
REM 4F10540
REM C0390,4/ CALLERS=C0300,C3300. 4F10541
REM C0390 INSERTS THE CHARACTER IN THE AC INTO THE 1ST POSITION 4F10542
REM TO THE LEFT OF THAT DEFINED BY FWA AND XR1 4F10543
C0390 CLA ENDMK PREPARE TO CHANGE 4F10544
LXD FWA,2 THE PROPER CHARACTER 4F10545
LXD CHCTR,1 IN THE F-REGION. 4F10546
TNX C0393,1,1 ADJUST MASK 4F10547
C0392 LGL 6 TO POSITION 4F10548
TIX C0392,1,1 CHARACTER 4F10549
C0393 COM INVERT MASK, AND 4F10550
ANS -1,2 ERASE PROPER CHARACTER. 4F10551
LGL 36 ADJUST CHARACTER, AND 4F10552
ORS -1,2 INSERT IN ERASED POSITION. 4F10553
REM C0390 CONTINUES BY USING C0190. 4F10554
REM 4F10555
REM C0190,4/ CALLERS=CD000,CB000,CC000,C0100,C200,C00300,C0400, 4F10556
REM C0900,C1000,C1100,C1200,C1400,C1500,C1600,C3000,C3100,C3200, 4F10557
REM C3300,C3400,C0150,C0160,C0190,SS000,ROYCNV,RSC,LPR. 4F10558
REM C0190 OBTAINS IN AC THE NEXT NON-BLANK CHARACTER OF FORMULA. 4F10559
C0190 SXD C0194,1 SAVE THE C(XR1), AND 4F10560
LXD CHCTR,1 SET XR1 = CHARACTER COUNT. 4F10561
LDQ RESIDU PICK UP ANY REMAINING CHARACTERS. 4F10562
C0191 TIX C0193,1,1 IF NONE, 4F10563
LXD FWA,1 PICK UP NEXT FORMULA 4F10564
LDQ 0,1 WORD FROM F-REGION, 4F10565
TXI C0192,1,-1 AND INCREASE 4F10566
C0192 SXD FWA,1 FORMULA WORD ADDRESS BY 1. 4F10567
LXA L(6),1 RESET XR1 FOR 6 NEW CHARACTERS. 4F10568
C0193 PXD ,0 EXAMINE 4F10569
LGL 6 NEXT CHARACTER 4F10570
CAS BLANK AND COMPARE WITH A BLANK. 4F10571
C0194 TXI C0195,0,** IF BLANK, 4F10572
CHCTR TXI C0191,0,** GO EXAMINE NEXT CHARACTER. 4F10573
C0195 SXD CHCTR,1 IF NOT BLANK, RESET CHAR COUNT, 4F10574
STQ RESIDU SAVE ANY REMAINING CHARACTERS, 4F10575
LXD C0194,1 RESTORE THE C(XR1), AND 4F10576
TRA 1,4 * RETURN TO MAIN ROUTINE. 4F10577
REM END OF PROGRAM C0190. 4F10578
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10579
REM 4F10580
REM CIT00,4/ CALLERS=C0200,C0400,C0900,C1000,C1100,C1300,C1600, 4F10581
REM C3200,RDC,WBT,RBT,WRD,BRW,EFT,LPR,CMA,EMK,INPUT(OUTPUT), 4F10582
REM ETMSW(LTMSW),LIB,VRA(VRD). 4F10583
REM C1T00 MAKE ENTRIES IN THE COMPILED INSTRUCTION TABLE. WHEN 4F10584
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 046/046 ------
REM THE BUFFER IS FULL IT IS WRITTEN AS A RECORD ONTO TAPE 3. 4F10585
CIT00 SXD CITXR2,2 SAVE THE C(XR2). 4F10586
SXD CITXR1,1 SAVE THE C(XR1). 4F10587
STQ CITMQR SAVE THE C(MQR). 4F10588
LXD BBOX,2 SET XR2 = 2S COMPL OF NO-WRDS-ENTD.4F10589
CLA BS COMPARE BLOCK SIZE 4F10590
SUB EC WITH ENTRY COUNT. 4F10591
TNZ CIT04 IF BLOCK IS NOT FULL,GO MAKE ENTRY.4F10592
WRS CITTAP PREPARE TO WRITE BLOCK ON CIT TAPE.4F10593
PAX ,1 SET XR1 = 0, AND 4F10594
CIT01 CPY CIB,1 COPY SUCCESSIVE 4F10595
TXI CIT02,1,-1 WORDS OF BLOCK 4F10596
CIT02 TXI CIT03,2,1 AND CONTINUE 4F10597
CIT03 TXH CIT01,2,1 UNTIL XR2 = 0. 4F10598
IOD WHEN DONE, 4F10599
CIT04 LXA L(4),1 SET XR1 = ENTRY SIZE. 4F10600
CIT05 TXI CIT05+1,4,-1 SET XR4 = -(ADDR OF NEXT ENTRY WRD)4F10601
CLA 0,4 AND PICK UP ADDRESS OF NEXT ENTRY 4F10602
STA CIT06 TO SET NEXT ADDRESS. 4F10603
CIT06 CLA ** MOVE ENTRY 4F10604
STO CIB,3 INTO CIB BUFFER, 4F10605
TXI CIT07,2,-1 AND COUNT 1 FOR EACH WORD ENTERED. 4F10606
CIT07 TIX CIT05,1,1 WHEN DOEN, 4F10607
SXD BBOX,2 SAVE THE C(XR2), AND 4F10608
DMSR99 PXD DMSR05+1,2 COMPUTE THE 4F10609
COM REAL NUMBER 4F10610
ADD 2E18 OF WORDS ENTERED 4F10611
DMSR98 PDX DMSR05,2 IN CIB BUFFER, AND 4F10612
SXD EC,2 SAVE IN EC. 4F10613
LDQ CITMQR RESTORE THE C(MQR), 4F10614
LXD CITXR1,1 RESTORE THE C(XR1), 4F10615
LXD CITXR2,2 RESTORE THE C(XR2), AND 4F10616
TRA 1,4 * EXIT TO MAIN ROUTINE (5TH WRD CS). 4F10617
REM END OF PROGRAM CIT00. 4F10618
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10619
REM 4F10620
REM DIM.SR,4/ CALLS=DIAG. CALLERS=C1200,SS000,CMA. 4F10621
REM DIM.SR SEARCHS THE DIMENSION TABLES. ENTRANCE IS TO DIM1SR, 4F10622
REM DIM2SR, OR DIM3SR ACCORDING TO THE DIMENSION. 4F10623
REM DIM1SR= ENTRY POINT FOR 1 DIMENSION TABLE. 4F10624
DIM1SR SXD DMSR00,4 SAVE THE C(XR4) FOR RETURN, 4F10625
LXD DIM1IX-3,4 SET XR4 = NUMBER OF ENTRIES IN DIM14F10626
CLA ORGDM1 AND PICK UP 1ST ADDRESS OF DIM1 TO 4F10627
DMSR00 TXI DMSR01,0,** GO SET DRUM ADDRESS. 4F10628
REM DIM2SR = ENTRY POINT FOR 2 DIMENSION TABLE. 4F10629
DIM2SR SXD DMSR00,4 SAVE THE C(XR) FRO RETURN. 4F10630
LXD DIM2IX-3,4 SET XR4 = NUMBER OF ENTRIES IN DIM24F10631
CLA ORGDM2 AND PICK UP 1ST ADDRESS OF DIM2 TO 4F10632
DMSR01 STA DRMADR SET DRUM ADDRESS. 4F10633
CLA DMSR99 SET LOOP ADDRESS TO 4F10634
STA DMSR15 DMSR05+1 FOR DIM1 AND DIM2. 4F10635
CAL DMCN12 (STZ D3) 4F10636
DMSR11 TXI DMSR02,0,** GO SET OP FRO DIM1 AND DIM2. 4F10637
REM DIM3SR= ENTRY POINT FOR 3 DIMENSION TABLE. 4F10638
DIM3SR SXD DMSR00,4 SAVE THE C(XR4) FRO RETURN, 4F10639
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 047/047 ------
LXD DIM3IX-3,4 SET XR4 = NUMBER OF ENTRIES IN DIM34F10640
CLA ORGDM3 AND PICK UP 1ST ADDRESS OF DIM3 TO 4F10641
STA DRMADR SET DRUM ADDRESS. 4F10642
CLA DMSR98 SET LOOP ADDRESS TO 4F10643
STA DMSR15 DMSR05 FOR DIM3. 4F10644
CAL DMCN3 (CPY D3) 4F10645
DMSR02 SLW DMSR05 SET OP CODES ACCORDING 4F10646
SLW DMSR07 TO DIMENSION. 4F10647
TXL DMSR08,4,0 IF TABLE IS EMPTY, GO OUT. 4F10648
SXD DMSR11,4 SAVE ENTRY COUNT IN CASE OF ERROR. 4F10649
DMSR14 LXA L(5),4 SET ERROR COUNTER FOR 5 ATTEMPTS. 4F10650
DMSR13 SXD DMSR12,4 SAVE ERROR COUNTER, AND 4F10651
LXD DMSR11,4 RESET ENTRY COUNT. 4F10652
RDR 3 SELECT DRUM. 4F10653
CLA E+2 GET NAME OF VARIABLE. 4F10654
LDA DRMADR LOAD CURRENT DRUM ADDRESS, AND 4F10655
DMSR04 CPY DRSYM COPY DRUM SYMBOL. 4F10656
TLQ DMSR06 COMPARE WITH NAME OF VARIABLE, AND 4F10657
CPY D12 IF NOT LESS, COPY N1 AND N2. 4F10658
DMSR05 PZE D3 (DIM1 AND DIM2 = STZ , DIM3 = CPY).4F10659
CPY DRCKSM COPY CHECKSUM. 4F10660
CAS DRSYM COMPARE DRUM SYMBOL WITH ANEM OF V.4F10661
TSX DIAG,4 * GO TO DIGNOSTIC - MACHINE ERROR. 4F10662
DMSR12 TXI DMSR09,0,** IF NOT EQUAL, THEN 4F10663
CPY DRSYM CONTINUE 4F10664
TLQ DMSR06 PROCESS 4F10665
CPY D12 UNTIL 4F10666
DMSR15 TIX **,4,1 TABLE 4F10667
TXI DMSR08,0 IS EXHAUSTED. 4F10668
DMSR06 CPY D12 PASS OVER ENTRY 4F10669
DMSR07 PZE D3 (DIM1 AND DIM2 = STZ, DIM3 = CPY) 4F10670
CPY DRCKSM AND CHECKSUM, AND 4F10671
TIX DMSR04,4,1 REPEAT LOOP. 4F10672
DMSR08 LXD DMSR00,4 RESTORE THE C(XR4), AND 4F10673
TRA 1,4 * TAKE NOT FOUND EXIT. 4F10674
DMSR09 CAL DRSYM COMPUTE A 4F10675
ACL D12 NEW 4F10676
ACL D3 LOGICAL CHECKSUM 4F10677
COM FOR ENTRY. AND 4F10678
ACL DRCKSM COMPARE WITH 4F10679
COM DRUM CHECKSUM. 4F10680
TZE DMSR10 IF NOT EQUAL, THEN 4F10681
LXD DMSR12,4 REPEAT ATTEMPT, 4F10682
TIX DMSR13,4,1 UNLESS PROCESS 4F10683
TSX DIAG,4 * FAILED 5 TIMES IN READING DRUM. 4F10684
DMSR10 LXD DMSR00,4 RESTORE THE C(XR4), AND 4F10685
TRA 2,4 * TAKE FOUND EXIT TO MAIN ROTUINE. 4F10686
REM 4F10687
DMCN12 STZ D3 CONSTANT USED BY DIM.SR. 4F10688
DMCN3 CPY D3 CONSTANT USED BY DIM.SR. 4F10689
ENT BCD 1NTR000 VARIABLE USED BY IO AND FL. 4F10690
NZE BCD 1PZE000 VARIABLE USED BY FL. 4F10691
REM END OF PROGRAM DIM.SR. 4F10692
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10693
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 048/048 ------
REM 4F10694
REM DRTABS(,4)/ CALLS RDRX,DIAG. CALLERS=C1200,SS000,ROYCNV,CMA, 4F10695
REM VRA(VRD). 4F10696
REM DRTABS IS CALLED BY TSX ....IX,4 -WHERE .... IS THE NAME OF 4F10697
REM THE DRUM TABLE REFERRED TO. DRTABS MAKES ENTRIES IN THE DRUM 4F10698
REM TABLES, AND ALSO SEARCHES THE DRUM TABLES FOR INFOMATION. 4F10699
REM DIMALT= ENTRY POINT FOR DIMENSION TABLES. 4F10700
DIMALT CAL TXLOP PICK UP SWITCH CONTROL, 4F10701
TXI DRTABS,0 AND GO SET SWITCH FOR DIM TABLES. 4F10702
REM ALT= ENTRY POINT FOR ALL OTHER DRUM TABLES. 4F10703
ALT CAL TXHOP PICK UP SWITCH CONTROL, 4F10704
DRTABS STP DIMSW SET SWITCH. 4F10705
CLA 0,4 GET CALLER (TSX ....IX,4) IN AC. 4F10706
SXD XR1,1 SAVE THE C(XR1), 4F10707
SXD XR2,2 SAVE THE C(XR2), 4F10708
SXD XR4,4 SAVE THE C(XR4), AND 4F10709
STQ MQ SAVE THE C(MQR). 4F10710
ADD L(1) PREPARE TO MOVE PARAMETERRS 4F10711
STA MOVE INTO WORKING STORAGE. 4F10712
SUB L(4) PREPARE TO UPDATE 4F10713
STA UPDATE PERMANENT PARAMETER. 4F10714
LXA L(5),1 MOVE 5 WORDS 4F10715
MOVE CAL **,1 (....IX+1) 4F10716
SLW TEMP,1 OF PARAMETERS 4F10717
TIX MOVE,1,1 INTO WORKING STORAGE. 4F10718
CLS NAR INITIALIZE 4F10719
STA TRY ALL 4F10720
ADD L(1) GENERAL 4F10721
STA ESUM1 INSTRUCTIONS= 4F10722
STA ESUM2 X 4F10723
ARS 17 X 4F10724
ADM BIAS X 4F10725
STA JUMP1 X 4F10726
STA JUMP2 X 4F10727
CAL FDA X 4F10728
STD COMPR X 4F10729
STP JUMP1 X 4F10730
STP SW X 4F10731
STP RX4 X 4F10732
CLA LBUF X 4F10733
STA BUFL X 4F10734
CLA TDA X 4F10735
LXD TDA,2 X 4F10736
SXD BUFF+1,2 X 4F10737
DIMSW TXL BUFF,0 IF DIM TABLE, SKIP SEARCH. 4F10738
TXL XERR01+1,2,0 SKIP IF TABLE IS EMPTY. 4F10739
LXD NAR,1 4F10740
SXD NC,2 4F10741
SXD ADD01,2 4F10742
ADD02 TNX COMPR,1,1 COMPUTES (N*L). 4F10743
ADD01 TXI ADD02,2,** (N) 4F10744
BUFFM1 LXD FDA,2 4F10745
BUFF LXD DBL,1 L(J) 4F10746
TIX BUFF+3,1,** (N) TEST FOR TABLE OVERFLOW. 4F10747
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 049/049 ------
XERR01 TXI WHICH,0 GO FIND OUT WHICH TABLE OVERFLOWED.4F10748
LXD DI,1 4F10749
WDR 5,1 4F10750
SW TXL EBLK,0 ENTER SUM=TXL, BLOCK SUM=TXH. 4F10751
TXL ADD04,2,0 SKIP IF TABLE IS EMPTY. 4F10752
TXI ADD03,2,1 4F10753
ADD03 TNX ADD05,2,50 SKIP IF BLOCK IS NOT YET FULL. 4F10754
ADD04 STZ DUMP START NEW BLOCK CHECKSUM. 4F10755
CLA TDA CHANGE CHECKSUM ADDRESS. 4F10756
STA FDA 4F10757
ADD L(1) SET ENTRY ADDR = CHECKSUM ADD +1. 4F10758
STA TDA 4F10759
ADD05 CAL DUMP 4F10760
ACL G ADD NEW FLOCON TO 4F10761
SLW DUMP CHECKSUM FOR THIS BLOCK. 4F10762
LDA FDA 4F10763
CPY DUMP WRITE BLOCK CHECKSUM ON DRUM. 4F10764
WDR 5,1 4F10765
LDA TDA 4F10766
CPY G WRITE NEW FLOCON ON DRUM. 4F10767
XR2 TXI NOWIN,0,** GO UPDATE FLOCON PARAMETER. 4F10768
EBLK PXD ,0 FOR ALL TABLES EXCEPT FLOCON= 4F10769
LXD NAR,2 (L) 4F10770
LDA TDA NEXT DRUM ENTRY ADDRESS. 4F10771
TNX ESUM2,2,1 IF L = 1, 4F10772
ESUM1 CAD **,2 (ARG1+L-1) WRITE NEW 4F10773
TIX ESUM1,2,1 ENTRY ON DRUM. 4F10774
ESUM2 CAD ** (ARG1+L-1) 4F10775
SLW DUMP COMPUTE AND 4F10776
CPY DUMP WRITE CHECKSUM FOR NEW ENTRY. 4F10777
NOWIN CAL NAR UPDATE PERMANENT 4F10778
ARS 18 PARAMETERS FOR ENTRY 4F10779
ADD DECR1 JUST ADD TO TABLE. 4F10780
RX4 TXL RX4+2,0,** IF TABLE WAS FLOCON, 4F10781
SUB L(1) READJUST. 4F10782
ADM TDA N=N+1,TDA=TDA+(L+1) OR (L). 4F10783
UPDATE STO ** (....IX-3) 4F10784
LXD TDA,2 L(N) 4F10785
XR4 TXI OUT,0,** GET TAG AND EXIT. 4F10786
NXBLK LXD NC,4 4F10787
LXD FDA,2 L(K*L),K=K. 4F10788
NEW LXD NAR,1 L(L) 4F10789
TRY CLA **,1 (ARG1+L) 4F10790
BUFL CAS **,2 (BUFR OR CTABL) 4F10791
NC TXI NC+2,0,** NOT FOUND. 4F10792
TXI YEA,2,-1 K*L = K*L-1. 4F10793
TNX BUFFM1,4,1 N = N-1 OR ITEM NOT IN TABLE. 4F10794
SXD NC+4,1 4F10795
TIX NEW,2,** K = K-1. 4F10796
SXD NC,4 SAVE CURRENT VALUE OF N, 4F10797
CAL DBL AND GET NEW BLOCK. 4F10798
ADM FDA 4F10799
STA FDA 4F10800
LXD NTL,2 4F10801
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 050/050 ------
COMPR TIX COMPR+2,2,** (K*L) 4F10802
SXD FDA,2 K*L = (N*L)MOD K*L IF N*L IS 4F10803
SXD NTL,2 LESS THAN K*L, OTHERWISE K*L = K*L,4F10804
TSX RDRX,4 * GO READ NEXT BLOCK INTO BUFFER. 4F10805
NTL TXI NXBLK,0,** (N*L,N*L-K*L,N*L-2*K*L,...(N*L)MOD 4F10806
YEA TIX TRY,1,1 K*L). TEST NEXT WORD OF ARG. L=L-1.4F10807
LXD TDA,2 (N) 4F10808
SXD YEA+3,4 4F10809
TIX OUT,2,** COMPUTE TAG. 4F10810
LXA L(0),2 4F10811
OUT PXD ,2 EXIT WITH TAG IN THE AC. 4F10812
ARS 18 (TAG = NUMBER OF ENTRIES 4F10813
LXD XR2,2 WHICH PRECEED THE ENTRY 4F10814
LXD XR4,4 WHICH EQUALS THE ARGUMENT. 4F10815
LXD XR1,1 RESTORE THE C(XR1,XR2,XR4), 4F10816
LDQ MQ RESTORE THE C(MQR), AND 4F10817
TRA 1,4 * RETURN TO MAIN ROUTINE. 4F10818
WHICH LXD XR4,4 GET ALPHA BAR, AND 4F10819
CLA 0,4 AND PICK UP ALPHA (TSX ...NIX,4). 4F10820
ANA MASK2 BLANK ALL BUT ...NIX. 4F10821
SUB CONX (...NIX) - (ADDR OF FIXCNIX-5). 4F10822
LXA L(9),4 SET XR4 FOR 9 TABLES. 4F10823
COMPUT SUB L(5) COMPUTE WHICH 4F10824
TZE WHICHX TABLE OVERFLOWED. 4F10825
TIX COMPUT,4,1 IF TABLE IS NOT FOUND. 4F10826
TSX DIAG,4 * GOT TO DIAGNOSTIC. 4F10827
WHICHX PXD ,4 OTHERWISE, 4F10828
COM CONVERT 2S COMPLEMENT 4F10829
ADD 2E18 OF NUMBER, 4F10830
PDX ,4 PLACE IN XR4, AND 4F10831
TXI DIAG,0 * GO TO DIAGNOSTIC. 4F10832
REM 4F10833
CONX PZE FXCNIX-5 CONSTANT USED BY DRTABS. 4F10834
BUFR BES 50 DRUM TABLE BUFFER. 4F10835
MQ BSS 1 WORKING STORAGE USED BY DRTABS. 4F10836
NAR BSS 1 WORKING STORAGE USED BY DRTABS. 4F10837
TDA BSS 1 WORKING STORAGE USED BY DRTABS. 4F10838
FDA BSS 1 WORKING STORAGE USED BY DRTABS. 4F10839
DBL BSS 1 WORKING STORAGE USED BY DRTABS. 4F10840
DI BSS 1 WORKING STORAGE USED BY DRTABS. 4F10841
TEMP BSS 0 INDEXING ADDRES FOR ABOVE -DRTABS. 4F10842
DUMP BSS 1 WORKING STORAGE USED BY DRTABS. 4F10843
REM END OF PROGRAM DRTABS. 4F10844
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10845
REM 4F10846
REM GETIFN,4/ CALLERS=C0100,C0200,C1000,C1100,C1600,C3200. 4F10847
REM GETIFN PLACES THE INTERNAL FORMULA NUMBER IN AC AND IN 1C. 4F10848
GETIFN LXD EIFNO,1 PLACE THE INTERNAL FORMULA 4F10849
PXD ,1 NUMBER IN XR1, IN THE DECREMENT 4F10850
STO 1C OF THE AC, AND IN 1C. THEN 4F10851
TRA 1,4 * RETURN TO CALLER. 4F10852
REM END OF PROGRAM GETIFN. 4F10853
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10854
REM 4F10855
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 051/051 ------
REM JIF(GIF),4/ CALLERS=RDC,EFT,LPR,SPC,CMA,EMK,INPUT(OUTPUT), 4F10856
REM VRA(VRD),C3200. 4F10857
REM JIF = ENTRY POINT USED BY RDC,LPR,SPC,CMA,EMK,VRA(VRD),C3200.4F10858
JIF CAL EIFNO INCREASE THE 4F10859
ADD D1 INTERNAL FORMULA NUMBER 4F10860
STD EIFNO BY 1. 4F10861
REM GIF = ENTRY POINT USED BY EFT,INPUT(OUTPUT). 4F10862
GIF CAL EIFNO PICKUP IFN, 4F10863
ANA 1BAR CLEAR SL, AND 4F10864
L(SL) SLW SL PLACE IFN IN THE DECREMENTS 4F10865
L(TL) STD TL OF SL AND TL. 4F10866
TRA 1,4 * EXIT TO CALLER. 4F10867
REM END OF PROGRAM JIF(GIF). 4F10868
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10869
REM 4F10870
REM MTR000/ MONITOR ROUTINE FOR CALLING STATES FROM DRUM. 4F10871
REM STATEA= ENTRY POINT FOR STATE A. 4F10872
STATEA LXA L(4),4 SET C(XR4) = 4, THEN 4F10873
TXI MTR1,0 GO GET PARAMETERS. 4F10874
REM STATEB= ENTRY POINT FOR STATE B. 4F10875
STATEB LXA L(2),4 SET C(XR4) = 2, THEN 4F10876
TXI MTR1,0 GO GET PARAMETERS. 4F10877
REM STATEC= ENTRY POINT FOR STATE C. 4F10878
STATEC LXA L(1),4 SET C(XR4) = 1, THEN 4F10879
MTRCSL TXI MTR1,0,** GO GET PARAMETERS. 4F10880
REM STATED= ENTRY POINT FOR STATE D. 4F10881
STATED LXA L(3),4 SET C(XR4) = 3, THEN 4F10882
MTR1 CLA ZETA+4,4 OBTAIN THE NUMBER OF WORDS IN THE 4F10883
STD MTRCSL CURRENT STATE, AND SAVE. 4F10884
ARS 18 ADD THE NUMBER OF WORDS IN THE 4F10885
ADD MTR3 CURRENT STATE TO THE MEMORY ORIGIN 4F10886
STA MTR2 TO SET ADDRESS OF COPY LOOP. 4F10887
LXA DRMERC,1 SET FOR FIVE ATTEMPTS. 4F10888
MTR15 RDR 5,4 READ SELECT CURRENT LOGICAL DRUM. 4F10889
LXD MTRCSL,2 LENGTH OF CURRENT STATE TO XR2. 4F10890
LDA ZETA+4,4 THEN COPY 4F10891
PXD ,0 CURRENT STATE 4F10892
CAD DRCKSM FROM DRUM 4F10893
COM INTO MEMORY 4F10894
MTR2 CAD **,2 WHILE COMPUTING 4F10895
TIX MTR2,2,1 LOGICAL CHECKSUM. 4F10896
COM IF THIS EQUALS DRUM CHECKSUM, 4F10897
MTR3 TZE MEMORG * THEN ENTER CURRENT STATE. 4F10898
TIX MTR15,1,1 CHECKSUM FAILED, TRY UP TO 5 TIMES.4F10899
MTRERR TXI DIAG,4,-MTRERR * GO TO DIAGNOSTIC AFTER 5 FAILURES. 4F10900
REM 4F10901
ZETA PZE DEL(A),,ENDADR-ORGA 4F10902
PZE DEL(D),,ENDADR-ORGD 4F10903
PZE DEL(B),,ENDADR-ORGB 4F10904
PZE DEL(C),,ENDADR-ORGC 4F10905
REM END OF PROGRAM MTR000. 4F10906
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10907
REM 4F10908
REM RA000,4/ CALLERS=LPR,ARITH. 4F10909
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 052/052 ------
REM RA000 COMPUTES RELATIVE ADDRESS. 4F10910
RA000 SXD RAXR4,4 SAVE THE C(XR4) FOR RETURN. 4F10911
STZ EPS CLEAR EPSILON (WORKING STORAGE). 4F10912
CLA DIMSAV EXAMINE THE 4F10913
ED2 PAX E+4,4 DIMENSION COUNT, AND 4F10914
TXL ED1,4,2 IF 3 DIMENSION, 4F10915
ADD L(1) INCREASE IT 1. 4F10916
ED1 ADM ED2 THEN SET 4F10917
STA ED3 ED3 ADDRESS TO 4F10918
ED3 CLA **,4 EXAMINE SUCCESSIVE 4F10919
LDQ D1 SUBSCRIPT 4F10920
TZE ED4 VARIABLES, AND 4F10921
STQ EPS ACCORDINGLY SET 4F10922
LDQ L(0) EPSILON AND 4F10923
ED4 STQ EPS,4 EPSILON SUB I 4F10924
TIX ED3,4,1 TO 1 OR TO 0. WHEN DONE, 4F10925
CLA D1 IF 1 DIMENSION, PICKUP DECREMENT1, 4F10926
LXA DIMSAV,4 AND GO SUBTRACT ADDEND 1. 4F10927
TXL 1D1,4,1 IF 2 OR 3 DIMENSION, THEN 4F10928
LDQ E+11 PICKUP ADDENDS 1 AND 2, 4F10929
STZ E+11 CLEAR E+11, AND 4F10930
SLQ E+11 RESTORE ADDEND 1 TO E+11. 4F10931
LGL 18 ADJUST AND PLACE 4F10932
STQ N2 ADDEND 2 IN N2. 4F10933
LDQ E+6 AND, IF 2 DIMENSION 4F10934
CLA EPS-1 PICKUP EPSILON SUB 1, 4F10935
TXL 2D1,4,2 AND GO SUBTRACT ADDEND 2. 4F10936
SUB E+12 IF 3 DIMENSION, SET GTAG 4F10937
STO GTAG TO EPSILON SUB 1 - ADDEND 3. 4F10938
LDQ E+8 PICKUP DIMESNIONS 1 AND 2. 4F10939
STZ E+8 CLEAR E+8, AND 4F10940
SLQ E+8 RESTORE DIMENSION 1 TO E+8. 4F10941
LGL 18 ADJUST, AND MULTIPLY 4F10942
MPY GTAG DIMENSION 2 TIMES GTAG. 4F10943
ALS 17 THEN ADD 4F10944
ADD EPS-2 EPSILON SUB 2 4F10945
LDQ E+8 TO THE PRODUCT, AND 4F10946
2D1 SUB N2 SUBTRACT ADDEND 2. 4F10947
STO GTAG MULTIPLY 4F10948
MPY GTAG THE RESULT 4F10949
ALS 17 TIMES 4F10950
ADD EPS,4 DIMENSION 1, AND ADD IN EPSILON 4F10951
ADD EPS SUB I AND EPSILON. 4F10952
1D1 SUB E+11 SUBTRACT ADDEND 1, 4F10953
STO GTAG AND PLACE THE RESULT 4F10954
CAL E IN THE DECREMENT OF GTAG, 4F10955
ARS 24 WITH 1-TAUTAG 4F10956
STA GTAG IN THE ADDRESS. 4F10957
LXD RAXR4,4 RESTORE THE C(XR4), AND 4F10958
TRA 1,4 * EXIT TO CALLER. 4F10959
REM END OF PROGRAM RAD00. 4F10960
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F10961
REM 4F10962
REM RDRX,4 CALLS=DIAG. CALLER=DRTABS. 4F10963
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 053/053 ------
REM RDRX READS A BLOCK FO DRUM ENTRIES INTO 50 WORD BUFR. 4F10964
RDRX LXA DRMERC,1 SET FOR 5 ATTEMPTS TO READ DRUM. 4F10965
REP LXD DI,2 SET XR2 * (5-DRUM NUMBER). 4F10966
TXH BIAS-2,2,0 IF NOT GREATER THEN ZERO. 4F10967
TSX DIAG,4 * GO TO DIAGNOSTIC. 4F10968
RDR 5,2 SELECT CURRENT DRUM. 4F10969
LXD FDA,2 SET XR2 = NO. OF WORDS TO COPY. 4F10970
BIAS PXD ETSUM,0 CLEAR THE AC. 4F10971
LDA FDA DRUM ORIGIN OF CURRENT BLOCK. 4F10972
JUMP1 TXL ** (ETSUM-2*L) TXL=ENTRY,TXH=BLOCK. 4F10973
CAD DUMP READ 4F10974
COM FLOCON BLOCK 4F10975
LBUF CAD BUFR,2 AND COMPUTE 4F10976
TIX LBUF,2,1 LOGICAL CHECKSUM. 4F10977
XR1 TXI PROVE,0,** GO TEST CHECKSUM. 4F10978
CPY BUFR,2 COPY LOOP 4F10979
TNX ERR,2,1 FOR ALL 4F10980
CPY BUFR,2 COPY LOOP 4F10981
TNX ERR,2,1 TABLES 4F10982
CPY BUFR,2 EXCEPT 4F10983
TNX ERR,2,1 FLOCON* 4F10984
CPY BUFR,2 X 4F10985
TNX ERR,2,1 X 4F10986
CPY BUFR,2 X 4F10987
TNX ERR,2,1 X 4F10988
CPY BUFR,2 X 4F10989
TNX ERR,2,1 X 4F10990
CPY BUFR,2 X 4F10991
NOP X 4F10992
ETSUM CAD DUMP SUM CHECKSUMS. 4F10993
JUMP2 TIX **,2,1 (ETSUM-2*L) TEST END OF BLOCK. 4F10994
RDRXCR LXD FDA,2 COMPUTE 4F10995
COM NEW 4F10996
ACL BUFR,2 LOGICAL 4F10997
TIX RDRXCR+2,2,1 CHECKSUM, AND 4F10998
PROVE COM IF CHECKSUMS COMPARE 4F10999
TZE 1,4 * RETURN TO MAIN ROUTINE. 4F11000
ERR TIX REP,1,1 OTHERWISE, REPEAT UP TO 5 TIMES. 4F11001
TSX DIAG,4 * FAILED 5 TIMES IN READING DRUM. 4F11002
REM END OF PROGRAM RDRX. 4F11003
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11004
REM 4F11005
REM SR6DC1,1/ CALLS=DIAG. CALLERS=CA000,SS000. 4F11006
REM SR6DC1 CONVERTS UP TO 6 BCD DIGITS TO THEIR BINARY EQUIV. 4F11007
SR6DC1 SXD SR6XR2,2 SAVE THE C(XR2), AND 4F11008
LXA L(6),2 SET TO COUNT 6 CHARACTERS. 4F11009
STZ SR6WRK INITIALIZE OUTPUT CELL TO 0. 4F11010
SR6DC2 PXD ,0 OBTAIN NEXT CHARACTER 4F11011
LGL 6 IN AC AND 4F11012
CAS ABLANK TEST FOR BLANK. 4F11013
SR6XR2 TXI SR6DC3,0,** IF NOT BLANK, 4F11014
ENDWRD TIX SR6DC4,0,-1 (DECR= END OF PROBLEM INDICATOR) 4F11015
SR6DC3 CAS L(9) TEST FOR NUMERIC. 4F11016
TSX DIAG,4 * IF NON-NUMERIC - GO TO DIAGNOSTIC. 4F11017
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 054/054 ------
NOP NOP IF NUMERIC, 4F11018
STO SR6WRK+1 SAVE DIGIT, AND 4F11019
CLA SR6WRK MULTIPLY PREVIOUS PARTIAL 4F11020
ALS 2 RESULT BY 10, 4F11021
ADD SR6WRK AND ADD IN 4F11022
ALS 1 CURRENT DIGIT, SAVING 4F11023
ADD SR6WRK+1 NEW PARTIAL RESULT. 4F11024
STO SR6WRK THEN ADJUST COUNT, AND 4F11025
SR6DC4 TIX SR6DC2,2,1 WHEN 6 CHARS HAVE BEEN TREATED, 4F11026
CLA SR6WRK LEAVE OUTPUT IN AC, 4F11027
LXD SR6XR2,2 RESTORE THE C(XR2), AND 4F11028
TRA TRA 1,1 * EXIT TO MAIN ROUTINE. 4F11029
REM END OF PROGRAM SR6DC1. 4F11030
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11031
REM 4F11032
REM SS000,4/ CALLS=C0190,DIAG,SR6DC1,DIM,SR,DRTABS,TET00,TESTFX. 4F11033
REM CALLERS=ARITH,LPR,C0200. 4F11034
REM SS000 SCANS SUBSCRIPT COMBINATIONS AND MAKES TABLE ENTRIES. 4F11035
SS000 SXD SXR2,2 SAVE C(XR2), 4F11036
SXD SXR1,1 SAVE C(XR1), 4F11037
SXD SXR4,4 SAVE C(XR4), AND 4F11038
STZ DIMCTR SET DIMCTR = 0. 4F11039
LXA L(6),4 INITIALIZE 4F11040
SXD SBS2,4 FOR EACH SUBSCRIPT MEMBER. 4F11041
CAL TXHOP PICK UP TXH OP, AND 4F11042
STP SBC6 SET OP 4F11043
STP SBC8 SWITCHES. 4F11044
CAL TXLOP PICK UP TXL OP, AND 4F11045
STP SBC4 SET OP SWITCH. 4F11046
SS001 LXA L(5),3 SET FOR 6 CHARACTERS OF MULTIPLIER.4F11047
STZ SYMBOL CLEAR WORKING STORAGE. 4F11048
TSX C0190,4 * GET FIRST NON BLANK CHAR IN THE AC.4F11049
CAS L(9) COMPARE IT WITH 9. 4F11050
TXI SS0045,0 RETURN TO EXPLICIT CODING. 4F11051
NOP IF NUMERIC, 4F11052
STO FIRSTC SAVE RIGHT-ADJUSTED DIGIT, AND 4F11053
SS0012 ALS 36,2 LEFT-ADJUST DIGIT TO 4F11054
ORS SYMBOL BUILD SYMBOL. 4F11055
TXI SS0013,2,6 UPDATE SHIFT DECREMENT, AND 4F11056
SS0013 TXI SS0014,1,-1 UPDATE COUNT OF CHARS COLLECTED. 4F11057
SS0014 TSX C0190,4 * GET NEXT NB CHARACTER IN THE AC. 4F11058
LXA CTESTX,4 SET XR4 = NO. OF PUNCTUATION MARKS.4F11059
SS0015 CAS CTEST,4 TEST THIS CHARACTER AGAINTT 4F11060
TXI SS0016,0 ALL PUNCTUATION. 4F11061
TRA SUBTR,4 IF EQUALITY IS FOUND, TRANSFER. 4F11062
SS0016 TIX SS0015,6,1 IF NOT FOUND TO BE PUNCTUATION, 4F11063
CAS L(9) TEST FOR NUMERIC 4F11064
TXI SS0017,0 AND IF 4F11065
CTESTX NOP CTEST-ENDMK FOUND TO BE NUMERIC 4F11066
TXH SS0012,1,0 CONTINUE BUILDING SYMBOL. BUT IF 4F11067
TXI STOP49,0 SEVENTH CHAR, GO TO DIAGNOSTIC. 4F11068
SS0017 TSX TESTFX+1,1 * GO TEST FOR FIXED POINT VARIABLE. 4F11069
TSX DIAG,4 * NOT FIXED POINT --GO TO DIAGNOSTIC.4F11070
LGL 30 RESTORE FIXED POINT VARIABLE 4F11071
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 055/055 ------
SLW RESIDU TO RESUDU, AND 4F11072
LXD CHCTR,4 RESET CHARACTER COUNTER 4F11073
TXI SS0018,4,1 TO BEGIN PROCESSING 4F11074
SS0018 SXD CHCTR,4 SUBSCRIPT MULTIPLIER. 4F11075
SBX CLS SBC6 TEST FOR 4F11076
TMI SBX1 PREVIOUS MULTIPLIER. 4F11077
TSX DIAG,4 * DOUBLE MULTIPLIER FOR SUBSCRIPT. 4F11078
SBX1 STO SBC6 RESET MULTIPLIER SWITCH. 4F11079
CLA FIRSTC TEST 4F11080
SUB L(10) MULTIPLIER 4F11081
TMI SBX2 FOR CONSTANT. 4F11082
TSX DIAG,4 * SUBS-MULTIPLER NOT A CONSTANT. 4F11083
SBX2 CLA SYMBOL ADJUST MULTIPLIER 4F11084
ARS 42,2 TO LOW ORDER POSITION. 4F11085
LXD SBS2,4 GET STORING TAG, 4F11086
SLW E+9,4 AND STORE MULTIPLIER. 4F11087
STZ E+15,4 SET ADDEND = 0. 4F11088
SS003 LXA L(6),3 SET FOR 6 CHARS OF VARIABLE/ADDEND.4F11089
STZ SYMBOL CLEAR WORKING STORAGE. 4F11090
SS004 TSX C0190,4 * GO GET NEXT NB CHARACTER IN THE AC.4F11091
SS0045 LXA CTESTX,4 COMPARE CHARACTER 4F11092
SS005 CAS CTEST,4 TO ALL 4F11093
TXI SS006,0 PUNCTUATION. 4F11094
TRA SUBTR,4 IF EQUALITY IS FOUND, TRANSFER. 4F11095
SS006 TIX SS005,4,1 IF NOT FOUND TO BE PUNCTUATION, 4F11096
TXL SS008,1,5 IF 1ST CHARACTER OF VARIABLE OR 4F11097
STO FIRSTC ADDEND, SAVE FOR LATER TEST. 4F11098
SS008 ALS 36,2 POSITION EACH CHARACTER. BUT 4F11099
SS009 TXL STOP49,1,0 * ON 7TH CHARACTER, GO TO STOP. 4F11100
ORS SYMBOL BUILD SYMBOL. 4F11101
TXI SS007,2,6 UPDATE EFFECTIVE ADDRESS OF SHIFT. 4F11102
SS007 TXI SS004,1,-1 UPDAT FOR ANOTHER CHAR COLLECTED. 4F11103
STOP49 TSX DIAG,4 * GO TO DIAGNOSTIC ON 7TH CHARACTER. 4F11104
REM SUBSTR/ CONTROL TRANSFERS FOR SUBSCRIPT SCAN= 4F11105
TXI ISC,0 ENK (ILLEGAL IN LIST SUBSCRIPT). 4F11106
ISC TSX DIAG,4 * ( (ILLEGAL IN LIST SUBSCRIPT). 4F11107
TXI SBC,0 , 4F11108
TXI SBR,0 ) 4F11109
TXI ISC,0 = (ILLEGAL IN LIST SUBSCRIPT). 4F11110
SBS2 TXI SBM,0,** - ,,SUBSCRIPT ELEMENT COUNTER, 4F11111
TXI ISC,0 / (ILLEGAL IN LIST SUBSCRIPT). 4F11112
SXR1 TXI ISC,0,** . (ILLEGAL IN LIST SUBSCRIPT). 4F11113
SXR2 TXI SBP,0,** + 4F11114
SXR4 TXI SBX,0,** * 4F11115
SUBTR BSS 0 INDEXING ADDRESS FOR ABOVE LIST. 4F11116
SBM SSM MINUS ADDEND. 4F11117
SBP CLM PLUS ADDEND. 4F11118
LXD SBS2,4 GET STORING TAG, AND 4F11119
STO E+15,4 STORE SIGN OF ADDEND. 4F11120
CLS SBC8 TEST SWITCH 4F11121
TMI SBP1 FOR PREVIOUS ADDEND. 4F11122
TSX DIAG,4 * DOUBLE ADDEND FOR SUBSCRIPT, 4F11123
SBP1 STO SBC8 RESET ADDEND SWITCH. 4F11124
TSX TESTFX,1 * GO TO TEST FOR FIXED POINT. 4F11125
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 056/056 ------
TSX DIAG,4 * NOT FIXED POINT --GO TO DIAGNOSTIC.4F11126
LXD SBS2,4 GET STORING TAG, AND 4F11127
CLS SBC6 TEST SWITCH 4F11128
TPL SBP2 FOR PREVIOUS MULTIPLIER. 4F11129
CLA L(1) IF NONE, 4F11130
STO E+9,4 SET MULTIPLIER 4F11131
TXI SBP4,0 TO 1, AND CONTINUE. 4F11132
SBC1 CLS SBC6 RESET MULTIPLIER 4F11133
SBP2 STO SBC6 OP SWITCH. 4F11134
SBP4 CAL SYMBOL IF VARIABLE SUBSCRIPT. 4F11135
TXH SBP41,2,36 ADD A BLANK 4F11136
CAL BLANK IF LESS 4F11137
ALS 36,2 THAN 6 4F11138
ORA SYMBOL CHARACTERS, AND 4F11139
SBP41 SLW E+10,4 PLACE IN E-REGION. 4F11140
TSX TESTFX,1 * GO TO TEST FOR FIXED POINT. 4F11141
TSX DIAG,4 * NOT FIXED POINT --GO TO DIAGNOSTIC.4F11142
CLA SBC8 IF THERE IS AN ADDEND, 4F11143
TMI SS003 GO COLLECT, OTHERWISE 4F11144
TXI SBC7,0 GO UPDATE STORING TAG. 4F11145
SBR CLS SBC4 SET SWITCH 4F11146
STO SBC4 FOR CLOSING PARENTHESIS. 4F11147
SBC CAL DIMCTR UPDATE 4F11148
ADD L(1) DIMENSION COUNTER 4F11149
STA DIMCTR BY 1. 4F11150
LXD SBS2,4 GET STORING TAG. 4F11151
SBC6 TXH SBC1,0 SWITCH-IF NO MULTIPLIER, AND 4F11152
SBC8 TXH SBC2,0 SWITCH-IF NO ADDEND, THEN 4F11153
CLA L(1) SET 4F11154
STO E+9,4 MULTIPLIER = 1. 4F11155
STZ E+15,4 SET ADDEND = 0. 4F11156
CLA FIRSTC TEST FOR 4F11157
SUB L(10) CONSTANT OR VARIABLE. 4F11158
TPL SBP4 IF CONSTANT, THEN 4F11159
STZ E+10,4 SET VARIABLE = 0. 4F11160
SBC9 CAL SYMBOL ADJUST 4F11161
ARS 42,2 CONSTANT 4F11162
ORS E+15,4 TO LOW ORDER POSITION. 4F11163
SBC7 TNX SBC3,4,2 UPDATE STORING TAG 4F11164
SXD SBS2,4 BY -2, AND SAVE. 4F11165
SBC4 TXL SS001,0 SWITCH-REPEAT FOR NEXT SUB-COMB. 4F11166
TXI SA000,0 GO MAKE TABLE ENTRIES AND GET TAG. 4F11167
SBC2 CLS SBC8 RESET ADDEND 4F11168
STO SBC8 OP SWITCH. 4F11169
CLS L(10) TEST 4F11170
ADD FIRSTC ADDEND 4F11171
TMI SBC9 FOR CONSTANT. 4F11172
TSX DIAG,4 * SUBSCRIPT ADDEND NOT A CONSTANT. 4F11173
SBC3 CLS SBC4 AFTER SCANNING 3 SUBSCRIPTS. 4F11174
TMI SA000 GO MAKE TABLE ENTRIES AND GET TAG. 4F11175
TSX DIAG,4 * GO TO DIAG - NO ) AFTER 3RD SUBS. 4F11176
REM CSA000= ENTRY POINT USED BY C0200 (GO TO ROUTINE). 4F11177
CSA000 SXD SXR4,4 SAVE C(XR4) FOR RETURN TO C0200. 4F11178
SA000 CLA DIMCTR SAVE 4F11179
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 057/057 ------
STO DIMSAV THE CONTENTS OF DIMCTR 4F11180
ALS 33 POSITION AND 4F11181
STO E STORE I TAG. 4F11182
CLA E+11 MOVE SUBSCRIPT ADDENDS 4F11183
STO E+12 INTO POSITION 4F11184
CLA E+9 FOR FOLLOWING 4F11185
STO E+11 PROGRAM. 4F11186
CLA L(2) EXAMINE DIMCTR 4F11187
CAS DIMCTR TO DETERMINE 4F11188
TXI 1D0000,0 WHETHER DIMESNION OF 4F11189
TXI 2D0000,0 VARIABLE IS 1, 2, OR 3. 4F11190
3D0000 LXA L(6),4 PREPARE TO PICK UP 3 COEFFICIENTS. 4F11191
3D0001 LDQ E+9,4 CONVERT THEM FROM BCD TO BINARY 4F11192
TSX SR6DC1,1 * IN E+3,5,7, AND 4F11193
STO E+9,4 STORE BACK IN E+3,5,7, 4F11194
TIX 3D0001,4,2 WHEN DONE, PREPARE 4F11195
LXA L(3),4 TO PICK UP 3 ADDENDS. 4F11196
3D0002 CLA E+14,4 CONVERT ADDENS (BCD TO BINARY)= 4F11197
SLW G STRIP OFF 4F11198
LDQ G SIGN. 4F11199
TSX SR6DC1,1 * CONVERT ADDENDS IN E+11,12,13, 4F11200
LDQ E+14,4 PUT SIGN IN S-BIT OF MQ, AND 4F11201
TQP 3D0040 IF PLUS--SKIP NEXT, 4F11202
ORA 2E17 IF MINUS--OR SIGN INTO BIT 18, 4F11203
3D0040 STO E+14,4 AND STORE BACK INTO E+11,12,13, 4F11204
TIX 3D0002,4,1 WHEN DONE, 4F11205
TSX DIM3SR,4 * GO SEARCH DIM3 TABLE, 4F11206
TSX DIAG,4 * --ERROR...NOT ON DRUM, 4F11207
3D0060 CLA E+3 REFORMATIZE E-STRING = 4F11208
ALS 18 PACK TOGETHER COEFFICIENTS 1 AND 2 4F11209
ADD E+5 AND STORE THEM 4F11210
STO E+3 IN E+3. 4F11211
CLA E+4 MOVE SUBSCRIPT 1 4F11212
STO E+5 TO E+5. 4F11213
CLA E+7 AND MOVE 4F11214
ALS 18 COEFFICIENT 3 4F11215
STO E+4 INTO E+4. 4F11216
CLA E+8 MOVE SUBSCRIPT 3 INTO E+7, 4F11217
STO E+7 NEXT SUBSCRIPT 2 IN E+6. 4F11218
CLA D12 MOVE DIMESIONS 1 AND 2 4F11219
STO E+8 INTO E+8. 4F11220
CAL E+11 PACK TOGETHER 4F11221
ALS 18 ADDENDS 1 AND 2 4F11222
ORA E+12 AND 4F11223
SLW E+11 STORE THEM IN E+11. 4F11224
CAL E+13 MOVE 4F11225
ALS 18 ADDEND 3 4F11226
SLW E+12 INTO E+12. 4F11227
TSX TAU3IX,4 * GO SEARCH TAU3 TABLE. 4F11228
ALS 24 POSITION TAU3 TAG, AND 4F11229
ORS E PLACE TAU3 TAG IN TAG WORD. 4F11230
CAL E+7 COMBINE 4F11231
ORA E+6 SUBSCRIPTS 3,2, AND 1, 4F11232
3D0340 ORA E+5 AND IF THEY ARE ALL ZERO, 4F11233
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 058/058 ------
3D0350 TZE NOTAG --DON,T ENTER FORTAG. 4F11234
FTG000 CLA EIFNO ENTER FORTAG= 4F11235
ANA MASK1 BRING UP ALPHA (INTFORMNO) 4F11236
SLW G AND STORE IN G. 4F11237
CAL E BRING UP TAUTAG FOR I, 4F11238
ARS 24 ADJUST, AND 4F11239
ORS G PLACE IN G WITH ALPHA. THEN 4F11230
TSX TET00,1 * ENTER INTO FORTAG TABLE 4F11240
PZE 4 (TET TABLE 4). 4F11241
TXI SAEXIT,0 GO TO EXIT. 4F11242
2D0000 LXA L(4),4 THEN PICKUP AND 4F11243
2D0001 LDQ E+7,4 CONVERT COEFFICIENTS 4F11244
TSX SR6DC1,1 * (BCD TO BINARY), 4F11245
STO E+7,4 AND STORE BACK IN E+3 AND E+5, 4F11246
TIX 2D0001,4,2 WHEN DONE, 4F11247
LXA L(2),4 PREPARE TO 4F11248
2D0002 CLA E+13,4 PICKUP THE TWO ADDENDS. 4F11249
SLW G STRIP OFF 4F11250
LDQ G THEIR SIGNS, 4F11251
TSX SR6DC1,1 * CONVERT THEM FROM BCD TO BINARY, 4F11252
LDQ E+13,4 PUT SIGN IN S-BIT OF MQ, AND 4F11253
TQP 2D0040 IF PLUS--SKIP NEXT, 4F11254
ORA 2E17 IF MINUS--OR SIGN INTO BIT 18, 4F11255
2D0040 STO E+11,4 AND STORE BACK IN E+11 AND E+12. 4F11256
TIX 2D0002,4,1 WHEN DONE, 4F11257
TSX DIM2SR,4 * GO SEARCH DIM2 TABLE. 4F11258
TSX DIAG,4 * --ERROR...NOT ON DRUM. 4F11259
2D0060 CLA E+3 REFORMATIZE E-STRING = 4F11260
ALS 18 PACK TOGETHER 4F11261
ADD E+5 COEFFICENTS 1 AND 2, 4F11262
STO E+3 AND STORE THEM IN E+3, 4F11263
CLA E+6 MOVE SUBSCRIPT 2 INTO E+5 4F11264
STO E+5 (NEXT TO SUBSCRIPT 1 IN E+4), 4F11265
CLA D12 OBTAIN 4F11266
ANA MASK1 DIMENSION 1, AND MOVE IT 4F11267
STO E+6 INTO E+6. 4F11268
CAL E+11 PACK TOGETHER 4F11269
ALS 18 ADDENDS 1 AND 2, 4F11270
ORA E+12 AND STORE THEM 4F11271
SLW E+11 IN E+11. 4F11272
TSX TAU2IX,4 * GO SEATCH TAU2 TABLE. 4F11273
ALS 24 POSITION TAU2 TAG, AND 4F11274
ORS E PLACE TAU2 TAG IN TAG WORD. 4F11275
CAL E+4 COMBINE SUBSCRIPTS 1 AND 2, AND 4F11276
TXI 3D0340,0 GO TO FORTAG SECTION. 4F11277
1D0000 LDQ E+3 PICKUP AND CONVERT COEFFICIENTS 4F11278
TSX SR6DC1,1 * (BCD TO BINARY), AND 4F11279
ALS 18 THEN ADJUST THEM, 4F11280
STO E+3 AND STORE THEM BACK IN E+3. 4F11281
CLA E+11 PICKUP ADDEND, 4F11282
SLW G STRIP OFF SIGN, 4F11283
LDQ G CONVERT ADDEND 4F11284
TSX SR6DC1,1 * (BCD TO BINARY), AND THEN 4F11285
LDQ E+11 PUT SIGN IN S-BIT OF MQ, 4F11286
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 059/059 ------
TQP 1D0001 IF PLUS--SKIP NEXT, 4F11287
ORA 2E17 IF MINUS--OR SIGN INTO BIT 18. 4F11288
1D0001 ALS 18 THEN ADJUST AND STORE 4F11289
SLW E+11 BACK INTO E+11. 4F11290
TSX TAU1IX,4 * GO SEARCH TAU1 TABLE. 4F11291
ALS 24 POSITION TAU1 TAG, AND 4F11292
ORS E PLACE TAU1 TAG IN TAG WORD. 4F11293
CAL E+4 TAKE SUBSCRIPT, AND 4F11294
TXI 3D0350,0 GO TO FORTAG SECTION. 4F11295
NOTAG CAL FNIND POSITION SIGMA1 TAG, AND 4F11296
ORS E PLACE SIGMA1 TAG IN TAGE WORD. 4F11297
SAEXIT LXD SXR1,1 RESTORE THE C(XR1) 4F11298
LXD SXR2,2 RESTORE THE C(XR2) 4F11299
LXD SXR4,4 RESTORE THE C(XR4) 4F11300
TRA 1,4 * EXIT TO MAIN ROUTINE. 4F11301
REM END OF PROGRAM SS000. 4F11302
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11303
REM 4F11304
REM SUBX00,4/ CALLERS=C3000,C3300. 4F11305
REM SUBX00 ADDS BLANKS TO THE NAMES OF SUBROUTINES. 4F11306
SUBX00 LXA L(6),3 PREPARE TO COUNT CHARS AND SHIFTS. 4F11307
LDQ 1G PICKUP SUBROUTINE NAME. 4F11308
SUBX01 PXD ,0 CLEAR THE AC, AND 4F11309
LGL 6 SEARCH FOR A BLANK 4F11310
SUB BLANK CHARACTER IN THIS NAME. 4F11311
TZE SUBX03 IF NOT BLANK, THEN 4F11312
TXI SUBX02,1,6 UPDATE SHIFT COUNT, AND 4F11313
SUBX02 TIX SUBX01,2,1 CONTINUE UNTIL 6 CHARS ARE COUNTED.4F11314
TRA 1,4 * RETURN TO CALLER AFTER 6TH CHAR. 4F11315
SUBX03 LDQ BLANKS IF LESS THEN 6 CHARACTERRS IN NAME,4F11316
LGL 36,1 SHIFT ENOUGH BLANKS INTO THE AC, 4F11317
ORS 1G AND FILL OUT NAME WITH BLANKS. 4F11318
TRA 1,4 * RETURN TO CALLER. 4F11319
REM END OF PROGRAM SUBX00. 4F11320
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11321
REM 4F11322
REM TESTFX,1/ CALLERS=SS000,C3000,IFFIX. 4F11323
REM TESTFX TEST FOR FIXED OR FLOATING POINT VARIABLES. 4F11324
TESTFX CAL FIRSTC COMPARE FIRST CHARACTER 4F11325
CAS L(H) WITH H. 4F11326
CAS L(O) IF GREATER THEN H, COMPARE WITH O. 4F11327
TRA 1,1 * IF NOT GREATER THEN H, LESS THEN O,4F11328
TRA 1,1 * THEN TAKE FLOATING POINT EXIT. 4F11329
TRA 2,1 * OTHERWISE, TAKE FIXED POINT EXIT. 4F11330
REM END OF PROGRAM TESTFX. 4F11331
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11332
REM 4F11333
REM TEST..,4/ CALLS=DIAG. CALLERS=C0100,C0200,C0300,C0400,C1000, 4F11334
REM C1100,C1200,C1400,C1500,C1600,C3000,C3100,C3200,C3400,LPR. 4F11335
REM TEST.. TESTS THE CHARACTER IN THE AC(30-35). 4F11336
REM TEST CHARACTER IN THE AC FOR COMMA OR ENDMARK. 4F11337
TESTA0 CAS COMMA 4F11338
TRA TESTA1 4F11339
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 060/060 ------
TRA 1,4 * RETURN TO CALLER. 4F11340
TESTA1 SUB ENDMK 4F11341
TZE 1,4 * RETURN TO CALLER. 4F11342
TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11343
REM TEST CHARACTER IN THE AC FOR COMMA OR CLOSED PARENTHESIS. 4F11344
TESTB0 CAS COMMA 4F11345
TRA TESTB1 4F11346
TRA 1,4 * RETURN TO CALLER. 4F11347
TESTB1 SUB CLOS 4F11348
TZE 1,4 * RETURN TO CALLER. 4F11349
TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11350
REM TEST CHARACTER IN THE AC FOR OPEN PARENTHESIS OR ENDMARK. 4F11351
TESTC0 CAS OPEN 4F11352
TRA TESTC1 4F11353
TRA 1,4 * RETURN TO CALLER. 4F11354
TESTC1 SUB ENDMK 4F11355
TZE 1,4 * RETURN TO CALLER. 4F11356
TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11357
REM TEST CHARACTER IN THE AC FOR ENDMARK. 4F11358
TESTD0 CAS ENDMK 4F11359
ERR77P TSX DIAG,4 * MACHINE ERROR, GO TO DIAGNOSTIC. 4F11360
TRA 1,4 * RETURN TO CALLER. 4F11361
TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11362
REM TEST CHARACTER IN THE AC FOR OPEN PARENTHESIS. 4F11363
TESTE0 CAS OPEN 4F11364
TRA TESTE1 4F11365
TRA 1,4 * RETURN TO CALLER. 4F11366
TESTE1 TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11367
REM TEST CHARACTER IN THE AC FOR CLOSED PARENTHESIS. 4F11368
TESTF0 CAS CLOS 4F11369
TRA TESTF1 4F11370
TRA 1,4 * RETURN TO CALLER. 4F11371
TESTF1 TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11372
REM TEST CHARACTER IN THE AC FOR COMMA. 4F11373
TESTG0 CAS COMMA 4F11374
TRA TESTG1 4F11375
TRA 1,4 * RETURN TO CALLER. 4F11376
TESTG1 TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11377
REM TEST CHARACTER IN THE AC FOR NON-NUMERIC. 4F11378
TESTH0 CAS L(9) 4F11379
TRA 1,4 * RETURN TO CALLER. 4F11380
NOP 4F11381
TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11382
REM TEST CHARACTER IN THE AC FOR NUMERIC. 4F11383
TESTI0 CAS L(9) 4F11384
TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11385
TRA 1,4 * RETURN TO CALLER. 4F11386
TRA 1,4 * RETURN TO CALLER. 4F11387
REM END OF PROGRAM TEST... 4F11388
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11389
REM 4F11390
REM TET00,1/ CALLERS=CA000,CC000,C0100,C0200,C0300,C1300,C1400, 4F11391
REM C1500,C3000,C3100,SS000,FOR,SPC,CMA,EMK,LIB,VRA(VRD). 4F11392
REM TET00 MAKES ENTRIES IN THE TAPE TABLES. WHEN A BUFFER IS 4F11393
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 061/061 ------
REM FULL IT IS WRITTEN AS A RECORD ONTO TAPE 4. 4F11394
TET00 SXD TETXR2,2 SAVE THE C(XR2), 4F11395
SXD TETXR4,4 SAVE THE C(XR4), AND 4F11396
STQ TETMQR SAVE THE C(MQR). 4F11397
CLA 1,1 COMPUTE TABLE NUMBER 4F11398
ALS 1 TIMES 3 4F11399
ADD 1,1 AND 4F11400
COM PLACE THE 2S COMPLEMENT 4F11401
ADD L(1) OF THIS 4F11402
PAX 0,2 IN XR2 4F11403
CLA INTET,2 OBTAIN THE CURRENT 4F11404
ARS 18 B (BUFFER CAPACITY), 4F11405
STO TETWRK AND SAVE IT. THEN 4F11406
CLA INTET+2,2 GET P (PORTION OF BUFFER FULL), 4F11407
ARS 18 AND 4F11408
SUB TETWRK COMPARE TO B. 4F11409
TNZ TET03 IF BUFFER IS FULL, 4F11410
STD INTET+2,2 SET P = 0, AND 4F11411
TET01 WRS TABTAP PREPARE TO WRITE BLOCK ON TABTAP. 4F11412
LXA TETWRK,4 SET XR4 = BLOCK SIZE (B). 4F11413
CLA TETWRK ADD BLOCK SIZE TO 4F11414
ADD INTET,2 ORGIN OF CURRENT BLOCK (O). 4F11415
STA TET02 AND SET ADDRESS OF COPY LOOP (O+B).4F11416
CPY 1,1 COPY TABLE NUM FOR IDENTIFICATION. 4F11417
TET02 CPY **,4 WRITE BLOCK ONTO 4F11418
TIX TET02,4,1 TABLE TAPE, AND 4F11419
IOD WHEN DONE, 4F11420
CLA INTET+2,2 INCREASE C (BLOCK COUNT) 4F11421
ADD L(1) BY 1 FOR 4F11422
STA INTET+2,2 BLOCK JUST WRITTEN ON TABLE TAPE. 4F11423
TET03 CLA INTET+2,2 ADD P (PORTION OF BUFFER FULL) 4F11424
ARS 18 TO O (ORIGIN OF CURRENT TABLE 4F11425
ADD INTET,2 BUFFER) TO SET 4F11426
STA TET05 ADDRESS OF ENTRY LOOP (P+O). 4F11427
CLA INTET+1,2 OBTAIN CURRENT A (ENTRY ADDRESS), 4F11428
STA TET04 AND SET ADDRESS OF ENTRY LOOP. 4F11429
PDX ,4 SET XR4 = E (ENTRY LENGTH IN WRDS).4F11430
ADD INTET+2,2 INCREASE P BY E TO ACCOUNT 4F11431
STD INTET+2,2 FOR FOLLOWING ENTRY. 4F11432
LXD L(0),2 SET XR2 = 0. THEN 4F11433
TET04 CLA **,2 MOVE THE CURRENT ENTRY 4F11434
TET05 STO **,2 INTO THE CURRENT TABLE BUFFER, AND 4F11435
TXI TET06,2,-1 WHEN 4F11436
TET06 TIX TET04,4,1 DONE, 4F11437
LDQ TETMQR RESTORE ORIGINAL C(MQR), 4F11438
LXD TETXR2,2 RESTORE ORIGINAL C(XR2), 4F11439
LXD TETXR4,4 RESTORE ORIGINAL C(XR4), AND 4F11440
TRA 2,1 * EXIT TO MAIN ROUTINE. 4F11441
REM END OF PROGRAM TET00. 4F11442
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11443
REM 4F11444
REM DIAGNOSTIC CALLERS=CD000,CB000,CC000,CA100,C0200,C0300,C090, 4F11445
REM C1000,C1200,C3000,C3100,C3200,C3400,C0150,C0160,C0180,TEST..,4F11446
REM SR6DC1,DRTABS,RDRX,DIM.SR,SS000,ROYCNV,RDC,RSC,LPR,EQS,RPR, 4F11447
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 062/062 ------
REM CMA,EMK,BEG(TYP),VRA(VRD). 4F11448
REM (CA000 ALSO CALLS THE DIAGNOSTIC AFTER ALL STATEMENTS HAVE 4F11449
REM BEEN PROCESSES. IF THERE HAVE BEEN NO PREVIOUS CALLS TO 4F11450
REM THE DIAGNOSTIC DURING SECTION ONE, THEN 1PRIME IS CALLED.) 4F11451
DIAG TXI 4,0 * GO GET THE DIAGNOSTIC. 4F11452
REM END OF PROGRAM DIAG. 4F11453
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11454
REM 4F11455
REM ROUTINE TO COMPILE FLOW TRACING INSTRUCTIONS. 4F11456
FLTR00 SXD FLTR05,4 SAVE CALLING TAG. 4F114571
CLA EIFNO GET LAST INTERNAL AND EXTERNAL FORMULA NOS.4F114572
STA ENT PLACE LAST EFN IN DEC OF NTR INSTRUCTION. 4F114573
ARS 18 4F114574
STA NZE PLACE LAST IFN IN DEC OF PZE 4F114575
LXD ARGCTR,4 4F114576
TXL FLTR01,4,0 IS THIS AN FN FUNCTION, NO SKIP. 4F114577
STZ 1C+2 4F114578
CLS 2E18 SET ADDRESS TO -1 4F114579
TRA FLTR03 4F11457A
FLTR01 CLA SBDFCN IS THIS A MAIN PROGRAM OR SUBPROGRAM. 4F11457B
TNZ FLTR02 SKIP ON SUBPROGRAM 4F11457C
STZ 1C+2 SET ADDRESS TO 0 4F11457D
STZ 1C+3 4F11457E
TRA FLTR04 4F11457F
FLTR02 CLA DOLSGN SET ADDRESS TO $+2 4F11457G
STO 1C+2 4F11457H
CLA D2 4F11457I
FLTR03 STO 1C+3 SET RELATIVE ADDRESS WORD OF CIT. 4F11457J
FLTR04 TSX CIT00,4 4F11457K
PZE L(0) COMPILE NTR *+2,0,EFN 4F11457L
PZE ENT 4F11457M
PZE 15P 4F11457N
PZE D2 4F11457O
TSX CIT00,4 4F11457P
PZE L(0) COMPILE PZE ALPHA,0,IFN 4F11457Q
PZE NZE WHERE ALPHA IS 0 FOR MAIN PROGRAM, $+2 FOR 4F11457R
PZE 1C+2 SUBPROGRAM, OR -1 FOR FN FUNCTION IN EITHER4F11457S
PZE 1C+3 MAIN OR SUBPROGRAM. 4F11457T
LXD FLTR05,4 4F11457U
FLTR05 TXI CIT00,4 GO COMPILE LXD M(,4 OR 7(TYPE=,4 4F11457V
REM 4F11457W
REM 4F11458
REM END OF THE COMMON PART OF SECTION ONE. 4F11459
REM 4F11460
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11461
REM 4F11462
REM SECTION 1 / INITIALIZATION = 4F11463
REM 704 FORTRAN MASTER RECORD CARD / INITIZLIZATION = F0150000. 4F11464
ORG 0 4F114641
PZE FORSUB,,1TOCS 4F114642
PZE DMWR98 4F114643
ORG FORSUB 4F11465
REM INITIALIZATION OCCUPIES FORSUB BUFFER AND IS WRITTEN OVER 4F11466
REM BY FORSUB ENTRIES IF THERE ARE ANY FORTRAN FUNCTIONS IN THE 4F11467
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 063/063 ------
REM PROGRAM. 4F11468
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11469
REM 4F11470
REM PART I / CLEAR DRUMS 1,2,3,4, AND REWIND TAPES 2,3,4 = 4F11471
CLDR00 LXA CLDR07,1 CLEAR DRUMS 1,2,3,4 TO +0. 4F11472
CLDR01 WRS 197,1 X 4F11473
LXD CLDR07,2 X 4F11474
CLDR03 CPY CLDR08 X 4F11475
TIX CLDR03,2,1 X 4F11476
TIX CLDR01,1,1 X 4F11477
REW 146 REWIND WORKING TAPES 2,3,4. 4F11478
REW 147 X 4F11479
REW 148 X 4F11480
REM END OF INITIALIZATION / PART 1. 4F11481
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11482
REM 4F11483
REM PART 2 / WRITE STATES A,B,C,D ON DRUMS1,3,4,2= 4F11484
DMWR01 LXA L(3),4 PREPARE TO WRITE STATE D ON DRUM 2.4F11485
TRA DMWR11 X 4F11486
DMWR03 LXA L(1),4 PREPARE TO WRITE STATE C ON DRUM 4.4F11487
TRA DMWR11 X 4F11488
DMWR06 LXA L(2),4 PREPARE TO WRITE STATE B ON DRUM 3.4F11489
TRA DMWR11 X 4F11490
DMWR09 LXA L(4),4 PREPARE TO WRITE STATE A ON DRUM 1.4F11491
CLA DMWR98 THIS IS FINAL STATE TO BE WRITTEN, 4F11492
STA DMWR40 CHANGE ADDRESS TO GET OUT OF LOOP. 4F11493
DMWR11 CLA ZETA+4,4 GET LENGTH OF CURRENT STATE. 4F11494
PDX ,2 LENGTH OF CURRENT STATE. 4F11495
SXD CHECK,2 SAVE LENGTH. 4F11496
ARS 18 LENGTH + ORIGIN TO PREPARE FOR CK 4F11497
ADD MTR3 SUM AND COPY LOOPS. 4F11498
STA DMWR20 X 4F11499
STA DMWR26 X 4F11500
PXD ,0 CLEAR AC AND COMPUTE CK SUM. 4F11501
DMWR20 ACL **,2 X 4F11502
TIX DMWR20,2,1 X 4F11503
SLW DRCKSM X 4F11504
LXA DRMERC,1 SET FOR FIVE ATTEMPTS. 4F11505
DMWR23 WDR 5,4 PREPARE TO WRITE DRUM. 4F11506
LXD CHECK,2 X 4F11507
LDA ZETA+4,4 X 4F11508
CPY DRCKSM WRITE CK SUM ON DRUM. 4F11509
DMWR26 CPY **,2 WRITE STATE ON DRUM. 4F11510
TIX DMWR26,2,1 X 4F11511
RDR 5,4 PREPARE TO READ STATE BACK. 4F11512
LXD CHECK,2 X 4F11513
LDA ZETA+4,4 X 4F11514
PXD ,0 CLEAR AC AND READ BACK CK SUM AND 4F11515
CAD GARBGE STATE. 4F11516
COM X 4F11517
DMWR32 CAD GARBGE RECOMPUTE CK SUM. 4F11518
TIX DMWR32,2,1 X 4F11519
COM X 4F11520
DMWR40 TZE 1TOCS * CK SUM AGREE, GO GET NEXT STATE. 4F11521
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 064/064 ------
TIX DMWR23,1,1 CK SUM FAILED, TRY UP TO 5 TIMES. 4F11522
CLA DMWR89 SET MONITOR TO RETURN TO THIS 4F11523
STO STATEA PROGRAM INSTEAD OF TO STATE A. 4F11524
TXL DMWR80,4,3 TEST FOR STATE A IN PROGRESS. 4F11525
TSX DIAG,4 * STATE A CANNOT BE WRITTEN ON DRUM1.4F11526
DMWR80 TXL DMWR82,4,2 TEST FOR STATE D IN PROGRESS. 4F11527
RTB 1 SPACE OVER STATE C RECORD. 4F11528
RTB 1 SPACE OVER STATE B RECORD. 4F11529
RTB 1 SPACE OVER STATE A RECORD. 4F11530
TSX DIAG,4 * STATE D CANNOT BE WRITTEN ON DRUM2.4F11531
DMWR82 TXL DMWR84,4,1 TEST FOR SET B IN PROGRESS. 4F11532
RTB 1 SPACE OVER STATE A RECORD. 4F11533
TSX DIAG,4 * STATE B CANNOT BE WRITTEN ON DRUM3.4F11534
DMWR84 RTB 1 SPACE OVER STATE B RECORD. 4F11535
RTB 1 SPACE OVER STATE A RECORD. 4F11536
TSX DIAG,4 * STATE C CANNOT BE WRITTEN ON DRUM4.4F11537
DMWR88 LXA L(0),4 SET IR4 TO 0 TO CAUSE DIAGNOSTIC TO4F11538
TRA DIAG * PRINT END LINE AND STOP 4F11539
DMWR99 TSX CA100,4 * GO TO SUBROUTINE TO LOAD FT REGION.4F11540
TRA CA010 * GO BEGIN STATE A OF SECTION ONE. 4F11541
REM END OF INITIALIZATION / PART 2. 4F11542
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11543
REM 4F11544
REM PART3 / VARIABLES AND CONSTANTS USED BY INITIALIZATION= 4F11545
GARBGE BSS 1 ERASEABLE STORAGE. 4F11546
CHECK PZE ,,** SAVING CELL FOR LENGTH OF STATE. 4F11547
CLDR07 PZE 4,,2048 CONSTANT FOR CLEARING DRUMS. 4F11548
CLDR08 PZE 0 CONSTANT FOR CLEARING DRUMS. 4F11549
DMWR89 TRA DMWR88 CONSTANT FOR ERROR ROUTINE. 4F11550
DMWR98 PZE DMWR99 CONSTANT FOR ADDRESS MODIFICATION. 4F11551
REM END OF INITIALIZATION / PART 3. 4F11552
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11553
REM 4F11554
REM 4F11555
REM SECTION 1 / STATEA = 4F11556
REM 704 FORTRAN MASTER RECORD CARD / STATE A = F0190000. 4F11557
ORG 0 4F115571
PZE ORGA,,DMWR09 4F115572
PZE ENDA-1 4F115573
REM 4F11558
REM NAME FUNCTION 4F11559
REM PART 1 / ASSEMBLE AND CLASSIFY ALL STATEMENTS= 4F11560
REM CA000 ASSEMBLE STATEMENT. 4F11561
REM CD000 SCAN FOR HOLLERITH AND ILLEGAL CHS.4F11562
REM CB000 CLASSIFY=ARITHMETIC/NON-ARITHMETIC.4F11563
REM CC000 CLASSIFY=WHICH NON-ARITHMETIC. 4F11564
REM PART 2 / PROCESS CONTROL AND SPECIFICATION STATEMENTS. 4F11565
REM C0100 DO. 4F11566
REM C0200 GO TO. 4F11567
REM C0300 IF. 4F11568
REM C0400 IF (SENSE SWITCH. 4F11569
REM C0500 IF (SENSE LIGHT. 4F11570
REM C0600 IF DIVIDE CHECK. 4F11571
REM C0700 IF AC OVERFLOW. 4F11572
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 065/065 ------
REM C0800 IF MQ OVERFLOW. 4F11573
REM C0900 PAUSE. 4F11574
REM C1000 ASSIGN. 4F11575
REM C1100 SENSE LIGHT. 4F11576
REM C1200 DIMENSION. 4F11577
REM C1300 STOP. 4F11578
REM C1400 FREQUENCY. 4F11579
REM C1500 EQUIVALENCE. 4F11580
REM C1600 CONTINUE. 4F11581
REM C3000(C3500) SUBROUTINE / FUNCTION. 4F11582
REM C3100 COMMON. 4F11583
REM C3200 RETURN. 4F11584
REM C3300 CALL. 4F11585
REM C3400 END. 4F11586
REM PART 3 / PROCESS INPUT-OUTPUT STATEMENTS= 4F11587
REM RDC READ CARD 4F11588
REM RIT READ INPUT TAPE. 4F11589
REM RDP PRINT. 4F11590
REM WOT WRITE OUTPUT TAPE. 4F11591
REM PDC PUNCH. 4F11592
REM WBT WRITE TAPE. 4F11593
REM RBT READ TAPE. 4F11594
REM WRD WRITE DRUM. 4F11595
REM RDD READ DRUM. 4F11596
REM EFT END FILE. 4F11597
REM RWN REWIND. 4F11598
REM BSP BACKSPACE. 4F11599
REM FOR FORMAT. 4F11600
REM RSC RESET AND SCAN. 4F11601
REM LISTR CONTROL FOR LIST SCAN. 4F11602
REM LPR LEFT PARENTHESES IN LIST SCAN. 4F11603
REM EOS EQUAL SIGN IN LIST SCAN. 4F11604
REM SPCTR CONTROL FOR SPECIFICATION SCAN. 4F11605
REM SPC SUBSCRIPT SPECIFICATIONS. 4F11606
REM RPR RIGHT PARENTHESIS IN LIST SCAN. 4F11607
REM CMA COMMA IN LIST SCAN. 4F11608
REM EMK ENDMARK IN LIST SCAN. 4F11609
REM PART 4 / SUBROUTINES USED BY STATE A= 4F11610
REM BEG(TYP),4 BEGIN SCAN AND TYPE TEST. 4F11611
REM BEGTR CONTROL FOR BEGINNING SCAN. 4F11612
REM BRW,4 BINARY READ OR WRITE COMPILER. 4F11613
REM BSS,2 COMPILES= IFN BSS 0. 4F11614
REM CA100,4 READ SOURCE PROGRAM TAPE. 4F11615
REM CC500,4 SCAN DICTIONARY. 4F11616
REM ETM(LTM)SW,4 IF SW=NOP, COMPILES ETM(LTM). SL=0.4F11617
REM IFFIX,1 SETS UP FORVAR OR FORVAL ENTRY. 4F11618
REM IN(OUT)PUT,2 COMPILES CAL *, AND XIT (LEV). 4F11619
REM LIB,1 MAKES CLOSUB ENTRY, COMPILES CIT. 4F11620
REM VRA(VRD),4 MAKES FORVAR, FIXCON, CIT ENTRIES. 4F11621
REM PART 5 / CONSTANTS AND VARIABLES USED BY STATE A. 4F11622
REM DIC DICTIONARY. 4F11623
REM T TRANSFER TABLE. 4F11624
REM 4F11625
REM THE FOLLOWING CONVENTIONS ARE USED IN THIS LISTING= 4F11626
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 066/066 ------
REM 4F11627
REM ** IN ADDRESS, TAG, OR DECREMENT OF AN INSTRUCTION 4F11628
REM INDICATES THAT THIS FIELD WILL BE MODIFIED BY THE PROGRAM. 4F11629
REM * IN COL/36 INDICATES THE INSTRUCTION IS A TRANSFER OUT OF 4F11630
REM THIS LOGICAL BLOCK OR SUBROUTINE. 4F11631
REM C IN COL/34 INDICATES THE INSTRUCTION WAS CORRECTED. 4F11632
REM P IN COL/32 INDICATES THE INSTRUCTION WAS INSERTED (PATCH). 4F11633
REM 4F11634
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11635
REM 4F11636
REM STATEA/1-ASSEMBLE AND CLASSIFY ALL STATEMENTS= 4F11637
ORGA ORG 1824 4F11638
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11639
REM 4F11640
REM CA000/ CALLS=CA100,SR6DC1,TET00,DIAG. 4F11641
REM CA000 ASSEMBLES STATEMENT IN THE F-REGION AND ASSIGNS AN IFN.4F11642
CA010 LXD ENDWRD,4 IF THE FINAL STATEMENT HAS BEEN 4F11643
TXL DIAG,4,0 * PROCESSED, THE GO CALL DIAGNOSTIC. 4F11644
LXD EIFNO,1 KEEP INTERAL FORMULA NUMBER 4F11645
TXI CA013,1,1 (DECR PART OF EIFNO) 4F11646
CA013 SXD EIFNO,1 UP TO DATE BY ADDING 1. 4F11647
CAL FT OBTAIN HOLLERITH CODED 5-DIGIT 4F11648
ARS 6 EXTERNAL FORMULA NO IN ACC. 4F11649
SLW F-1 AND RETAIN IN F-01. 4F11650
LXD DCF,1 INITIALIZE INDEX A TO COMPL OF F. 4F11651
CA018 LXA L(11),2 SET UP LOOP FOR 11 CYCLES. 4F11652
CA019 LDQ FT+12,2 MOVE WORD FROM REGION FT 4F11653
STQ 0,1 TO REGION F. 4F11654
TIX CA020,1,1 KEEP F-REGION ADDRESS UP-TO-DATE. 4F11655
CA020 TIX CA019,2,1 TEST END OF LOOP. 4F11656
TSX CA100,4 * GO READ NEXT NON-BLANK CARD. 4F11657
CAL FT TEST RIGHTMOST CHARACTER OF 4F11658
ANA L(63) FIRST WORD FOR CONTINUATION MARK, 4F11659
TZE CA021 IF ZERO OR BLANK, 4F11660
SUB ABLANK DISCONTINUE READING, 4F11661
TNZ CA018 OTHERWISE CONTINUE. 4F11662
CA021 CLA BLANKS BEGIN SCANNING REGION F BACKWARDS 4F11663
CA022 CAS -1,1 TO FIND FIRST NON BLANK WORD. 4F11664
TRA CA023 NOT BLANK. 4F11665
TXI CA022,1,1 BLANK, SO CONTINUE SCAN. 4F11666
CA023 LDQ 36ONES PLACE BINARY ONES IN FIRST WORD 4F11667
STQ 0,1 FOLLOWING RIGHTMOST NONBLANK WORD. 4F11668
CAL F-1 PICK UP EXTERNAL FORMULA NUMBER AND4F11669
CAS 5BLANS COMPARE WITH /0 /. 4F11670
TRA CA015 NOT COMPARE. 4F11671
TRA CD000 * TAKE EXTFORMNO, IF ANY AND 4F11672
CA015 LRS 35 GO TO CONVERSION SUBROUTINE AND 4F11673
TSX SR6DC1,1 * RETURN HERE WITH RESULT IN ACC. 4F11674
STA EIFNO STORE RESULT IN ADDRESS OF EIFNO. 4F11675
TSX TET00,1 * GO TO PROGRAM TET TO ENTER EIFNO 4F11676
PZE 0 INTO TABLE TEIFNO (TABLE O). 4F11677
REM END OF PROGRAM CA000. 4F11678
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11679
REM 4F11680
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 067/067 ------
REM CD000/ CALLS=C0190X,C0190,DIAG. 4F11681
REM CD000 SCANS FOR HOLLERITH AND ILLEGAL CHARACTERS. 4F11682
CD000 TSX C0190X,4 * SET SCAN TO PICK UP 1ST CHARACTER. 4F11683
CD001 TSX CD900,1 * IF NOT ENDMARK OR ILLEGAL CHARACTER4F11684
CAS COMMA SCAN 4F11685
TXI CD002,0 FOR 4F11686
TXI CD003,0 HOLLERITH 4F11687
CD002 SUB OPEN SPECIFICATION 4F11688
TNZ CD001 WHICH 4F11689
CD003 TSX CD900,1 * CAN BE= 4F11690
SUB L(10) , N H 4F11691
TPL CD001 OR = ( N H. 4F11692
CD004 TSX CD900,1 * IF NOT ENDMARK OR ILLEGAL CHARACTER4F11693
CAS L(9) CONTINUE SCAN. 4F11694
TXI CD005,0 N 4F11695
TXI CD004,0 IS 4F11696
TXI CD004,0 A 4F11697
CD005 CAS L(H) FIXED 4F11698
TXI CD001+1,0 POINT 4F11699
TXI CD700,0 INTEGER. 4F11700
TXI CD001+1,0 X 4F11701
CD700 TSX C0194 * GO GET NEXT NONBLANK CHARACTER, 4F11702
CAS ENDMK AND IF ENDMARK, 4F11703
TXI CD701,0 THEN SKIP 4F11704
TXI CC000,0 * TO NON-ARITHMETIC CLASSIFICATION. 4F11705
CD701 TSX CD600,1 * SINCE HOLLERITH HAS BEEN FOUND, 4F11706
TXI CD700,0 THEN $ IS LEGAL IN FORMAT TEST. 4F11707
CD900 TSX C0190,4 * OBTAIN NEXT NONBLANK CHARACTER, 4F11708
CAS ENDMK AND IF NOT 4F11709
TXI CD800,0 ENDMARK, THEN SKIP 4F11710
TXI CB000,0 * EXIT TO ARITH/NON-ARITH SCAN. 4F11711
CD800 CAS SPECOP CHECK FOR $ 4F11712
TXI CD601,0 WHICH, UNLESS HOLERITH, IS AN 4F11713
TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11714
CD600 CAS PM CHECK FOR RECORD MARK 4F11715
TRA 1,1 WHICH IS AN 4F11716
TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11717
CD601 CAS CHAR3 CHECK FOR MINUS ZERO 4F11718
TRA 1,1 WHICH IS AN 4F11719
TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11720
CAS CHAR2 CHECK FOR PLUS ZERO 4F11721
TRA 1,1 WHICH IS AN 4F11722
TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11723
CAS MINUS CHECK FOR MINUS SIGN 4F11724
TRA 1,1 WHICH IS AN 4F11725
TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11726
SUB TEN CHECK FOR TEN 4F11727
TNZ 1,1 WHICH IS AN 4F11728
TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. 4F11729
REM END OF PROGRAM CD000. 4F11730
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11731
REM 4F11732
REM CB000/ CALLS=C0190X,C0190,DIAG. 4F11733
REM CB000 CLASSIFIES STATEMENT AS ARITHMETIC OR NON-ARITHMETIC. 4F11734
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 068/068 ------
CB000 LXA L(1),1 SET XR TO COUNT PARENTHESES. 4F11735
TSX C0190X,4 * RESET CHCTR AND FWA TO BEGIN SCAN. 4F11736
CB001 TSX C0190,4 * EXAMINE NEXT NON-BLANK CHARACTER. 4F11737
CAS AEQUAL IF AN EQUAL SIGN, 4F11738
TXI CB005,0 THEN 4F11739
TXI CB200,0 GO TEST PAREN-COUNT. 4F11740
CB005 CAS ALPAR IF A LEFT PARENTHESIS, 4F11741
TXI CB006,0 THEN 4F11742
TXI CB001,1,1 UPDATE PAREN-COUNT BY 1. 4F11743
CB006 CAS ARPAR IF A RIGHT PARENTHESIS, 4F11744
TXI CB007,0 THEN 4F11745
TXI CB500,0 GO TEST PAREN-COUNT. 4F11746
CB007 SUB ENDMK IF NOT ENDMARK, THEN 4F11747
TNZ CB001 GO EXAMINE NEXT CHARACTER. 4F11748
TXI CC000,0 * OTHERWISE, GO TO DIC LOOK-UP. 4F11749
CB200 TIX CC000,1,1 * IF EQUAL WAS NOT WITHIN PARENS, 4F11750
CB201 TSX C0190,4 * THEN EXAMINE NEXT CHARACTER. 4F11751
CAS ALPAR IF LEFT PARENTHESIS, 4F11752
TXI CB205,0 THEN 4F11753
TXI ARITH,0 * THIS IS AN ARITHMETIC FORMULA. 4F11754
CB205 CAS ACOMMA IF A COMMA, 4F11755
TXI CB206,0 THEN 4F11756
TXI CC000,0 * GO TO NON-ARITHMETIC DIC LOOK-UP. 4F11757
CB206 SUB ENDMK IF NOT ENDMARK, THEN 4F11758
TNZ CB201 GO EXAMINE NEXT CHARACTER. 4F11759
TXI ARITH,0 * THIS IS AN ARITHMETIC FORMULA. 4F11760
CB500 TIX CB001,1,1 IF PAREN-COUNT DOES NOT BALANCE, 4F11761
TSX DIAG,4 * ERROR-GO TO DIAGNOSTIC ROUTINE. 4F11762
REM END OF PROGRAM CB000. 4F11763
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11764
REM 4F11765
REM CC000/ CALLS=CC500,C0190X,DIAG,C0190,TET00. 4F11766
REM CC000 CLASSIFIES STATEMENT AS TO WHICH NON-ARITHMETIC. 4F11767
CC000 STZ 2G SET DICTIONARY WORD TAG, AND 4F11768
LXA L(0),3 CHARACTER COUNT AND ENTRY COUNT. 4F11769
CC001 TSX C0190X,4 * RESET CHCTR AND FWA TO BEGIN SCAN. 4F11770
TSX CC500,4 * EXAMINE NEXT DICTIONARY CHARACTER. 4F11771
CAS ENDMK TEST FOR CONSECUTIVE ENDMARKS. 4F11772
TRA ERR77P * MACHINE ERROR, GO TO DIAGNOSTIC. 4F11773
TSX DIAG,4 * ERROR = NOT FOUND IN DICTIONARY. 4F11774
TXI CC004,4 GO BEGIN COMARISION. 4F11775
CC002 TSX CC500,4 * EXAMINE NEXT DICTIONARY CHARACTER. 4F11776
CAS ENDMK TEST FOR END OF DIC ENTRY. 4F11777
TXI ERR77P,0 * MACHINE ERROR, GO TO DIAGNOSTIC. 4F11778
TXI CC007,0 IF END OF ENTRY, LOOK NO FURTHER. 4F11779
CC004 STO 1C OTHERWISE, SAVE CHARACTER 4F11780
STQ 1C+1 AND REMAINDER OF DICTIOANRY WORD. 4F11781
TSX C0190,4 * GO GET NEXT FORMULA CHARACTER, 4F11782
LDQ 1C+1 AND RESTORE DICTIONARY WORD. 4F11783
SUB 1C IF CHARCATERS ARE EQUAL, 4F11784
TZE CC002 THEN GO COMPARE NEXT CHARACTER. 4F11785
CC005 TSX CC500,4 * OTHERWISE, EXAMINE NEXT DIC CHAR. 4F11786
SUB ENDMK CONTINUE UNTIL AN ENDMARK IS 4F11787
TNZ CC005 FOUND, THEN 4F11788
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 069/069 ------
TXI CC001,1,-1 COUNT ENTRY, AND BEGIN AGAIN. 4F11789
CC007 CLA T,1 IF THE CURRENT STATEMENT IS 4F11790
TPL T,1 OF THE NON-EXCUTABLE TYPE, 4F11791
SXD 1C+2,1 THEN 4F11792
TSX TET00,1 * GO ENTER EIFNO IN THE 4F11793
PZE 14 NONEXC TABLE. 4F11794
LXD 1C+2,1 AND THEN 4F11795
CC008 TRA T,1 * TAKE INDICATED TRANSFER. 4F11796
REM END OF PROGRAM CC000. 4F11797
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11798
REM 4F11799
REM STATEA/2-PROCESS CONTROL AND SPECIFICATION STATEMENTS= 4F11800
REM 4F11801
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11802
REM 4F11803
REM C0100/ CALLS=GETIFN,C0190,TEST..,C0180,C0160,C0150,TET00. 4F11804
REM C0100 PROCESSES DO STATEMENTS. 4F11805
C0100 TSX GETIFN,4 * GET INTERNAL FORMULA NUMBER IN 1C. 4F11806
TSX C0190,4 * OBTAIN 1ST NON-BLANK CHARACTER 4F11807
TSX TESTI0,4 * WHICH SHOULD BE NUMERIC. 4F11808
TSX C0180,2 * OBTAIN IN 1G THE BIN EQUIV OF BETA.4F11809
STO 2G SAVE THE 1ST CHAR OF SUBSCRIPT. 4F11810
CLA 1G TAKE CONVERTED RESULT FOR BETA 4F11811
STA 1C AND STORE IN ADDR OF 1C. 4F11812
CLA 2G 1C IS NOW COMPETE EXCEPT FOR TAG. 4F11813
TSX C0160,2 * OBTAIN IN 1G THE SUBSCRIPT. 4F11814
CLA 1G STORE SUBSCRIPT 4F11815
STO 1C+1 IN 1C+1. 4F11816
TSX C0150,2 * OBTIAN IN 1G THE PROPER N1. 4F11817
CLA 1G STORE N1 4F11818
STO 1C+2 IN 1C+2. 4F11819
CAL I OBTAIN I IN LOGICAL ACC AND 4F11820
ARS 18 STORE IN POS 18 OF 1C 4F11821
ORS 1C 0 IF NUMERIC, OR 1 IF NON-NUMERIC. 4F11822
TSX C0150,2 * OBTAIN IN 1G THE PROPER N2. 4F11823
TSX TESTA0,4 * TEST THE AC FOR COMMA OR ENDMARK. 4F11824
TNZ C0113 IF ENDMARK, THEN 4F11825
RQL 31 CREATE ONE IN MQ FOR N3 4F11826
STQ RESIDU AND PLACE IN RESIDU. 4F11827
C0113 CLA 1G STORE N2 4F11828
STO 1C+3 IN 1C+3. 4F11829
CAL I OBTAIN I IN LOG ACC AND 4F11830
ARS 19 STORE IN POS 19 OF 1C 4F11831
ORS 1C 0 IF NUMERIC, OR 1 IF NON-NUMERIC. 4F11832
TSX C0150,2 * OBTAIN IN 1G THE PROPER N3. 4F11833
TSX TESTD0,4 * THE AC SHOULD CONTIAN AN ENDMARK. 4F11834
CLA 1G STORE N3 4F11835
STO 1C+4 IN 1C+4. 4F11836
CAL I OBTAIN I IN LOG ACC AND 4F11837
ARS 20 STORE IN POS 20 OF 1C 4F11838
ORS 1C 0 IF NUMERIC, OR 1 IF NON-NUMERIC. 4F11839
TSX TET00,1 * GO TO TET PROGRAM TO ENTER 4F11840
PZE 1 1C,1C+1,..1C+4 IN TDO TABLE 1. 4F11841
TXI CA010,0 * EXTI TO PROCESS NEXT STATEMENT. 4F11842
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 070/070 ------
REM END OF PROGRAM C0100. 4F11843
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11844
REM 4F11845
REM C0200/ CALLS=GETIFN,DIAG,TEST..,C0190,C0180,TET00,C0160, 4F11846
REM CIT00,SS000(CSA000). 4F11847
REM C0200 PROCESSES GO TO STATEMENTS. 4F11848
C0200 TSX GETIFN,4 * GET INTERNAL FORMULA NUMBER IN 1C 4F11849
STO 1C+2 AND IN 1C+2. 4F11850
TSX C0190,4 * OBTAIN IN ACC NEXT NB CHARACTER 4F11851
CAS L(9) AND COMPARE IT WITH 9. 4F11852
TXI C0205,0 IF NON-NUMERIC, GO COMPARE WITH (. 4F11853
NOP IF NUMERIC, THEN 4F11854
TSX C0180,2 * OBTAIN IN 1G THE BINARY EQUV BETA. 4F11855
TSX TESTD0,4 * THE AC SHOULD CONTAIN AN ENDMARK. 4F11856
CLA 1G STORE BETA IN 1C+1 TO CONSTRUCT 4F11857
STO 1C+1 THE 2ND WORD OF TIFGO TABLE ENTRY. 4F11858
TXI C0202,0 GO TO ENTER 1C,1C+1 INTO TIFGO. 4F11859
C0205 CAS ALPAR TEST CHARACTER FOR ALPHABETIC. 4F11860
TXI C0210,0 IF NOT ALPHABETIC, THEN 4F11861
TXI C0212,0 THIS IS TYPE= GO TO ( ), I. 4F11862
C0210 TSX C0160,2 * TYPE= GO TO N,(),SO OBTAIN IN 1G N 4F11863
TSX TESTG0,4 * WHICH SHOULD BE FOLLOWED BY COMMA. 4F11864
CLA 1G SAVE THE SYMBOL N IN 1C+3 4F11865
STO 1C+3 FOR COMPILED INSTRUCTION. 4F11866
TSX C0190,4 * OBTAIN IN ACC NEXT NB CHARACTER, 4F11867
TSX TESTE0,4 * WHICH SHOULD BE A LPARAN. 4F11868
CLA L(1) PREPARE TO SET ADDRESS PART OF 1C 4F11869
TRA C0213 TO 1 TO INDICATE CLASS OF TRANSFER.4F11870
C0212 CLA L(2) PREPARE TO SET ADDR OF 1C TO 2. 4F11871
C0213 STA 1C STORE 1 OR 2 IN ADDR OF 1C. 4F11872
LXD CTRAD,2 OBTAIN 250-(NO. TRAD ENTRIES), AND 4F11873
PXD ,2 PLACE IN THE DECREMENT OF THE AC 4F11874
STO 1C+1 AND STORE IN 1C+1. 4F11875
C0215 TSX C0190,4 * OBTAIN IN ACC NEXT NB CHAR. 4F11876
TSX C0180,2 * OBTAIN IN 1G THE BIN EQU OF BETA. 4F11877
STO 2G SAVE CHAR IN ACC. 4F11878
TSX TET00,1 * GO TO ENTER 1G 4F11879
PZE 3 INTO TRAD TABLE (TABLE 3). 4F11880
LXD CTRAD,2 REDUCE COUNTER 4F11881
TIX C0216,2,1 CTRAD 4F11882
C0216 SXD CTRAD,2 BY 1. 4F11883
CLA 2G RESTORE CHAR TO ACC. 4F11884
TSX TESTB0,4 * TEST FOR COMMA OR RPAREN. 4F11885
TNZ C0215 IF RIGHT PARENTHESIS, THEN 4F11886
CLA CTRAD OBTAIN IN ADDR OF ACC 250-NO. OF 4F11887
ARS 18 ENTRIES IN TRAD TABLE,AND STORE 4F11888
STA 1C+1 IN ADDR OF 1C+1. 4F11889
CLA 1C OBTAIN 1C IN ACC 4F11890
LBT AND TEST LOW ORDER BIT. 4F11891
TRA C0220 THIS IS A TYPE GO TO (),I FORMULA. 4F11892
TSX C0190,4 * OBTAIN NEXT NB CHAR AND 4F11893
TSX TESTD0,4 * TEST FOR ENDMK. 4F11894
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F11895
PZE 1C+2 WORD 1--DECR= INTFORMNN (LOCATION) 4F11896
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 071/071 ------
PZE L(TRA) WORD 2--TRA00P (OP AND DECR) 4F11897
PZE 1C+3 WORD 3--VARIABLE N (ADDRESS) 4F11898
PZE L(0) WORD 4--00000 (REL ADDR AND TAG). 4F11899
TRA C0202 GO TO ENTER 1C,1C+1 INTO TIFGO. 4F11900
C0220 TSX C0190,4 * EXAMINE NEXT NB CHARACTER, 4F11901
TSX TESTG0,4 * WHICH SHOULD BE A COMMA. 4F11902
TSX C0190,4 * OBTAIN IN ACC NEXT NB CHAR, AND 4F11903
TSX C0160,2 * OBTAIN IN 1G THE FXF-PT. VARIABLE. 4F11904
TSX TESTD0,4 * WHICH SHOULD BE FOLLOWED BY ENDMK. 4F11905
CLA L(1) PREPARE PROPER FORM OF SUBSCRIPT 4F11906
STO E+3 COMBINATION AS 4F11907
STO DIMCTR INPUT TO SUBSCRIPT ANALYSIS= 4F11908
CLA 1G E+3 = 1ST COEFFICIENT. 4F11909
STO E+4 E+4 = 1ST SUBSCRIPT VARIABLE, 4F11910
STZ E+9 E+9 = ADDEND OF SUBSCRIPT, 4F11911
TSX CSA000,4 * DIMCTR = DIMENSION OF VARIABLE. 4F11912
CLA E OUTPUT FROM CSA IS FOUND IN 4F11913
ARS 24 E = I--TAUTAG (GENERAL TAG) 1-11. 4F11914
STO 2G ADJUST AND SAVE FOR COMP. INSTR. 4F11915
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F11916
PZE 1C+2 WORD 1--DECR-INTFORMNO(LOCATION) 4F11917
PZE L(TRA) WORD 2--TRA000(OP AND DECR) 4F11918
PZE L(0) WORD 3--000000(ADDRESS) 4F11919
PZE 2G WORD 4--ADDR = TAUTAG FOR I 4F11920
REM C0200= ENTRY POINT USED BY C0400,C1000. 4F11921
C0202 TSX TET00,1 * GO TO TET TO ENTER 1C AND 1C+1 4F11922
PZE 2 INTO TIFGO TABLE (TABLE 2). 4F11923
CTRAD TXI CA010,0,250 * EXIT TO PROCESS NEXT STATEMENT. 4F11924
REM END OF PROGRAM C0200. 4F11925
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11926
REM 4F11927
REM C0300/ CALLS=-C0190X,C0190,C0390,TEST..,DIAG,C0180,TET00, 4F11928
REM STATEB. 4F11929
REM C0300 PROCESSES IF STATEMENTS. 4F11930
C0300 LXD EIFNO,4 PLACE THE CURRENT INTERNAL FORMULA 4F11931
PXD ,4 NUMBER IN THE DECREMENT OF 1C 4F11932
SSM WITH SIGN SET TO MINUS 4F11933
STO 1C FOR FUTURE TIFGO ENTRY. 4F11934
TSX C0190X,4 * SET CHCTR AND FWA TO BEGIN SCAN. 4F11935
TSX C0190,4 * OBTAIN IN AC THE 1ST NB CHAR (I). 4F11936
LDQ L(X) REPLACW THE CHARACTER I 4F11937
TSX C0390,4 * WITH THE CHARACTER X. 4F11938
LDQ L(10) REPALCE THE CHARACTER F 4F11939
TSX C0390,4 * WITH THE CHARACTER 001010. 4F11940
TSX TESTE0,4 * IF NOT LPAREN -- THEN ERROR. 4F11941
LDQ AEQUAL REPLACE THE CHARACTER LPARAN 4F11942
TSX C0390,4 * WITH THE CHARACTER EQUAL. 4F11943
LXA L(1),2 SET XR2 FOR COUNTING PARENTHESES. 4F11944
TRA *+2 4F11945
C0302 TSX C0190,4 * MAKE SURE THAT NEXT NB CHARACTER 4F11946
CAS ENDMK IS NOT AN ENDMARK. 4F11947
TRA ERR77P * MACHINE ERROR, GO TO DIAGNOSTIC. 4F11948
TSX DIAG,4 * PROGRAM ERROR, GO TO DIAGNOSTIC. 4F11949
CAS ALPAR IF IT IS A LPAREN, 4F11950
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 072/072 ------
TXI C0303,0 THEN ADD 1 TO PAREN COUNT, AND 4F11951
TXI C0302,2,1 GO EXAMINE NEXT CHARACTER. 4F11952
C0303 SUB ARPAR IF IT IS A RPAREN, 4F11953
TNZ C0302 THE TEST PAREN COUNT, AND IF IT 4F11954
TIX C0302,2,1 CAN NOT BE REDUCED,MATE IS FOUND. 4F11955
LDQ ENDMK SO REPLACE THE CHARACTER RPAREN 4F11956
TSX C0390,4 * WITH THE CHARACTER ENDMK. 4F11957
TSX C0180,2 * BINARY EQUIVALENT OF BETA 1. 4F11958
TSX TESTG0,4 * THIS SHOULD BE FOLLOWED BY A COMMA.4F11959
CLA 1G MOVE BETA1 4F11960
STA 1C TO ADDRESS OF 1C. 4F11961
TSX C0190,4 * AND PROCEED TO FORM 4F11962
TSX C0180,2 * THE BINARY EQUIVALENT OF BETA 2. 4F11963
TSX TESTG0,4 * THIS SHOULD BE FOLLWED BY A COMMA. 4F11964
CLA 1G MOVE BETA2 4F11965
ALS 18 TO DECR PART 4F11966
STO 1C+1 OF 1C+1. 4F11967
TSX C0190,4 * AND PROCEED TO FORM 4F11968
TSX C0180,2 * THE BINARY EQUIVALENT OF BETA 3. 4F11969
TSX TESTD0,4 * THIS SHOULD BE FOLLOWED BY ENDMARK.4F11970
CLA 1G MOVE BETA3 4F11971
STA 1C+1 TO ADDRESS OF 1C+1. 4F11972
TXI ARITH,0 * EXIT TO ARITH FOR FINAL PROCESSING.4F11973
REM END OF PROGRAM C0300. 4F11974
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F11975
REM 4F11976
REM C0400/ CALLS=C0190,C0180,TEST..,CIT00,C0200. 4F11977
REM C0400 PROCESSES IF (SENSE SWITCH STATEMENTS. 4F11978
C0400 CLA L(112) FOR SENSE SWITCH 4F11979
STO 1H SET 1H TO 112, AND PREPARE TO 4F11980
CLA L(PSE) SET 2H TO PSE. 4F11981
REM C0401= ENTRY POINT USED BY C0500. 4F11982
C0401 STO 2H SET 2H FOR SENSE SWITCH OR LIGHT. 4F11983
TSX C0190,4 * PROCEED TO FORM THE BINARY 4F11984
TSX C0180,2 * EQUIVALENT OF SW OR SL NUMBER. 4F11985
TSX TESTF0,4 * THIS SHOULD BE FOLLOWED BY RPAREN. 4F11986
CLA L(3) STORE 3 4F11987
STO 1C IN ADDRESS OF 1C. 4F11988
CLA 1G ADD THE PROPER INCREMENT TO THE 4F11989
ADD 1H NUMBER OF SENSE SWITCH OR LIGHT, 4F11990
ALS 18 AND ADJUST TO THE DECREMENT. 4F11991
REM C0402= ENTRY POINT USED BY C0600. 4F11992
C0402 STO 1C+3 SET 1C+3 FOR CIT ENTRY. 4F11993
LXD EIFNO,4 PLACE THE CURRENT INTERNAL FORMULA 4F11994
PXD ,4 NUMBER IN THE DECREMENT OF 4F11995
STD 1C 1C FOR FUTURE TIFGO ENTRY, AND 4F11996
STO 1C+2 1C+2 FOR FUTURE CIT ENTRY. 4F11997
TSX C0190,4 * PROCEED TO FORM THE BINARY 4F11998
TSX C0180,2 * EQUIVALENT OF BETA 1, 4F11999
TSX TESTG0,4 * WHICH SHOULD BE FOLLOWED BY COMMA. 4F12000
CLA 1G BRING UP, 4F12001
ALS 18 ADJUST AND 4F12002
STO 1C+1 STORE BETA1 IN DECR OF 1C+1. 4F12003
TSX C0190,4 * PROCEED TO FORM THE BINARY 4F12004
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 073/073 ------
TSX C0180,2 * EQUIVALENT OF BETA 2, 4F12005
TSX TESTD0,4 * WHICH SHOULD BE FOLLOWED BY ENDMK. 4F12006
CLA 1G BRING UP AND 4F12007
STA 1C+1 STORE BETA2 IN ADDR OF 1C+1. 4F12008
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12009
PZE 1C+2 WORD1--DECR = INTFORMNO (LOCATION) 4F12010
PZE 2H WORD2--PSE,MSE,DCT,TOV,OR TQO. 4F12011
PZE L(0) WORD3--000000 (ADDRESS) 4F12012
PZE 1C+3 WORD4--DECR=SS OR SL NO., OR 0000004F12013
TXI C0202,0 * MAKE TIFGO ENTRY, AND RETURN TO CA.4F12014
REM END OF PROGRAM C0400. 4F12015
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12016
REM 4F12017
REM C0500/ USES=C0400. 4F12018
REM C0500 PROCESSES IF (SENSE LIGHT STATMENTS. 4F12019
C0500 CLA L(96) STORE 96 IN 4F12020
STO 1H 1H AND 4F12021
CLA L(MSE) OBTAIN (MSE000) IN ACC. 4F12022
TRA C0401 * AND CONTINUE BY USING PROGRAM C04. 4F12023
REM END OF PROGRAM C0500. 4F12024
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12025
REM 4F12026
REM C0600/ USES=C0400. 4F12027
REM C0600 PROCESSES IF DIVIDE CHECK STATEMENTS. 4F12028
C0600 CLA L(DCT) STORE (DCT000) 4F12029
STO 2H IN 2H 4F12030
CLA L(4) AND PICK UP 4 TO SET 1C. 4F12031
REM C0601= ENTRY POINT USED BY C0700. 4F12032
C0601 STO 1C SET 1C FOR FUTURE TIFGO ENTRY. 4F12033
PXD ,0 CLEAR THE AC, 4F12034
TRA C0402 * AND CONTINUE BY USING PROGRAM C04. 4F12035
REM END OF PROGRAM C0600. 4F12036
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12037
REM 4F12038
REM C0700/ USES C0600. 4F12039
REM C0700 PROCESSES IF AC OVERFLOW STATEMENTS. 4F12040
C0700 CLA L(TOV) PICKUP TOV000 TO SET 2H. 4F12041
REM C0701= ENTRY POINT USED BY C0800. 4F12042
C0701 STO 2H SET 2H FOR FUTURE CIT ENTRY. 4F12043
CLA L(5) PICKUP 5 TO SET 1C, AND 4F12044
TRA C0601 * CONTINUE BY USING PROGRAM C06. 4F12045
REM END OF PROGRAM C0700. 4F12046
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12047
REM 4F12048
REM C0800/ USES=C0700. 4F12049
REM C0800 PROCESSES IF MQ OVERFLOW STATEMENTS. 4F12050
C0800 CLA L(TQO) PICKUP TQO000 TO SET 2H, 4F12051
TRA C0701 * AND CONTINUE BY USING PROGRAM C07. 4F12052
REM END OF PROGRAM C0800. 4F12053
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12054
REM 4F12055
REM C0900/ CALLS=C0190,CIT00,DIAG. CALLER=C1300. 4F12056
REM C0900 PROCESSES PAUSE STATEMENTS. 4F12057
C0900 LXD C090X,2 SET XR2 FOR EXIT TO CA000. 4F12058
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 074/074 ------
REM C0901= ENTRY POINT USED BY C1300. 4F12059
C0901 STZ 1G CLEAR 1G. 4F12060
C0902 TSX C0190,4 * TEST NEXT NON-BLANK CHARACTER 4F12061
CAS ENDMK FOR END OF STATEMENT MARK. 4F12062
TRA ERR77P * MACHINE ERROR, GO TO DIAGNOSTIC. 4F12063
C090X TXI C0903,0,-CA010+1 IF NOT END OF STATEMENT, THEN 4F12064
ADD 1G ADD 1G TO DIGIT, 4F12065
ALS 3 MULTIPLY BY 8. 4F12066
STO 1G AND STORE BACK IN 1G. 4F12067
TXI C0902,0 CONTINUE UNTIL END OF STATEMENT. 4F12068
C0903 CLA 1G THEN PLACE OCTAL ALPHA 4F12069
ALS 15 IN THE DECREMENT 4F12070
STO 1C OF 1C FOR FUTURE CIT ENTRY. 4F12071
LXD EIFNO,4 PLACE THE CURRENT INTERNAL FORMULA 4F12072
PXD ,4 NUMBER IN THE DECREMENT 4F12073
STO 1C+1 OF 1C+1,WITH ZEROS ELSEWHERE. 4F12074
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12075
PZE 1C+1 WORD1--DECR = INTFORMNO (LOCATION) 4F12076
PZE L(HPR) WORD2--HPR000 (OP AND DECR) 4F12077
PZE L(0) WORD3--000000 (ADDRESS) 4F12078
PZE 1C WORD4--DECR = ALPHA, REST ZEROS. 4F12079
TRA 1,2 * EXIT TO CA000, OR TO C1300. 4F12080
REM END OF PROGRAM C0900. 4F12081
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12082
REM 4F12083
REM C1000/ USES=C0200. CALLS=GETIFN,C0190,C0180,DIAG,C0190,TEST..4F12084
REM CIT00. 4F12085
REM C1000 PROCESSES ASSIGN STATEMENTS. 4F12086
C1000 TSX GETIFN,4 * GET INTERNAL FORMULA NUMBER IN 1C 4F12087
STO 1C+2 AND 1C+2,WITH ZEROS ELSEWHERE. 4F12088
CLA L(6) STORE 6 IN 4F12089
STA 1C ADDRESS OF 1C. 4F12090
TSX C0180X,2 * GO FORM BINARY EQUIV OF ALPHA. 4F12091
SUB L(T) IF NEXT CHARACTER IS NOT T, THEN 4F12093
TZE *+2 THIS IS AN 4F12094
TSX DIAG,4 * ERROR - GO TO THE DIAGNOSTIC. 4F12095
TSX C0190,4 * EXAMINE NEXT NON-BLANK CHARACTER 4F12096
SUB L(0) AND IF IT IS NOT 0, THEN 4F12097
TNZ *-3 ERROR, GO TO DIAGNOSTIC. 4F12098
CLA 1G PUT BIN EQUIV OF ALPHA 4F12099
STO 1C+1 IN ADDRESS OF 1C+1. 4F12100
TSX C0190,4 * PROCEED TO ASSEMBLE IN 1G 4F12101
TSX C0160,2 * THE SYMBOL N. 4F12102
TSX TESTD0,4 * THE NEXT NB CHAR SHOULD BE ENDMK. 4F12103
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12104
PZE 1C+2 WORD1--DECR = INTFORMNO (LOCATION) 4F12105
PZE L(CLA) WORD2--CLA000 (OP AND DECR) 4F12106
PZE L(0) WORD3--000000 (ADDRESS) 4F12107
PZE L(0) WORD4--000000 (RELADDR AND TAG). 4F12108
TSX CIT00,4 * STORE SECOND COMPILED INSTRUCTION= 4F12109
PZE L(0) WORD1--000000 (ALL ZEROS) 4F12110
PZE L(STO) WORD2--STO000 (OP AND DECR) 4F12111
PZE 1G WORD3--SYMBOL N (ADDRESS) 4F12112
PZE L(0) WORD4--000000 (REL ADDR AND TAG). 4F12113
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 075/075 ------
TRA C0202 * CONTINUE BY USING PROGRAM C02. 4F12114
REM END OF PROGRAM C1000. 4F12115
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12116
REM 4F12117
REM C1100/ CALLS=C0190,C0180,TEST..,GETIFN,CIT00. 4F12118
REM C1100 PROCESSES SENSE LIGHT STATMENTS. 4F12119
C1100 TSX C0180X,2 * GO FORM BINARY EQUIV OF SL NUMBER. 4F12120
TSX TESTD0,4 * THE NEXT NB CHARACTER SHD BE ENDMK.4F12122
CLA 1G STORE SENSE LIGHT NUMBER 4F12123
ADD L(96) PLUS 96 4F12124
ALS 18 IN DECR 4F12125
STO 1G OF 1G. 4F12126
TSX GETIFN,4 * GET INTERNAL FORMULA NUMBER IN 1C. 4F12127
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY. 4F12128
PZE 1C WORD1--DECR = INTFORMNO (LOCATION) 4F12129
PZE L(PSE) WORD2--PSE000 (OP AND DECREMENT) 4F12130
PZE L(0) WORD3--000000 (ADDRESS PART) 4F12131
PZE 1G WORD4--DECR = 96+ALPHA,REST ZEROS. 4F12132
TXI CA010,0 * EXIT TO PROCESS NEXT STATEMENT. 4F12133
REM END OF PROGRAM C1100. 4F12134
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12135
REM 4F12136
REM C1200/ CALLS=C0190,C0160,TEST..,DIM.SR,DIAG,C0180,DRTABS. 4F12137
REM C1200 PROCESSES DIMENSION STATEMENTS. 4F12138
C1200 TSX C0190,4 * PROCEED TO ASSEMBLE IN 1G 4F12139
TSX C0160,2 * THE VARIABLE SYMBOL. 4F12140
TSX TESTE0,4 * NEXT NB CHARACTER SHOULD BE LPAREN.4F12141
CLA 1G PUT VARIABLE SYMBOL 4F12142
STO 1C IN 1C. 4F12143
STO E+2 ALSO IN E+2. THEN 4F12144
TSX DIM1SR,4 * GO SEARCH DIM1 TABLE. 4F12145
TRA C1280 THEN IF NOT 4F12146
TRA C1299 FOUND, 4F12147
C1280 TSX DIM2SR,4 * GO SEARCH DIM2 TABLE. 4F12148
TRA C1281 THEN IF NOT 4F12149
TRA C1299 FOUND, 4F12150
C1281 TSX DIM3SR,4 * GO SEARCH DIM3 TABLE. 4F12151
TRA C1282 DO NOT CONTUINUE IF 4F12152
C1299 TSX DIAG,4 * VARIABLE PREVIOUSLY APPEARED. 4F12153
C1282 TSX C0180X,2 * GO FORM BINARY EQUIV OF D1. 4F12154
SUB CLOS IF NOT 1 DIMENSION, 4F12155
TZE C1210 THEN 4F12156
CLA 1G PUT D1 4F12157
ALS 18 IN DECR 4F12158
STO 1C+1 OF 1C+1. 4F12159
TSX C0180X,2 * GO FORM BINARY EQUIV OF D2. 4F12160
SUB CLOS IF NOT 2 DIMENSION, 4F12163
TZE C1220 THEN 4F12164
CLA 1G PUT D2 4F12165
STA 1C+1 IN ADDRESS OF 1C+1. 4F12166
TSX C0180X,2 * GO FORM BINARY EQUIV OF D3. 4F12168
SUB CLOS IF MORE THAN 3 DIMENSIONS, 4F12169
TZE *+2 THIS IS AN 4F12170
TSX DIAG,4 * ERROR - GO TO THE DIAGNOSTIC. 4F12171
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 076/076 ------
CLA 1G IF 3 DIMENSION, PUT D3 4F12172
STO 1C+2 IN 1C+2, AND 4F12173
TSX DIM3IX,4 * GO MAKE DIM3 ENTRY. 4F12174
TXI C1201,0 GO TO TEST FOR END OF STATEMENT. 4F12175
C1210 CLA 1G IF 1 DIMENSION, PUT D1 4F12176
STO 1C+1 IN 1C+1, AND 4F12177
TSX DIM1IX,4 * GO MAKE DIM1 ENTRY. THEN 4F12178
TXI C1201,0 GO TO TEST FOR END OF STATEMENT. 4F12179
C1220 CLA 1G IF 2 DIMENSIONS, PUT D2 IN 4F12180
STA 1C+1 ADDRESS PART OF 1C+1. AND 4F12181
TSX DIM2IX,4 * GO MAKE DIM2 ENTRY. THEN 4F12182
C1201 TSX C0190,4 * OBTAIN NB CHAR FOLLOWING RPAREN. 4F12183
TSX TESTA0,4 * TEST FOR COMMA OR ENDMARK. 4F12184
TNZ C1200 IF CHARACTER IS ENDMAKR, THEN 4F12185
TXI CA010,0 * EXIT TO PROCESS NEXT STATMENT. 4F12186
REM END OF PROGRAM C1200. 4F12187
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12188
REM 4F12189
REM C1300/ CALLS=C0901,TET00,CIT00. 4F12190
REM C1300 PROCESSES STOP STATEMENTS. 4F12191
C1300 TSX TET00,1 * GO MAKE EIFNO ENTRY 4F12192
PZE 15 IN TSTOP TABLE. 4F12193
TSX C0901,2 * USE C0900 TO BEGIN PROCESSING. 4F12194
TSX CIT00,4 * GO MAKE FOLLOWING CIT ENTRY= 4F12195
PZE L(0) WORD1--ALL ZEROS 4F12196
PZE L(TRA) WORD2--TRA000 (OP+DECR) 4F12197
PZE 1C+1 WORD3--DECR = INTFORMNO (SYMBOL) 4F12198
PZE L(0) WORD4--ZEROS (REL ADDR AND TAG) 4F12199
TXI CA010,0 * EXIT TO PROCESS NEXT STATEMENT. 4F12200
REM END OF PROGRAM C1300. 4F12201
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12202
REM 4F12203
REM C1400/ CALLS=C0190,C0180,TEST..,TET00. 4F12204
REM C1400 PROCESS FREQUENCY STATEMENTS. 4F12205
C1400 TSX C0180X,2 * GO FORM BINARY EQUIV OF EFN. 4F12206
TSX TESTE0,4 * CHARACTER SHOULD BE A LPAREN. 4F12208
CLS 1G CHANGE SIGN OF SYMBOL 4F12209
STO 1G TO MINUS. 4F12210
TSX TET00,1 * GO TO PROGRAM TET TO ENTER 4F12211
PZE 7 4F12212
C1401 TSX C0180X,2 * GO FORM BINARY EQUIV OF M(1). 4F12213
STO 1C SAVE CHAR IN ACC. 4F12215
TSX TET00,1 * GO TO PROGRAM TET TO ENTER M(1) 4F12216
PZE 7 INTO TABLE FRET (TABLE7), AND 4F12217
CLA 1C RESTORE CHAR IN ACC, AND 4F12218
TSX TESTB0,4 * TEST FOR , OR ). 4F12219
TNZ C1401 IF RIGHT PARENTHESIS, THEN 4F12220
TSX C0190,4 * OBTAIN IN ACC NEXT NBCHAR, AND 4F12221
TSX TESTA0,4 * TEST FOR COMMA OR ENDMARK. 4F12222
TNZ C1400 IF ENDMAKE, THIS STATEMENT IS DONE.4F12223
TXI CA010,0 * EXIT TO PROCESS NEXT STATEMENT. 4F12224
REM END OF PROGRAM C1400. 4F12225
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12226
REM 4F12227
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 077/077 ------
REM C1500/ CALLS=C0190,TEST..,C0160,C0180,TET00. 4F12228
REM C1500 PROCESSES EQUIVALENCE STATEMENTS. 4F12229
C1500 TSX C0190,4 * OBTAIN NEXT NBCHAR IN ACC. 4F12230
TSX TESTE0,4 * CHARACTER SHOULD BE A LPARAN. 4F12231
C1501 CLA L(1) INITIALIZE 1C 4F12232
STO 1C+1 TO 1. 4F12233
TSX C0190,4 * OBTAIN NEXT NBCHAR IN ACC AND 4F12234
TSX C0160,2 * OBTAIN IN 1G THE SYMBOL V. 4F12235
LDQ 1G MOVE V 4F12236
STQ 1C INTO 1C. 4F12237
CAS ALPAR EXAMINE CHARACTER LEFT IN THE AC, 4F12238
TXI C1503,0 AND IF 4F12239
TXI C1502,0 CHARACTER IS A LEFT PARENTHESIS, 4F12240
TIX C1503,0 THEN 4F12241
C1502 TSX C0180X,2 * GO FORM BINARY EQUIV OF N. 4F12242
TSX TESTF0,4 * 1ST NON-NUMERIC SHOULD BE A RPAREN.4F12244
CLA 1G PUT BIN EQUIV OF N 4F12245
STO 1C+1 IN 1C+1. 4F12246
TSX C0190,4 * OBTAIN NEXT NBCHAR IN AC, AND 4F12247
C1503 TSX TESTB0,4 * TEST FOR COMMA OR RPAREN. 4F12248
TZE C1504 IF COMMA, THEN 4F12249
TSX TET00,1 * GO TO PROGRAM TET TO ENTER SYMBOL 4F12250
PZE 8 AND N IN EQUIT (TABLE 8), AND 4F12251
TXI C1501,0 RETURN TO CONTINUE PROCESSING X. 4F12252
C1504 CLS 1C+1 MAKE SIGN OF N MINUS SINCE 4F12253
STO 1C+1 THIS IS LAST ITEM. 4F12254
TSX TET00,1 * GO TO PROGRAM TET TO ENTER SYMBOL 4F12255
PZE 8 AND N IN EQUIT (TABLE 8), AND 4F12256
TSX C0190,4 * OBTAIN NEXT NBCHAR IN ACC, AND 4F12257
TSX TESTA0,4 * TEST FOR COMMA OR ENDMARK. 4F12258
TNZ C1500 IF ENDMARK, THEN 4F12259
TXI CA010,0 * EXIT TO PROCESS NEXT STATEMENT. 4F12260
REM END OF PROGRAM C1500. 4F12261
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12262
REM 4F12263
REM C1600/ CALLS=C0190,TEST..,GIF,BSS. 4F12264
REM C1600 PROCESSES CONTINUE STATEMENTS. 4F12265
C1600 TSX C0190,4 * OBTAIN NEXT NBCHAR IN ACC. 4F12266
TSX TESTD0,4 * CHARACTER SHOULD BE AN ENDMARK. 4F12267
TSX GIF,4 * GET INTERNAL FORMULA NUMBER, AND 4F12268
TSX BSS,2 * GO COMPILE= IFN BSS 0. 4F12269
TXI CA010,0 * EXIT TO PROCESS NEXT STATEMENT. 4F12270
REM END OF PROGRAM C1500. 4F12271
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12272
REM 4F12273
REM C3000/ CALLS=DIAG,C0190,C0160,TEST..,SUBX00,TET00,TESTFX. 4F12274
REM C3000 PROCESSES SUBROUTINE AND FUNCTION STATEMENTS. 4F12275
C3500 CAL TXHOP 4F12276
STP C3003 4F12277
C3000 LXD EIFNO,4 EXAMINE INTERNAL FORMULA NO., AND 4F12278
TXL *+2,4,1 IF NOT THE 1ST STATEMENT, THEN 4F12279
TSX DIAG,4 * ERROR - GO TO DIAGNOSTIC. 4F12280
CLA ARGCNT SET ARGCNT TO INDICATE TO LATER 4F12281
SSP RETURN THAT THERE WAS A PRECEEDING 4F12282
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 078/078 ------
STO ARGCNT SUBROUTINE OR FUNCTION STATEMENT. 4F12283
TSX C0190,4 * IF 1ST CHARACTER OF NAME IS 4F12284
TSX TESTH0,4 * NUMERIC, THEN GO TO THE DIAGNOSTIC.4F12285
TSX C0160,2 * ASSEMBLE NAME IN 1G. 4F12286
TSX TESTC0,4 * NEXT CHAR SHD BE LPAREN OR ENDMARK.4F12287
C3003 TXL *+3,0 4F12288
CLA 1G 4F12289
STO FSNAME 4F12290
TSX SUBX00,4 * FILL OUT NAME WITH BLANKS. 4F12291
TSX TET00,1 * GO ENTER NAME 4F12292
PZE 11 IN SUBDEF TABLE. 4F12293
LXD EIFNO,4 PLACE 4F12294
PXD ,4 INTERNAL FORMULA NUMBER 4F12295
STO G IN G. 4F12296
TXI C3003,0 GO TEST FOR END OF STATEMENT. 4F12297
C3001 ADD ENDMK IF NOT ENDMARK, RESTOERE CHARACTER 4F12298
TSX TESTH0,4 * WHICH SHOULD BE NON-NUMERIC 4F12299
STO FIRSTC 1ST CHARACTER OF ARGUMENT. 4F12300
TSX C0160,2 * ASSEMBLE ARGUMENT IN 1G. 4F12301
TSX TESTB0,4 * NEXT CHAR SHD BE COMMA OR RPARAN. 4F12302
CLA 1G MOVE ARGUMENT 4F12303
STO G+1 INTO G+1. 4F12304
TSX TESTFX,1 * GO TEST FOR FIXED OR FLOATING PT. 4F12305
TXI C3004,0 IF FLOATING PT., SKIP FORVAL ENTRY.4F12306
TSX TET00,1 * IF FIXED POINT, GO MAKE ENTRY 4F12307
PZE 6 IN FORVAL TABLE. 4F12308
C3004 TSX TET00,1 * IN BOTH CASES, MAKE ENTRIES IN 4F12309
PZE 11 SUBDEF TABLE. 4F12310
CLA ARGCNT UPDATE 4F12311
ADD D1 ARGUMENT COUNT 4F12312
STO ARGCNT BY 1. AND 4F12313
C3002 TSX C0190,4 * EXAMINE NEXT NON-BLANK CHARACTER. 4F12314
SUB ENDMK IF NOT ENDMARK, THEN 4F12315
TNZ C3001 GO PROCESS NEXT ARGUMENT. 4F12316
TXI CA010,0 * OTHERWISE, EXIT TO CA000. 4F12317
REM END OF PROGRAM C3000. 4F12318
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12319
REM 4F12320
REM C3100/ CALLS=C0190,DIAG,TEST..,C0160,TET00. 4F12321
REM C3100 PROCESSES COMMON STATEMENTS. 4F12322
C3100 TSX C0190,4 * GET FIRST NON-BLANK CHAR OF SYMBOL 4F12323
TSX TESTH0,4 * WHICH SHOULD BE NON-NUMERIC. 4F12324
TSX C0160,2 * ASSEMBLE SYMBOL IN 1G, AND TEST 4F12325
TSX TESTA0,4 * NEXT CHARACTER FOR COMMA OR ENDMK. 4F12326
PAX ,4 SAVE RESULT OF TEST IN XR4, AND 4F12327
TSX TET00,1 * GO ENTER THIS SYMBOL 4F12328
PZE 12 IN COMMON TABLE. 4F12329
CLA SBDFCN ANY ENTRIES IN SUBDEF 4F123291
TZE C3101 INDICATE THIS IS NOT A 4F123292
CLA 2E18 MAIN PROGRAM. SINCE THIS 4F123293
STO G IS A COMMON 4F123294
CAL 1G STATEMENT WHICH 4F123296
SLW G+1 APPEARS IN A SUBPROGRAM 4F123297
ARS 30 ENTER ANY 4F123298
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 079/079 ------
TSX TESTFX+1,1 * FIXED POINT 4F123299
TRA C3101 VARIABLES 4F12330
TSX TET00,1 * IN 4F123301
PZE 6 FORVAL TABLE. 4F123302
C3101 TXH C3100,4,0 IF CHARACTER WAS COMMA, REPEAT. 4F123303
TXI CA010,0 * IF ENDMK, EXIT TO CA000. 4F12331
REM END OF PROGRAM C3100. 4F12332
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12333
REM 4F12334
REM C3200/ CALLS=C0190,TEST..,GETIFN,DIAG,CIT00,JIF(GIF). 4F12335
REM C3200 PROCESSES RETURN STATEMENTS. 4F12336
C3200 TSX C0190,4 * EXAMINE NEXT NON-BLANK CHARACTER, 4F12337
TSX TESTD0,4 * WHICH SHOULD BE AN ENDMARK. 4F12338
TSX GETIFN,4 * GET INTERNAL FORMULA NUMBER IN 1C. 4F12339
TSX JIF,4 * SET SL TO ALPHA+1. 4F12340
CLA ARGCNT TEST ARGCNT FOR PRECEEDING 4F12341
TPL *+2 SUBROUTINE - IF NONE, THEN 4F12342
TSX DIAG,4 * ERROR - GO TO THE DIAGNOSTIC. 4F12343
CLA FSNAME 4F12344
TZE *+7 4F12345
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12346
PZE 1C WORD1--0(IFN)000 4F12347
PZE L(CLA) WORD2--CLA000 4F12348
PZE FSNAME WORD3--NAME OF FUNCTION 4F12349
PZE L(0) WORD4--000000 4F12350
STZ 1C CLEAR 1C. 4F12351
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12352
PZE 1C WORD1--0(IFN)000 4F12353
PZE L(LXD) WORD2--LXD000 4F12354
PZE DOLSGN WORD3--$ 4F12355
PZE L(1) WORD4--000001 4F12356
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12357
PZE L(0) WORD1--000000 4F12358
PZE L(LXD) WORD2--LXD000 4F12359
PZE DOLSGN WORD3--$ 4F12360
PZE ABTAG2 WORD4--001002 4F12361
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12362
PZE L(0) WORD1--000000 4F12363
PZE L(QXD) WORD2--QXD000 4F12364
PZE DOLSGN WORD3--$ 4F12365
PZE ABTAG3 WORD4--002000 4F12366
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12367
PZE SL WORD1--0(IFN+1)000 4F12368
PZE L(OPR) WORD2--OPRO00 4F12369
PZE L(0) WORD3--000000 4F12370
PZE ARGCNT WORD4--0(N+1)004 4F12371
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12372
PZE L(0) WORD1--000000 4F12373
PZE L(TRA) WORD2--TRA000 4F12374
PZE SL WORD3--0(IFN+1)000 4F12375
PZE L(0) WORD4--000000 4F12376
TXI CA010,0 * EXIT TO PROCESS NEXT STATEMENT. 4F12377
REM END OF PROGRAM C3200. 4F12378
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12379
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 080/080 ------
REM 4F12380
REM C3300/ CALLS=C0390,C0190X,C0190,TEST..,ARITH,SUBX00. 4F12381
REM C3300 PROCESSES CALL STATEMENTS. 4F12382
C3300 TSX C0190,4 * IF 1ST CHARACTER OF NAME IS 4F12383
TSX TESTH0,4 * NUMERIC, THEN GO TO THE DIAGNOSTIC.4F12384
TSX C0160,2 * COLLECT THE REST OF THE NAME, WHICH4F12385
TSX TESTC0,4 * SHD BE FOLLOWED BY LPAREN OR ENDMK.4F12386
TZE C3301 IF LPAREN, THEN CHANGE CALL TO A 4F12387
TSX C0190X,4 * PSEUDO-ARITHMETIC FORMULA (Z10=). 4F12388
TSX C0190,4 * PICKUP THE CHARACTER C, 4F12389
LDQ L(Z) AND 4F12390
TSX C0390,4 * REPLACE C WITH Z. 4F12391
LDQ L(10) AND 4F12392
TSX C0390,4 * REPLACE A WITH TEN. 4F12393
LDQ EQUAL AND 4F12394
TSX C0390,4 * REPLACE FIRST L WITH =. 4F12395
LDQ BLANK AND 4F12396
TSX C0390,4 * REPLACE SECOND L WITH BLANK. 4F12397
CLA EIFNO PUT 1ST IFN OF THIS CAL IN CALLNM 4F12398
ARS 18 FOR LATER TABLE ENTRY FO 4F12399
STA CALLNM FIRST / LAST NUMBERS OF CALLS. 4F12400
TXI ARITH,0 * THEN EXIT TO ARITH TO PROCESS. 4F12401
C3301 TSX SUBX00,4 * IF THERE ARE NO ARGUMENTS, THEN 4F12402
CLA 1G AFTER COMPLETING NAME WITH BLANKS, 4F12403
STO G MOVE IT INTO G, AND 4F12404
TSX TET00,1 * GO ENTER NAME 4F12405
PZE 9 INTO CLOSUB TABLE. 4F12406
TSX GETIFN,4 * PUT INTERNAL FORMULA NUMBER IN 1C. 4F12407
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12408
PZE 1C WORD1--0(IFN)000 4F12409
PZE L(SXD) WORD2--SXD000 4F12410
PZE X( WORD3--700000 4F12411
PZE L(4) WORD4--000004 4F12412
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12413
PZE L(0) WORD1--000000 4F12414
PZE L(TSX) WORD2--TSX000 4F12415
PZE 1G WORD3--(NAME) 4F12416
PZE L(4) WORD4--000004 4F12417
TSX FLTR00,4 * GO MAKE FLOW TRACING INSTRUCTIONS. 4F12418
PZE L(0) WORD1--000000 4F12419
PZE L(LXD) WORD2--LXD000 4F12420
PZE X( WORD3--700000 4F12421
PZE L(4) WORD4--000004 4F12422
TXI CA010,0 * EXIT TO PROCESS NEXT STATEMENT. 4F12423
REM END OF PROGRAM C3300. 4F12424
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12425
REM 4F12426
REM C3400/ CALLS=C0190,DIAG,TEST... 4F12427
REM C3400 PROCESSES END STATEMENTS. 4F12428
C3400 LXA L(5),2 PREPARE TO SET 5 SS SIMULATORS. 4F12429
C3405 TSX C0190,4 * PICKUP CONSTANT, 4F12430
CAS L(2) WHICH SHOULD BE 0,1, OR 2. 4F12431
TSX DIAG,4 * OTHERWISE, GO TO THE DIAGNOSTIC. 4F12432
TXI C3410,0 SIMULATOR IS PRESET TO 2. 4F12433
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 081/081 ------
STO ENDI1+5,2 IF 0 OR 1, SET PROPER SIMULATOR. 4F12434
C3410 TSX C0190,4 * SKIP NEXT NON-BLANK CHARACTER, AND 4F12435
TIX C3405,2,1 REPEAT PROCESS FOR 5 CONSTANTS. 4F12436
TSX C0190,4 * EXAMINE NEXT NON-BLANK CHARACTER, 4F12437
TSX TESTD0,4 * WHICH SHOULD BE AN ENDMK. 4F12438
TXI CA010,0 * EXIT TO PROCESS NEXT STATEMENT. 4F12439
REM END OF PROGRAM C3400. 4F12440
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12441
REM 4F12442
REM STATEA/3-PROCESS INPUT-OUTPUT STATEMENTS= 4F12443
REM 4F12444
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12445
REM 4F12446
REM RDC/ CALLS=INPUT,BEG,DIAG,ETMSW,LIB,CIT,JIF. 4F12447
REM RDC PROCESSES READ STATEMENTS. 4F12448
RDC CLA A81 SET THE ADDRESS FIELD OF 4F12449
STA ENT ENT (NTR000) TO 81. 4F12450
TSX INPUT,2 * GO COMPILE CAL *, AND XIT (LEV). 4F12451
CLA CSH PICKUP (CSH) TO 4F12452
REM TSC= ENTRY POINT USED BY RIT. 4F12453
TSC STO TSA SET TSA. 4F12454
CAL RTN MOVE (RTN) 4F12455
SLW END INTO END. 4F12456
CLA DBC PICKUP (DBC) TO 4F12457
REM TTC= ENTRY POINT USED BY RDP. 4F12458
TTC STO TTA SET TTA. 4F12459
TSX BEG,4 * CONVERT CONSTANT FORMULA NUMBER. 4F12460
TSX DIAG,4 * ATTEMPT TO USE VARIABLE FORMAT NO. 4F12461
TNZ 4,4 GO TO THE DIAGNOSTIC, IF THERE WAS 4F12462
TSX DIAG,4 * NO FORMAT NUMBER GIVEN. 4F12463
STA ST MOVE BINARY FORMAT NUMBER INTO SET.4F12464
CAL NTR MOVE NTR000 4F12465
SLW OP INTO OP. 4F12466
CAL TXLOP SET OP-SWITCHES. 4F12467
STP ETMSW ETMSW AND LTMSW, 4F12468
STP LTMSW TO NO TRANSFER CASE. 4F12469
TSX ETMSW,4 * GO COMPILE ETM. 4F12470
TSX LIB,4 * MAKE CLOSUB ENTRY, AND COMPILE= 4F12471
PZE L(0) WORD1--000000 4F12472
PZE CAL WORD2--CAL000 4F12473
PZE TTA WORD3--(DBC) OR (BDC) 4F12474
PZE L(0) WORD4--000000 4F12475
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12476
PZE L(0) WORD1--000000 4F12477
PZE SLW WORD2--SLW000 4F12478
PZE L(0) WORD3--000000 4F12479
PZE D1 WORD4--001000 4F12480
TSX LIB,4 * MAKE CLOSUB ENTRY, AND COMPILE= 4F12481
PZE L(0) WORD1--000000 4F12482
PZE CAL WORD2--CAL000 4F12483
PZE TSA WORD3--(CSH) OR (TSH) 4F12484
PZE L(0) WORD4--000000 4F12485
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12486
PZE TL WORD1--0(IFN)0(248) 4F12487
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 082/082 ------
PZE ENT WORD2--NTR0(81, OR UNIT, OR 00) 4F12488
PZE SET WORD3--800(FORMAT NUMBER) 4F12489
PZE L(0) WORD4--000000 4F12490
TSX JIF,4 * GO JUMP IFN, AND SET SL AND TL. 4F12491
REM BXT = EXIT SWITCH TO RSC OR LAST, USED BY WBT,RBT,WRD. 4F12492
BXT TXI RSC,0 * EXIT TO SCAN LIST, IF THERE IS ONE.4F12493
REM END OF PROGRAM RDC. 4F12494
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12495
REM 4F12496
REM RIT/ CALLS=INPUT,BEG,VRD. USES=RDC. 4F12497
REM RIT PROCESSES READ INPUT TAPE STATEMENTS. 4F12498
RIT TSX INPUT,2 * GO COMPILE CAL *, AND XIT (LEV). 4F12499
TSX BEG,4 * SCAN AND TEST TYPE OF UNIT SYMBOL. 4F12500
TSX VRD,4 * IF VARIABLE, ENTER FORVAR AND CITS.4F12501
STA ENT IF CONSTANT, SET ENT= NTRO(UNIT). 4F12502
CLA TSH PICKUP (TSH) TO SET TSA, AND 4F12503
TXI TSC,0 * CONTINUE BY USING PROGRAM RDC. 4F12504
REM END OF PROGRAM RIT. 4F12505
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12506
REM 4F12507
REM RDP/ CALLS=OUTPUT. USES=RDC. 4F12508
REM RDP PROCESSES PRINT STATEMENTS. 4F12509
RDP PXD ,0 RESET ENT 4F12510
STA ENT TO NTR000. 4F12511
TSX OUTPUT,2 * GO COMPILE CAL *, AND XIT (LEV). 4F12512
CLA SPH PICKUP (SPH), AND 4F12513
REM TSD = ENTRY POINT USED BY WOT, PDC. 4F12514
TSD STO TSA SET TSA. 4F12515
CAL FIL MOVE (FIL) 4F12516
SLW END INTO END. 4F12517
CLA BDC PICKUP (BDC) TO SET TTA, AND 4F12518
TXI TTC,0 * CONTINUE BY USING PROGRAM RDC. 4F12519
REM END OF PROGRAM RDP, 4F12520
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12521
REM 4F12522
REM WOT/ CALLS=OUTPUT,BEG,VRD. USES=RDP. 4F12523
REM PROCESSES WRITE OUTPUT TAPE STATEMENTS. 4F12524
WOT TSX OUTPUT,2 * GO COMPILE CAL *, AND XIT (LEV). 4F12525
TSX BEG,4 * SCAN AND TEST TYPE OF UNIT SYMBOL. 4F12526
TSX VRD,4 * IF VARIABLE, ENTER FORVAR AND CITS.4F12527
STA ENT IF CONSTANT, SET ENT= NTRO(UNIT). 4F12528
CLA STH PICKUP (STH) TO SET TSA, AND 4F12529
TXI TSD,0 * CONTINUE BY USING PROGRAM RDP. 4F12530
REM END OF PROGRAM WOT. 4F12531
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12532
REM 4F12533
REM PDC/ CALLS=OUTPUT. USES=RDP. 4F12534
REM PROCESSES PUNCH STATEMENTS. 4F12535
PDC PXD ,0 RESET ENT 4F12536
STA ENT TO NTR000. 4F12537
TSX OUTPUT,2 * GO COMPILE CAL *, AND XIT (LEV). 4F12538
CLA SCH PICKUP (SCH) TO SET TSA. AND 4F12539
TXI TSD,0 * CONTINUE BY USING PROGRAM RDP. 4F12540
REM END OF PROGRAM PDC. 4F12541
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 083/083 ------
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12542
REM 4F12543
REM WBT/ CALLS=OUTPUT,BRW,CIT, 4F12544
REM WBT PROCESSES WRITE TAPE STATEMENTS, 4F12545
WBT CAL WTB MOVE WTB000 4F12546
SLW OP INTO OP. 4F12547
TSX OUTPUT,2 * GO COMPILE CAL *, AND XIT (LEV), 4F12548
CAL BTA PICKUP BINARY TAPE ADDRESS, AND 4F12549
TSX BRW,4 * COMPILE INSTRS TO SET UNIT DESIG. 4F12550
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12551
PZE L(0) WORD1-000000 4F12552
PZE CPY WORD2-CPY000 4F12553
PZE ZER WORD3-600000 4F12554
PZE D2 WORD4-002000 4F12555
TXI BXT,0 * EXIT TO SCAN LIST, IF THERE IS ONE,4F12556
REM END OF PROGRAM WBT, 4F12557
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12558
REM 4F12559
REM RBT/ CALLS=INPUT,BRW,CIT, 4F12560
REM RBT PROCESSES READ TAPE STATEMENTS. 4F12561
RBT CAL RTB MOVE RTB000 4F12562
SLW OP INT OP. 4F12563
TSX INPUT,2 * GO COMPILE CAL *, AND XIT (LEV), 4F12564
CAL BTA PICKUP BINARY TAPE ADDRESS, AND 4F12565
TSX BRW,4 * COMPILE INSTRS TO SET UNIT DESIG. 4F12566
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12567
PZE L(0) WORD1-000000 4F12568
PZE CPY WORD2-CPY000 4F12569
PZE DMP WORD3-100000 4F12570
PZE L(0) WORD4-000000 4F12571
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12572
PZE L(0) WORD1-000000 4F12573
PZE XIT WORD2-XIT000 4F12574
PZE 15P WORD3-*00000 4F12575
PZE D3CN WORD4-003000 4F12576
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12577
PZE L(0) WORD1-000000 4F12578
PZE HPR WORD2-HPR000 4F12579
PZE L(0) WORD3-000000 4F12580
PZE L(0) WORD4-000000 4F12581
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12582
PZE L(0) WORD1-000000 4F12583
PZE XIT WORD2-XIT000 4F12584
PZE TL WORD3-0(IFN)0(248) 4F12585
PZE L(0) WORD4-000000 4F12586
TXI BXT,0 * EXIT TO SCAN LIST, IF THERE IS 0N4F12587
REM END OF PROGRAM RBT. 4F12588
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12589
REM 4F12590
REM WRD/ CALLS=OUTPUT,BRW,CIT, 4F12591
REM WRD PROCESSES WRITE DRUM STATEMENTS. 4F12592
WRD TSX OUTPUT,2 * GO COMPILE CAL *, AND XIT (LEV), 4F12593
CAL WDR PICKUP WDR000, AND 4F12594
REM XDR= ENTRY POINT USED BY RDD. 4F12595
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 084/084 ------
XDR SLW OP SET OP. 4F12596
CAL BDA PICKUP BINARY DRUM ADDRESS, AND 4F12597
TSX BRW,4 * COMPILE INSTRS TO SET UNIT DESIG. 4F12598
CAL PXD MOVE PXD000 4F12599
SLW OP INTO OP. 4F12600
PXD ,0 CLEAR THE AC AND 4F12601
TSX BRW,4 * COMPILE INSTRS TO SET DRUM LOC. 4F12602
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12603
PZE L(0) WORD1--000000 4F12604
PZE LDA WORD2--LDA000 4F12605
PZE TL WORD3--0(IFN)0(248) 4F12606
PZE L(0) WORD4--000000 4F12607
TXI BXT,0 * EXIT TO SCAN LIST, IF THERE IS ONE.4F12608
REM END OF PROGRAM WRD. 4F12609
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12610
REM 4F12611
REM RDD/ CALLS=INPUT. USES=WRD, 4F12612
REM RDD PROCESSES READ DRUM STATEMENTS. 4F12613
RDD TSX INPUT,2 * GO COMPILE CAL *, AND XIT (LEV), 4F12614
CAL RDR PICKUP RDR000 TO SET OP, AND 4F12615
TXI XDR,0 * CONTINUE BY USING PROGRAM WRD. 4F12616
REM END OF PROGRAM RDD. 4F12617
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12618
REM 4F12619
REM EFT/ CALLS=GIF,BEG,VRAX,CIT, 4F12620
REM EFT PROCESSES WRITE END OF FILE STATEMENTS. 4F12621
EFT CAL WEF PICKUP WEF000, AND 4F12622
REM TPO= ENTRY POINT USED BY RWN, BSP, 4F12623
TPO SLW OP SET OP. 4F12624
CAL BTA MOVE BINARY TAPE ADDRESS 4F12625
SLW CON INTO CON. 4F12626
TSX GIF,4 * GET IFN INTO SL AND TL, 4F12627
CLA L(SL) RESET TPOA ADDRESS 4F12628
STA TPOA TO SL. 4F12629
TSX BEG,4 * SCAN AND TEST TYPE OF UNIT SYMBOL. 4F12630
TSX VRA,4 * IF VARIABLE, ENTER FORVAR AND CITS. 4F12631
ALS 18 IF CONSTANT, ADJUST AND 4F12632
STO RA PLACE IN THE DECREMENT OF RA. 4F12633
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12634
TPOA PZE SL WORD1--0(IFN)000 OR 0(IFN)0(248) 4F12635
PZE OP WORD2--(WEF,REW,OR BSP)000 4F12636
PZE L(0) WORD3--000000 4F12637
PZE RA WORD4--0(CON)000 OR 000000 4F12638
TXI FINI,0 * GO RESET BXT, AND TEST FOR EFN. 4F12639
REM END OF PROGRAM EFT. 4F12640
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12641
REM 4F12642
REM RWN/ USES=EFT, 4F12643
REM RWN PROCESSES REWIND TAPE STATEMENTS. 4F12644
RWN CAL REW PICKUP REW000 TO SET OP, AND 4F12645
TXI TPO,0 * CONTINUE BY USING PROGRAM EFT. 4F12646
REM END OF PROGRAM RWN. 4F12647
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12648
REM 4F12649
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 085/085 ------
REM BSP/ USES=EFT, 4F12650
REM BSP PROCESSES BACKSPACE TAPE STATEMENTS. 4F12651
BSP CAL BST PICKUP BST000 TO SET OP, AND 4F12652
TXI TPO,0 * CONTINUE BY USING PROGRAM EFT, 4F12653
REM END OF PROGRAM BSP. 4F12654
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12655
REM FOR/ CALLS=TET00, 4F12657
REM FOR PROCESSES FORMAT STATEMENTS. 4F12658
FOR CAL EIFNO MOVE EXTERNAL FORMULA NUMBER 4F12659
STA SET INTO THE ADDRESS OF SET, 4F12660
CAL SET AND MOVE SET (8000(EFN)) 4F12661
SLW G INTO G. 4F12662
LXD CHCTR,1 SET XR1 = CHARACTER COUNT. 4F12663
LXD FWA,2 SET XR2 = -(CURRENT F-WORD ADDR), 4F12664
TXL NFFW,1,1 UNLESS POSITIONED AT THE 4F12665
TXI *+1,1,-1 BEGINNING OF A FORMAT WORD, 4F12666
LDQ RESIDU THEN PICKUP AND 4F12667
CAL BLANKS PRECEED WITH BLANKS ANY 4F12668
NFC LGL 6 CHARACTERS 4F12669
TIX NFC,1,1 REMAINING IN THE MO, AND 4F12670
NFW SLW G+1 MOVE FORMAT WORDS INTO G+1. 4F12671
TSX TET00,1 * GO ENTER THEN IN 4F12672
PZE 10 THE FORMAT TABLE. 4F12673
CAL G+1 WHEN THE 4F12674
ANA ENDMK END OF STATEMENT MARK 4F12675
SUB ENDMK HAS BEEN ENTERED. 4F12676
TZE CA010 * EXIT TO PROCESS NEXT STATEMENT. 4F12677
STZ G PRECEED ALL BUT 1ST ENTRY WITH 0. 4F12678
NFFW CAL 0,2 PICKUP NEXT FORMAT WORD, 4F12679
TXI NFW,2,-1 UPDATE SCAN INDEX, AND CONTINUE. 4F12680
REM END OF PROGRAM FOR. 4F12681
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12682
REM 4F12683
REM RSC/ CALLS=C0190,DIAG, 4F12684
REM RSC SCANS EACH CHARACTER IN A STATEMENT UNTIL EQUALITY IS 4F12685
REM FOUND ON ONE OF THE PUNCTUATION MARKS IN THE CTEST BLOCK IN 4F12686
REM COMMON. THEN A TAGGED EXIT IS MADE THROUGH THE BLOCK OF 4F12687
REM CONTROL TRANSFERS INDICATED BY THE ADDRESS STORED IN CEXIT. 4F12688
REM RSC = ENTRY POINT FROM THE BXT SWITCH IN RDC, AND FROM SPC. 4F12689
RSC CAL FLINE RESET TEMPORARY 4F12690
STA TLINE TABLE LINE COUNTER. 4F12691
STZ DOLEV CLEAR DO LEVEL COUNTER. 4F12692
STZ GTAG CLEAR GENERALIZED TAG. 4F12693
REM LSC = ENTRY POINT FROM SPC. 4F12694
LSC CAL LISTR SET CONTROL TRANSFER 4F12695
REM CXS = ENTRY POINT FROM EOS, BEG. 4F12696
CXS STA CEXIT FOR LIST SCAN. 4F12697
REM NXS = ENTRY POINT FROM LPR, SPC, CMA. 4F12698
NXS LXA L(6),2 RESET SYMBOL CHARACTER COUNT 4F12699
SXD CSJ,2 AND SHIFT COUNT. 4F12700
STZ SYM CLEAR SYMBOL WORKING STORAGE. 4F12701
REM NXC = ENTRY POINT FROM CMA. 4F12702
NXC TSX C0190,4 * OBTAIN NEXT NB CHARACTER IN THE AC. 4F12703
CLOAD LXA CTESTX,4 SET XR4 TO PICK CONTROL CHARACTERS. 4F12704
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 086/086 ------
CCOMP CAS CTEST,4 COMPARE CHARACTER WITH CONSTANTS. 4F12705
TXL BUILD,0 IF EQUALITY IS FOUND ON SOME 4F12706
CEXIT TRA **,4 * CONTROL CHAR, EXIT TO TRA LIST. 4F12707
TIX CCOMP,4,1 CONTINUE THROUGH PUNCTUATION. 4F12708
BUILD LXD CSJ,4 BUILD A 4F12709
STO CHR,4 SYMBOL 4F12710
TNX LCT,4,1 COMPOSED OF 4F12711
ALS 36,2 SIX OR LESS CHARACTERS. 4F12712
CSZ SXD CSJ,4 SAVE SYMBOL CHARACTER COUNT, 4F12713
ORS SYM ALSO, SAVE EACH 4F12714
TXI NXC,2,6 CHARACTER SEPARATELY. 4F12715
LCT TXL LCS,2,36 GO TO DIAGNOSTIC IF 4F12716
TSX DIAG,4 * MORE THAN 6 CHARACTERS IN SYMBOL, 4F12717
LCS TXI CSZ,4,-1 ADJUST COUNT, AND CONTINUE SCAN. 4F12718
REM END OF PROGRAM RSC. 4F12719
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12720
REM 4F12721
REM LISTR/ CONTROL TRANSFERS FOR LIST SCAN= 4F12722
TXI EMK,0 * ENDMARK 4F12723
TXI LPR,0 * ( 4F12724
TXI CMA,0 * , 4F12725
TXI RPR,0 * ) 4F12726
TXI EQS,0 * * 4F12727
TXI ILC,0 - (ILLEGAL CHARACTER IN I/O LIST). 4F12728
ILC TSX DIAG,4 * / (ILLEGAL CHARACTER IN I/O LIST). 4F12729
TXI ILC,0 . (ILLEGAL CHARACTER IN I/O LIST). 4F12730
TXI ILC,0 + (ILLEGAL CHARACTER IN I/O LIST). 4F12731
TXI ILC,0 * (ILLEGAL CHARACTER IN I/O LIST). 4F12732
LISTR PZE LISTR INDEXING ADDRESS FOR ABOVE LIST. 4F12733
REM ******* ************************* 4F12734
REM 4F12735
REM LPR/ CALLS=TYP,SS000,RA000,C0190,TEST,.,LTMSW,CIT,JIF,DIAG, 4F12736
REM BSS. USES=CMA,RSC, 4F12737
REM LPR * ENTRY POINT TAKEN WHEN LPAREN IS MET IN LIST SCAN. 4F12738
LPR CAL SYM TEST FOR SUBSCRIPT OR DO NEST. 4F12739
TZE LPRD IF SUBSCRIPT, THEN 4F12740
TSX TYP,4 * IF VARIABLE SYMBOL CONTAINS LESS 4F12741
TRA 3,4 THAN 6 CHARACTERS, ADD A BLANK, 4F12742
TXI ERRC,0 * ON CONSTANT RETURN, GO TO DIAG, 4F12743
CAL SYM MOVE SYMBOL 4F12744
SLW E+2 INTO E+2, AND 4F12745
SLW SA COMPILE SYMBOLIC ADDRESS, 4F12746
TSX SS000,4 * GO SCAN AND PROCESS SUBSCRIPT. 4F12747
TSX RA000,4 * THEN GO COMPUTE RELATIVE ADDRESS. 4F12748
TSX C0190,4 * EXAMINE NEXT NON-BLANK CHARACTER 4F12749
CAS CLOS 4F12750
TRA *+5 4F12751
TRA *+2 4F12752
TRA *+3 4F12753
STZ DOLEV 4F12754
TSX C0190,4 4F12755
TSX TESTA0,4 * FOR EITHER COMMA OR ENDMARK. 4F12756
TXI CMA7,0 * AND CONTINUE BY USING PROGRAM CMA. 4F12757
LPRD CAL DOLEV IF THE BEGINNING OF A DO NEST, 4F12758
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 087/087 ------
TZE LPR3 AND DOLEV IS NOT ZERO, THEN 4F12759
LXA DOLEV,4 TEST FOR NULL FORMULA. 4F12760
TXL LPRE,4,0 IF NULL, GO ESTABLISH POSITION. 4F12761
TSX LTMSW,4 * OTHERWISE, COMPILE LTM, AND 4F12762
TXI LPR4,0 AND GO JUMP IFN. 4F12763
LPRE CAL SL IF C(SL) DO NOT = 0, 4F12764
TZE *+2 THEN 4F12765
TSX BSS,2 * GO COMPILE= IFN BSS 0, 4F12766
LPR4 TSX JIF,4 * GO JUMP IFN, AND SET SL AND TL. 4F12767
LPR3 LXD DOLEV,4 INCREASE THE C(DOLEV D) 4F12768
TXI LPR1,4,1 BY 1, AND 4F12769
LPR1 PXD ,4 SET THE C(DOLEV A) 4F12770
SLW DOLEV TO ZERO, 4F12771
CAL TLINE NOTE AT 4F12772
STA LPR2 THIS LEVEL 4F12773
STO DOLEV,4 THE LOCATION IN TLDO 4F12774
ADD L(5) OF THIS DO FORMULA 4F12775
STA TLINE AND INCREASE LINE IN TLINE. 4F12776
CLS TL MOVE -(0(IFN)0(248)) INTO THE 4F12777
LPR2 STO ** LOCATION WORD OF CURRENT TEMP DO. 4F12778
TSX JIF,4 * GO JUMP IFN, AND SET SL AND TL. 4F12779
LXD DOLEV,4 IF 3 OR FEWER LEVELS IN LIST DO, 4F12780
TXL NXS,4,3 * RETURN TO LIST SCAN. 4F12781
TSX DIAG,4 * OTHERWISE, GO TO DIAGNOSTIC 4F12782
REM END OF PROGRAM LPR. 4F12783
REM ******* *********************** 4F12784
REM 4F12785
REM EQS/ CALLS=DIAG, USES=RSC 4F12786
REM EQS = ENTRY POINT WHEN EQUAL SIGN IS MET IN LIST CAN, 4F12787
EQS LXD DOLEV,4 TEST THE LEGALITY OF EQUAL SIGN, 4F12788
TXH EQS2,4,0 AND GO TO DIAG ON THE ATTEMPT TO 4F12789
TSX DIAG,4 * SPECIFY SUBSCRIPT RANGE WITHOUT (. 4F12790
EQS2 CAL DOLEV,4 INITIALIZE SPECIFICATION 4F12791
STA SPC2 OF GENERATED DO FORMULA 4F12792
STA SPC5 AT CURRENT LEVEL. 4F12793
ADD L(1) PREPARE TO ENTER FORMULA NUMBERS 4F12794
STA EQS1 IN LOCATION WORD*SUBSCRIPT IN 4F12795
ADD L(4) SYMBOL WORD, AND SUBSCRIPT SPECS 4F12796
STA SPC3 IN TEMPDO ENTRY. 4F12797
LXA L(3),4 PREPARE TO COUNT THE 4F12798
SXD NSJ,4 NUMBER OF SPECIFICATIONS. 4F12799
CAL SYM OBTAIN SUBSCRIPT 4F12800
TXH EQS1,2,36 FOR THIS DO, AND 4F12801
CAL BLANK STORE IN PROPER 4F12802
ALS 36,2 LINE OF TEMPORARY 4F12803
ORA SYM LIST DO TABLE. 4F12804
EQS1 SLW ** (SUBSCRIPT SYMBOL WORD) 4F12805
CAL SPCTR SET CONTROL LOOP FOR 4F12806
NSJ TXI CXS,0,** * EXIT TO SPECIFICATION 4F12807
REM END OF PROGRAM EQS. 4F12608
REM ******* *********************** 4F12809
REM 4F12810
REM SPCTR/ CONTROL TRANSFERS FOR SPECIFICATION SCAN= 4F12811
TSX DIAG,4 * E (ILLEGAL IN CONTROL FOR LIST DO). 4F12812
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 088/088 ------
ICC TSX DIAG,4 * ( (ILLEGAL IN CONTROL FOR LIST DO). 4F12813
TXI SPC,0 * , 4F12814
TXI SPCX,0 * ) 4F12815
TXI ICC,0 = (ILLEGAL IN CONTROL FOR LIST DO). 4F12816
TXI ICC,0 - (ILLEGAL IN CONTROL FOR LIST DO). 4F12817
TXI ICC,0 / (ILLEGAL IN CONTROL FOR LIST DO). 4F12818
TXI ICC,0 . (ILLEGAL IN CONTROL FOR LIST DO). 4F12819
TXI ICC,0 + (ILLEGAL IN CONTROL FOR LIST DO). 4F12820
TXI ICC,0 * (ILLEGAL IN CONTROL FOR LIST DO). 4F12821
SPCTR PZE SPCTR INDEXING ADDRESS FOR ABOVE LIST. 4F12822
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F12823
REM 4F12824
REM SPC/ CALLS=TYP,LTMSW,JIF,TET00. USES=R5C 4F12825
REM SPCX = ENTRY POINT WHEN RPAREN IS MET IN SPECIFICATION SCAN. 4F12826
SPCX CAL SPC1 PREPARE FOR END OF SPECIFICATION. 4F12827
STO SPC1 SET SPC1 OP-SWITCH TO NOP CASE. 4F12828
REM SPC = ENTRY POINT WHEN COMMA IS MET IN SPECIFICATION SCAN. 4F12829
SPC TSX TYP,4 * GO TEST TYPE OF SUBSCRIPT SPEC. 4F12830
TXI SPCS,0 IF FIXED POINT CONSTANT, 4F12831
LXD NSJ,4 SET C(XR4) = SPECIFICATION COUNT, 4F12832
TXI SPC3,0 AND GO ENTER CONSTANT IN TABLE. 4F12833
SPCS LXD NSJ,4 OTHERWISE, SET SPEC COUNT AND 4F12834
CAL TAG4 IF VARIABLE, NOTE BY 4F12835
ARS 3,4 PLACING BIT IN TAG FIELD 4F12636
SPC2 ORS ** OF TABLE ENTRY. 4F12837
CAL SYM PICKUP VARIABLE SYMBOL AND 4F12838
SPC3 SLW **,4 ENTER N SUB J IN TABLE. 4F12839
TNX SPC4,4,1 REDUCE J. 4F12840
SXD NSJ,4 SAVE SPEC COUNT, AND 4F12841
SPC1 TXL NXS,0 * EXIT TO SCAN, IF SWITCH IS TXL. 4F12842
CAL L(1) SET N SUB 3 = 1 IF NOT 4F12843
TXI SPC3,0 OTHERWISE SPECIFIED. 4F12844
SPC4 CLS SPC1 RESTORE SPC1 EXIT. 4F12845
STO SPC1 (3 SPECS HAVE BEEN TREATED) 4F12846
CAL EIFNO ALSO RESTORE INTERNAL FORMULA NO. 4F12847
ARS 18 (PUT BETA IN TEMPDO TABLE) 4F12848
REM SPC5 = ENTRY POINT USED BY RPR. 4F12849
SPC5 STA ** SET BETA EQUAL TO IFNO. 4F12850
LXA DOLEV,4 EXAMINE DOLEV ADDRESS FOR ZERO TO 4F12851
TXL SPCR,4,4 TEST NEED FOR LTM, JLF AFTER ). 4F12352
TSX LTMSW,4 * GO COMPILE LTM. 4F12853
TSX JIF,4 * GO JUMP IFN, AND SET SL AND TL. 4F12654
SPCR LXD DOLEV,4 DECREASE DOLEV D 4F12855
TXI SPC6,4,-1 BY 1, AND INDICATE A TREATED LEVEL. 4F12656
SPC6 PXD ,4 IF NOT ZERO, 4F12857
SLW DOLEV THEN ALL LEVELS ARE NOT TREATED. 4F12858
TXH LSC,4,0 * RETURN TO SCAN NEXT LEVEL. 4F12659
CLA TLINE IF LEVEL IS ZERO 4F12860
STA SPC7 ENTER GENERATED 4F12861
FLINE PAX TLDOS,2 DO FORMULAS IN TDO BY 4F12862
TXI *+1,2,- TLDOS SUBROUTINE TET. 4F12663
SPC9 LXA L(5),4 (MOVE EACH 4F12864
SPC7 CLA **,2 TEMPDO TABLE ENTRY 4F12865
STO 1C+5,4 INTO 1C...1C+4, 4F12866
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 089/089 ------
TNX SPC8,2,1 AND THEN 4F12867
TIX SPC7,4,1 WHEN DONE, 4F12868
SPC8 LXA 1C,4 TEST TO SKIP 4F12869
TXL SPCT,4,0 NULL DO, 4F12870
TSX TET00,1 * GO MAKE AN ENTRY 4F12871
PZE 1 IN TDO TABLE.)AND WHEN THE WHOLE 4F12872
SPCT TXH SPC9,2,1 DO NEST HAS BEEN ENTERED, 4F12873
TSX JIF,4 * GO JUMP IFN, AND SET SL AND TL. 4F12874
RESET TXI RSC,0 * THEN EXIT TO CONTINUE LIST SCAN. 4F12875
REM END OF PROGRAM SPC, 4F12876
REM ******* *********************** 4F12877
REM 4F12878
REM RPR/ CALLS=DIAG,USES=CMA,SPC 4F12879
REM RPR = ENTRY POINT WHEN RPAREN IS MET IN LIST SCAN. 4F12880
RPR LXD DOLEV,4 TEST LEGALITY OF ), 4F12881
TXH RPS,4,0 IF THERE ARE TOO MANY I IN LIST, 4F12882
TSX DIAG,4 * GO TO THE DIAGNOSTIC 4F12883
RPS CAL DOLEV,4 NULLIFY DO AT CURRENT LEVEL. 4F12884
STA SPC5 SET SPC5 ADDRESS, 4F12885
CLA RPA SET CMA3 SWITCH TO RETURN TO 4F12886
STA CMA3 RPT, AND IF ANY CHARACTERS 4F12887
TXH CMA1,2,6 * WERE COLLECTED, EXIT TO CMA. 4F12888
REM RPT = R EENTRY POINT USED BY CMA. 4F12889
RPT CLA SPC1 RESET CMA3 SWITCH 4F12890
STA CMA3 TO NXS, 4F12891
RPA PXD RPT,0 CLEAR THE AC AND 4F12892
TXI SPC5,0 * CONTINUE BY USING PROGRAM SPC. 4F12893
REM END OF PROGRAM RPR. 4F12894
REM ******* *********************** 4F12895
REM 4F12896
REM CMA/ CALLS=TYP,DIAG,ETMSW,DIM.SR,IFFIX,TET00,DRTABS,JIF,CIT, 4F12897
REM LTMSW. USES=RSC 4F12898
REM CMA = ENTRY POINT WHEN COMMA IS MET IN LIST SCAN. 4F12899
CMA TXL NXC,2,6 * IF NOTHING COLLECTED, RETURN -SCAN. 4F12900
REM CMA1 = ENTRY POINT USED BY EMK. 4F12901
CMA1 TSX TYP,4 * TYPE TEST FOR NON-SUBSCR. VAR. 4F12902
TRA 3,4 ILLEGAL USE OF CONSTANT IN LIST, 4F12903
ERRC TSX DIAG,4 * GO TO THE DIAGNOSTIC 4F12904
CAL SYM MOVE VARIABLE SYMBOL 4F12905
CMA4 SLW SA INTO SA. AND 4F12906
REM CMA7 = ENTRY POINT USED BY LPR. 4F12907
CMA7 LXA DOLEV,4 IF DOLEV ADDRESS = 0, AND IF 4F12908
TXH CMA6,4,0 ETMSW IS SET TO TXH (NOP CASE), 4F12909
TSX ETMSW,4 * GO COMPILE ETM, AND CLEAR SL. 4F12910
CMA6 CAL DOLEV IN ANY CASE, 4F12911
ADD L(1) UPDATE DOLEV ADDRESS 4F12912
STO DOLEV BY 1, AND THEN 4F12913
CLA GTAG SET GENERALIZED TAG* 4F12914
STO RA (RELATIVE ADDRESS) 4F12915
TZE DIMSR IF THIS VARIABLE HAS A SUBSCRIPT, 4F12916
CLA EPS AND IF SUBSCRIPT 4F12917
TNZ CMA5 IS A CONSTANT, 4F12918
STA RA THEN CLEAR THE ADDRESS OF RA. 4F12919
TXI CMA5,0 THEN GO MAKE CIT ENTRY. 4F12920
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 090/090 ------
DIMSR CAL SA IF THIS VARIABLE 4F12921
SLW E+2 DOES NOT HAVE A SUBSCRIPT, THEN 4F12922
RD1 TSX DIM1SR,4 * GO SEARCH DIM1 TABLE, 4F12923
TXI RD2,0 IF FOUND, THEN 4F12924
CS1 CLA D12 PICKUP DIMENSION 1 4F12925
TXI DVS,0 AND GO TEST SIZE. OTHERWISE, 4F12926
RD2 TSX DIM2SR,4 * GO SEARCH DIM2 TABLE. 4F12927
TXI RD3,0 AND IF FOUND, 4F12928
CS2 LDQ D12 PICKUP 4F12929
STZ N2 DIMENSION 1 AND 4F12930
SLQ N2 DIMENSION 2 4F12931
LGL 18 AND MULTIPLY 4F12932
MPY N2 THEM TOGETHER. 4F12933
ARS 1 THEN 4F12934
TXI DVS,0 GO TEST THE PRODUCT. OTHERWISE, 4F12935
RD3 TSX DIM3SR,4 * GO SEARCH DIM3 TABLE. 4F12936
TXI NODIM,0 AND IF FOUND, 4F12937
CS3 LDQ D12 PICKUP 4F12938
STZ N2 DIMENSION 1, 4F12939
SLQ N2 DIMENSION 2, 4F12940
LGL 18 AND DIMENSION 3. 4F12941
MPY N2 MULTIPLY 4F12942
LRS 18 THEM TOGETHER, 4F12943
MPY D3 AND IF 4F12944
LLS 17 THEIR 4F12945
DVS SUB L(1) PRODUCT IS 4F12946
TZE NODIM GREATER THAN 1, THEN 4F12947
ALS 18 PLACE DIMENSION-1 IN THE 4F12948
STO G DECREMENT OF G, AND 4F12949
TSX FXCNIX,4 * GO ENTER IN FIXCON, AND GET TAG. 4F12950
ALS 18 ADJUST, AND STORE TAG IN THE 4F12951
STD RAT DECREMENT OF RAT. THEN 4F12952
TSX JIF,4 * GO JUMP IFN, AND SET SL AND TL. 4F12953
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12954
PZE SL WORD1--0(IFN)000 4F12955
PZE LXD WORD2--LXD000 4F12956
PZE 2P WORD3--200000 4F12957
PZE RAT WORD4--0(FIXCON TAG)008 4F12958
TSX JIF,4 * GO JUMP IFN, AND SET SL AND TL. 4F12959
TSX ETMSW,4 * IF LTMSW = NOP, COMPILE LTM. SL=0. 4F12960
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12961
PZE SL WORD1--0(IFN)000 OR 000000 4F12962
PZE OP WORD2--(OPERATION CODE) 4F12963
PZE SA WORD3--(SYMBOLIC ADDRESS) 4F12964
PZE ST WORD4--000008 4F12965
STZ SL CLEAR SL, AND 4F12966
TSX LTMSW,4 * IF LTMSW = NOP, COMPILE LTM. SL=0. 4F12967
TSX GIF,4 * GET IFN IN SL AND TL. 4F12968
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12969
PZE L(0) WORD1--000000 4F12970
PZE TIX WORD2--TIX001 4F12971
PZE SL WORD3--0(IFN)000 4F12972
PZE ST WORD4--000008 4F12973
STZ SL CLEAR SL, AND 4F12974
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 091/091 ------
TSX ETMSW,4 * IF ETMSW = NOP, COMPILE ETM, SL=0. 4F12975
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12976
PZE L(0) WORD1--000000 4F12977
PZE DED WORD2--DED000 4F12978
PZE L(0) WORD3--000000 4F12979
PZE ST WORD4--000008 4F12980
TXI CMA5,0 IF THE PRODUCT OF DIMENSIONS IS 4F12981
NODIM TSX IFFIX,1 * LESS THAN 2, TEST TYPE OF VARIABLE, 4F12982
TXI CMA5,0 AND IF FIXED POINT, 4F12983
TSX TET00,1 * GO ENTER VARIABLE IN 4F12984
INOUT PZE ** EITHER FORVAL OR FORVAR TABLE. 4F12985
CMA5 TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F12986
PZE SL WORD1--0(IFN)000 OR 000000 4F12987
PZE OP WORD2--NTR000 OR CPY000 4F12988
PZE SA WORD3--(SYMBOL) 4F12989
PZE RA WORD4--(RELATIVE ADDRESS) 4F12990
STZ SL CLEAR SL, AND 4F12991
STZ GTAG CLEAR GTAG. THEN TAKE EXIT 4F12992
CMA3 TXI NXS,0 * SWITCH TO RPT OR NXS, 4F12993
REM END OF PROGRAM CMA. 4F12994
REM ******* *********************** 4F12995
REM 4F12996
REM EMK/ CALLS=DIAG,LTMSW,JIF,CIT,LIB,TET00, USES=CMA, 4F12997
REM EMK = ENTRY POINT WHEN AN ENDMARK IS MET IN LIST SCAN. 4F12998
EMK TXH CMA1,2,6 * IF NO CHARACTERS REMAIN, THEN 4F12999
LXD DOLEV,4 CHECK THE NUMBER OF PARENTHESES. 4F13000
TXL FIN,4,0 IF THERE ARE TOO MANY LPARENS, 4F13001
TSX DIAG,4 * GO TO THE DIAGNOSTIC OTHERWISE, 4F13002
FIN TSX LTMSW,4 * IF LTMSW = NOP, COMPILE LTM. SL=0. 4F13003
TSX JIF,4 * GO JUMP IFN, AND SET SL AND TL. 4F13004
REM LAST = ENTRY POINT SET BY BXT SWITCH. 4F13005
LAST TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F13006
PZE SL WORD1--0(IFN)000 4F13007
PZE CAL WORD2--CAL000 4F13008
PZE 15P WORD3--*00000 4F13009
PZE L(0) WORD4--000000 4F13010
TSX LIB,4 * MAKE CLOSUB ENTRY, AND COMPILE= 4F13011
PZE L(0) WORD1--000000 4F13012
PZE XIT WORD2--XIT000 4F13013
PZE END WORD3--(RTN) OR (FIL) 4F13014
PZE L(0) WORD4--000000 4F13015
REM FINI = ENTRY POINT USED BY EFT. 4F13016
FINI CLA RESET RESET BXT SWITCH 4F13017
STA BXT TO RSC. 4F13018
CLA F-1 TEST FOR AN EXTERNAL 4F13019
SUB 5BLANS STATEMENT NUMBER, AND IF NONE, 4F13020
TZE CA010 * EXIT TO PROCESS NEXT STATEMENT. 4F13021
CAL MINUS0 OTHERWISE, SET THE SIGN 4F13022
ORS EIFNO OF EIFNO TO MINUS, AND 4F13023
TSX TET00,1 * GO ENTER -(EIFNO) 4F13024
PZE 0 IN THE TEIFNO TABLE. 4F13025
CAL EIFNO THEN RESTORE 4F13026
STO EIFNO EIFNO, AND 4F13027
TXI CA010,0 * EXIT TO PROCESS NEXT STATEMENT. 4F13028
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 092/092 ------
REM END OF PROGRAM EMK. 4F13029
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F13030
REM 4F13031
REM STATEA/ 4-SUBROUTINES USED BY STATE A= 4F13032
REM
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
REM 4F13033
REM BEG(TYP),4/ CALLS=DIAG. USES RSC. 4F13034
REM BEG = ENTRY POINT USED BY RDC,RIT,WOT,EFT, 4F13035
BEG SXD BEX,4 SAVE C(XR4) FOR RETURN, 4F13036
CAL BEGTR SET CONTROL TRANSFER 4F13037
BEX TXI CXS,0,** * AND GO EXECUTE BEGINNING SCAN. 4F13038
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F13039
REM 4F13040
REM BEGTR/ CONTROL TRANSFERS FOR BEGINNING SCAN= 4F13041
TXI NLS,0 * ENDMARK (NO LIST SCAN) 4F13042
IBC TSX DIAG,4 * ( (ILLEGAL CHARACTER IN I/O SETUP).4F13043
TXI CMB,0 * , 4F13044
TXI IBC,0 ) (ILLEGAL CHARACTER IN I/O SETUP).4F13045
TXI IBC,0 = (ILLEGAL CHARACTER IN I/O SETUP).4F13046
TXI IBC,0 - (ILLEGAL CHARACTER IN I/O SETUP).4F13047
TXI IBC,0 / (ILLEGAL CHARACTER IN I/O SETUP).4F13048
TXI IBC,0 . (ILLEGAL CHARACTER IN I/O SETUP).4F13049
TXI IBC,0 + (ILLEGAL CHARACTER IN I/O SETUP).4F13050
TXI IBC,0 * (ILLEGAL CHARACTER IN I/O SETUP).4F13051
BEGTR PZE BEGTR INDEXING ADDRESS FOR ABOVE LIST. 4F13052
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F13053
REM 4F13054
REM NLS = ENTRY POINT WHEN AN ENDMARK IS MET IN BEGINNING SCAN. 4F13055
NLS CLA NLA IF ENDMARK IS MET, 4F13056
STA BXT SET BXT SWITCH TO LAST. 4F13057
REM CMB = ENTRY POINT WHEN A COMMA IS MET IN BEGINNING SCAN. 4F13058
CMB LXD BEX,4 RESTORE THE C(XR4), AND 4F13059
REM TYP = ENTRY POINT USED BY LPR,SPC,CMA, 4F13060
TYP CLA CHR-6 TEST FIRST CHARACTER 4F13061
SUB PLUS FOR VARIABLE 4F13062
TMI ABS OR CONSTANT. 4F13063
TXH SMB,2,36 IF VARIABLE. 4F13064
CAL BLANK ADD A BLANK 4F13065
ALS 36,2 IF SYMBOL CONTAINS 4F13066
ORS SYM LESS THAN 6 CHARACTERS, AND 4F13067
SMB TRA 1,4 * TAKE VARIABLE EXIT TO CALLER. 4F13068
ABS LXA L(5),2 IF CONSTANT* 4F13069
CLA CHR-1,2 THEN 4F13070
STO BIN CONVERT 4F13071
CSJ TXL INT,2,** BCD 4F13072
ALS 2 DIGITS 4F13073
ADD BIN TO THEIR 4F13074
ALS 1 BINARY 4F13075
ADD CHR,2 EQUIVALENT, 4F13076
TXI CSJ-1,2,-1 AND WHEN DONE, 4F13077
INT TRA 2,4 * TAKE CONSTANT EXIT TO CALLER. 4F13078
REM END OF PROGRAM BEG(TYP), 4F13079
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F13080
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 093/093 ------
REM 4F13081
REM BRW,4/ CALLS=JIF,BEG,VRA,CIT, CALLERS=WBT,RBT,WRD, 4F13082
BRW SXD XRW,4 SAVE THE C(XR4), AND 4F13083
SLW CON SET CON = 0 OR ,,144 OR ,,192, 4F13084
TSX JIF,4 * GO JUMP IFN, AND SET SL AND TL. 4F13085
TSX BEG,4 * GO SCAN AND TEST TYPE OF SYMBOL. 4F13086
TSX VRA,4 * IF VARIABLE, ENTER FORVAR AND CITS.4F13087
ALS 18 IF CONSTANT, ADJUST CONVERTED 4F13088
STO RA NUMBER, AND SET RA. 4F13089
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F13090
PZE TL WORD1--0(IFN)0(248) 4F13091
PZE OP WORD2--(WTB,RBT,WRD,RDD)000 4F13092
PZE L(0) WORD3--000000 4F13093
PZE RA WORD4--000000 OR 0(UNIT)000 4F13094
CAL CPY MOVE CPY000 4F13095
SLW OP INTO OP. 4F13096
CAL TXLOP SET OP-SWITCHES, 4F13097
STP ETMSW ETMSW AND LTMSW, 4F13098
STP LTMSW TO THE TRA CASE. 4F13099
CAL RTN MOVE (RTN) 4F13100
SLW END INTO END. 4F13101
STZ SL CLEAR SL, 4F13102
LXD XRW,4 RESTORE THE C(XR4), AND 4F13103
TRA 1,4 * EXIT TO CALLER. 4F13104
REM END OF PROGRAM BRW. 4F13105
REM ****************************** 4F13106
REM 4F13107
REM BSS,2/ CALLS=CIT00, CALLERS=LPR,C1600, 4F13108
REM BSS COMPILES= IFN BSS 0. 4F13109
BSS TSX CIT00,4 * GO MAKE FOLLOWING CIT ENTRY= 4F13110
PZE SL WORD1--0(IFN)000 4F13111
PZE L(BSS) WORD2--BSS000 4F13112
PZE L(0) WORD3--000000 4F13113
PZE L(0) WORD4--000000 4F13114
TRA 1,2 * EXIT TO CALLER+1. 4F13115
REM END OF PROGRAM BSS, 4F13116
REM ***************************** 4F13117
REM 4F13118
REM CA100,4 / CALLS=DIAG, CALLER=CA000, 4F13119
REM CA100 READS NEXT SOURCE PROGRAM CARD (1 TAPE RECORD), 4F13120
CA100 LXA TERC,2 PREPARE TO COUNT 4F13121
SXD 1G,2 TAPE READING ERRORS. 4F13122
RTT TURN OFF TAPE CHECK INDICATOR. 4F13123
NOP PROCEED TO NEXT INSTRUCTION. 4F13124
CA101 RDS 130 SELECT SOURCE TAPE FOR READING, 4F13125
LXA L(12),2 INITIALIZE INDEX B FOR 12 CYCLES OF4F13126
REM COPY LOOP. 4F13127
CA102 CPY FT+12,2 COPY INTO FT REGION 4F13128
TRA CA103 NEXT SOURCE PROGRAM CARD. 4F13129
TRA CA120 END OF FILE, GO FINISH LAST STATEM.4F13130
CA130 LXD 1G,2 TEST TAPE ERROR COUNTER 4F13131
TIX CA131,2,1 BY TRYING TO REDUCE BY 1. 4F13132
TSX DIAG,4 * FAILED 5 TIMES IN READING TAPE 2. 4F13133
CA131 SXD 1G,2 SAVE REDUCED VALUE IN COUNTER, 4F13134
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 094/094 ------
BST 130 BACKSPACE FORMULA TAPE, 4F13135
TRA CA101 AND GO BACK TO READ AGAIN. 4F13136
CA103 TIX CA102,2,1 TEST EXIT FROM LOOP. 4F13137
IOD DELAY UNTIL TAPE DISCONNECTS. 4F13138
RTT CHECK READING OF TAPE. 4F13139
TXI CA130,0 IF INCORRECT, GO CHECK ERROR COUNT,4F13140
LXA L(12),2 PREPARE TO SCAN 12 WORDS OF CARD. 4F13141
CA112 CLA BLANKS TEST 4F13142
SUB FT+12,2 FOR 4F13143
TNZ CA113 BLANK 4F13144
TIX CA112,2,1 CARD. 4F13145
TRA CA100 IF BLANK, GO TO READ NEXT CARD. 4F13146
CA113 CAL FT IF NOT BLANK, 4F13147
ARS 30 EXAMINE FIRST 4F13148
SUB L(C) CHARACTER TO 4F13149
TZE CA100 TEST FOR COMMENT CARD. 4F13150
TRA 1,4 * EXIT IF NEITHER BLANK NOR COMMENT, 4F13151
CA120 STZ FT INDICATE THAT FINAL 4F13152
SXD ENDWRD,0 STATEMENT HAS BEEN READ IN. 4F13153
TRA 1,4 * EXIT TO MAIN ROUTINE TO FINISH. 4F13154
REM END OF PROGRAM CA100. 4F13155
REM **************************** *4F13156
REM 4F13157
REM CC500,4/ CALLER=CC000, 4F13156
REM CC500 BRINGS NEXT CHARACTER OF DICTIONARY INTO AC(30-35), 4F13159
CC500 PXD ,0 CLEAR THE AC 4F13160
TIX CC502,2,1 IF NO DICTIONARY CHARACTERS 4F13161
LXD 2G,2 REMAIN IN THE MO, THEN 4F13162
LDQ DIC,2 REFILL WITH NEXT DICTIONARY WORD, 4F13163
TXI CC501,2,-1 RESET THE 4F13164
CC501 SXD 2G,2 DICTIONARY WORD TAG, AND 4F13165
LXA L(6),2 SET THE CHARACTER COUNT = 6. 4F13166
CC502 LGL 6 SHIFT CHAR INTO AC(30-35), 4F13167
TRA 1,4 * AND RETURN TO CALLER. 4F13168
REM END OF PROGRAM CC500. 4F13169
REM ***************************** *4F13170
REM 4F13171
REM ETMSW(LTMSW)*4/ CALLS=CIT, CALLERS=RDC,LPR,SPC,CMA,EMK, 4F13172
REM ETMSW = ENTRY POINT USED BY RDC,CMA. 4F13173
ETMSW TXL NOTTM,0 SWITCH (TXL=TRA, TXH=NOP), 4F13174
CAL ETM PICKUP ETM00, AND 4F13175
XR4X TXI SETOP,0,** GO SET OP. 4F13176
REM LTMSW = ENTRY POINT USED BY LPR,SPC,CMA,EMK, 4F13177
LTMSW TXL NOTTM,0 SWITCH (TXL=TRA, TXH=NOP), 4F13178
CAL LTM PICKUP LTM000, AND 4F13179
SETOP SLW TOP SET TOP. 4F13160
SXD XR4X,4 SAVE THE C(XR4), AND 4F13161
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F13182
PZE SL WORD1--0(IFN)000 4F13183
PZE TOP WORD2--ETM000 OR LTM000 4F13184
PZE L(0) WORD3--000000 4F13165
PZE L(0) WORD4--000000 4F13186
STZ SL CLEAR SL, 4F13187
LXD XR4X,4 RESTORE THE C(XR4), AND 4F13188
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 095/095 ------
NOTTM TRA 1,4 * EXIT TO CALLER. 4F13189
REM END OF PROGRAM ETMSW(LTMSW). 4F13190
REM ***************************** *4F13191
REM 4F13192
REM IFFIX,1/ USES=TESTFX, CALLERS=CMA,VRA(VRD), 4F13193
IFFIX CAL EIFNO SET 4F13194
STZ G G TO 4F13195
STD G (0(IFN)000), 4F13196
CAL SYM MOVE SYMBOL 4F13197
SLW G+1 INTO G+1. 4F13198
CAL CHR-6 PICKUP 1ST CHARACTER OF SYMBOL, AND4F13199
TXI TESTFX+1,0 * GO TEST FOR FIXED OR FLOATING PT. 4F13200
REM END OF PROGRAM IFFIX. 4F13201
REM ***************************** *4F13202
REM 4F13203
REM INPUT(OUTPUT),2/ CALLS=GIF,CIT,LIB, 4F13204
REM CALLERS =RDC,RIT,RDP,WOT,PDC,WBT,RBT,WRD,RDD. 4F13205
REM INPUT = ENTRY POINT USED BY RDC,RIT,RBT,RDD, 4F13206
INPUT CLA L(6) PICKUP 6 TO 4F13207
TXI OUTPUT+1 GO SET INOUT FOR FORVAL ENTRY. 4F13208
REM OUTPUT = ENTRY POINT USED BY RDP,WOT,PDC,WBT,WRD. 4F13209
OUTPUT CLA L(5) PICKUP 5 TO 4F13210
STO INOUT SET INOUT FOR FORVAR ENTRY. 4F13211
TSX GIF,4 * SET SL = IFN,000. 4F13212
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F13213
PZE SL WORD1--0(IFN)000 4F13214
PZE CAL WORD2--CAL000 4F13215
PZE 15P WORD3--*00000 4F13216
PZE L(0) WORD4--000000 4F13217
TSX LIB,4 * MAKE CLOSUB ENTRY, AND COMPILE= 4F13218
PZE L(0) WORD1--000000 4F13219
PZE XIT WORD2--XIT000 4F13220
PZE LEV WORD3--(LEV) 4F13221
PZE L(0) WORD4--000000 4F13222
STZ SL CLEAR SL, AND 4F13223
TRA 1,2 * EXIT TO CALLER. 4F13224
REM END OF PROGRAM INPUT(OUTPUT), 4F13225
REM **************************** *4F13226
REM 4F13227
REM LIB,1/ CALLS=TET00,CIT, CALLERS=RDC,EMK,INPUT(OUTPUT), 4F13228
LIB CAL 3,4 MOVE NAME OF SUBROUTINE, 4F13229
STA LIC ADDRESS OF WHICH 4F13230
LIC CAL ** IS IN WORD3 OF CALLING SEQ, 4F13231
SLW G INTO G, AND 4F13232
TSX TET00,1 * GO ENTER IN THE 4F13233
PZE 9 CLOSUB TABLE. 4F13234
TXI CIT,0 * MAKE CIT ENTRY, AND EXIT TO CALLER.4F13235
REM END OF PROGRAM L1B. 4F13236
REM ***************************** *4F13237
REM 4F13238
REM VRA(VRD),4/ CALLS=IFFIX,DIAG,TET00,CIT,DRTABS,JIF, 4F13239
REM CALLERS =RIT,WOT,EFT, 4F13240
REM VRA = ENTRY POINT USED BY EFT. 4F13241
VRA CLA L(TL) RESET TPOA ADDRESS 4F13242
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 096/096 ------
STA TPOA TO TL. 4F13243
CAL TXLOP PREPARE TO SET OP-SWITCH TO TRA. 4F13244
TXI VRD1,4,-1 SET RETURN TO TSX+2, AND GO SET OP.4F13245
REM VRD = ENTRY POINT USED BY RIT,WOT, 4F13246
VRD CLA TXLOP PREPARE TO SET OP-SWITCH TO NOP. 4F13247
VRD1 STP VRX SET VRX OP-SWITCH. 4F13248
SXD VRX,4 SAVE THE C(XR4) FOR RETURN. 4F13249
TSX IFFIX,1 * SET UP IFN AND SYMBOL FOR FORVAR. 4F13250
TSX DIAG,4 * ILLEGAL USE OF FLOATING VARIABLE. 4F13251
TSX TET00,1 * IF SYMBOL IS FXD-PT, GO MAKE 4F13252
PZE 5 ENTRY IN FORVAR TABLE. 4F13253
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F13254
PZE SL WORD1-0(IFN)000 4F13255
PZE CAL WORD2-CAL000 4F13256
PZE SYM WORD3-(FXD-PT SYMBOL) 4F13257
PZE L(0) WORD4-000000 4F13258
VRX TXH VDA,0,** SWITCH ITXL=TRA, TXH=NOP), 4F13259
CAL STD PICKUP STD000, AND 4F13260
XRW TXI RVX,0,** GO SET TOP. 4F13261
VDA CLA CON IF CON 4F13262
TZE SDA IS NOT ZERO, 4F13263
STO G THEN 4F13264
TSX FXCNIX,4 * ENTER CON IN FIXCON,AND GET TAG, 4F13265
ALS 18 ADJUST TAG, AND 4F13266
STO RA SET RA. 4F13267
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY. 4F13268
PZE L(0) WORD1-000000 4F13269
PZE ADD WORD2-ADD000 4F13270
PZE 2P WORD3-200000 4F13271
PZE RA WORD4-(FIXCON TAG) 4F13272
SDA TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F13273
PZE L(0) WORD1-000000 4F13274
PZE ARS WORD2-ARSOOO 4F13275
PZE L(0) WORD3-000000 4F13276
PZE D18 WORD4-0(18)000 4F13277
CAL STA PICKUP STAOOO, AND 4F13278
RVX SLW TOP SET TOP TO STA OR STD. 4F13279
TSX JIF,4 * GO JUMP IFN, AND SET SL AND TL, 4F13280
TSX CIT,4 * GO MAKE THE FOLLOWING CIT ENTRY= 4F13281
PZE L(0) WORD1- 00600 4F13282
PZE TOP WORD2-STA000 OR STD000 4F13283
PZE TL WORD3-0(IFN)000 4F13264
PZE L(0) WORD4-000000 4F13285
NLA PXD LAST,0 CLEAR THE AC 4F13286
LXD VRX,4 RESTORE THE C(XR4), AND 4F13287
TRA 1,4 * EXIT TO CALLER. 4F13288
REM END OF PROGRAM VRA(VRD), 4F13289
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F13290
REM 4F13291
REM STATEA/5-CONSTANTS AND VARIABLES USED BY STATE A= 4F13292
REM 4F13293
BCD BCD 1BCD000 CONSTANT USED BY IOT. 4F13294
BST BCD 1BST000 CONSTANT USED BY IOT. 4F13295
ETM BCD 1ETM000 CONSTANT USED BY IOT, 4F13296
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 097/097 ------
LTM BCD 1LTM000 CONSTANT USED BY IOT. 4F13297
NTR BCD 1NTR000 CONSTANT USED BY IOT. 4F13298
RDR BCD 1RDR000 CONSTANT USED BY IOT. 4F13299
REW BCD 1REW000 CONSTANT USED BY IOT. 4F13300
RTB BCD 1RTB000 CONSTANT USED BY IOT. 4F13301
SLW BCD 1SLW000 CONSTANT USED BY IOT. 4F13302
STD BCD 1STD000 CONSTANT USED BY IOT. 4F13303
WDR BCD 1WDR000 CONSTANT USED BY IOT. 4F13304
WEF BCD 1WEF000 CONSTANT USED BY IOT. 4F13305
WTB BCD 1WTB000 CONSTANT USED BY IOT. 4F13306
XIT BCD 1XIT000 CONSTANT USED BY IOT. 4F13307
BDC BCD 1(BDC) CONSTANT USED BY IOT. 4F13308
CSH BCD 1(CSH) CONSTANT USED BY IOT. 4F13309
DBC BCD 1(DBC) CONSTANT USED BY IOT. 4F13310
FIL BCD 1(FIL) CONSTANT USED BY IOT. 4F13311
LEV BCD 1(LEV) CONSTANT USED BY IOT. 4F13312
RTN BCD 1(RTN) CONSTANT USED BY IOT. 4F13313
SCH BCD 1(SCH) CONSTANT USED BY IOT. 4F13314
SPH BCD 1(SPH) CONSTANT USED BY IOT. 4F13315
STH BCD 1(STH) CONSTANT USED BY IOT. 4F13316
TSH BCD 1(TSH) CONSTANT USED BY IOT. 4F13317
REM 4F13318
CON BSS 1 VARIABLE USED BY IOT. 4F13319
END PZE ** VARIABLE USED BY IOT. 4F13320
TOP BSS 1 VARIABLE USED BY IOT. 4F13322
TSA PZE ** VARIABLE USED BY IOT. 4F13323
TTA PZE ** VARIABLE USED BY IOT. 4F13324
REM 4F13325
REM DIC/ DICTIONARY OF NON-ARITHMETIC STATEMENTS (USED BY CC500).4F13326
DIC OCT 244677274663 DO-GOT 4F13327
OCT -67731267462 O-IF(S 4F13328
OCT 254562256266 ENSESW 4F13329
OCT 316323307731 ITCH-I 4F13330
OCT 267462254562 F(SENS 4F13331
OCT 254331273063 ELIGHT 4F13332
OCT -373126243165 -IFDIV 4F13333
OCT 312425233025 IDECHE 4F13334
OCT 234277312621 CK-IFA 4F13335
OCT 232364446443 CCUMUL 4F13336
OCT 216346514665 ATOROV 4F13337
OCT 255126434666 ERFLOW 4F13338
OCT -373126506446 -IFQUO 4F13339
OCT -233125456346 TIENTO 4F13340
OCT -252551264346 VERFLO 4F13341
OCT -267731267721 W-IF-A 4F13342
OCT -226231274577 SSIGN- 4F13343
OCT -226346477747 STOP-P 4F13344
OCT 216462257762 AUSE-S 4F13345
OCT 254562254331 ENSELI 4F13346
OCT 273063772431 GHT-DI 4F13347
OCT -42545623146 MENSIO 4F13348
OCT -57725506431 N-EQUI 4F13349
OCT -252143254523 VALENC 4F13350
OCT 257726512550 E-FREQ 4F13351
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 098/098 ------
OCT -242545237077 UENCY- 4F13352
OCT 234645633145 CONTIN 4F13353
OCT -242577512521 UE-REA 4F13354
OCT 246321472577 DTAPE- 4F13355
OCT -112521243145 READIN 4F13356
OCT -76463632147 PUTTAP 4F13357
OCT 257751252124 E-READ 4F13358
OCT 245164447751 DRUM-R 4F13359
OCT 252124776651 EAD-WR 4F13360
OCT 316325632147 ITETAP 4F13361
OCT 257766513163 E-WRIT 4F13362
OCT 254664634764 EOUTPU 4F13363
OCT -236321472577 TTAPE- 4F13364
OCT -265131632524 WRITED 4F13365
OCT -116444774751 RUM-PR 4F13366
OCT 314563774764 INT-PU 4F13367
OCT -52330775125 NCH-RE 4F13368
OCT -263145247722 WIND-B 4F13369
OCT 212342624721 ACKSPA 4F13370
OCT 232577254524 CE-END 4F13371
OCT 263143257726 FILE-F 4F13372
OCT -65144216377 ORMAT- 4F13373
OCT -226422514664 SUBROU 4F13374
OCT -233145257723 TINE-C 4F13375
OCT -064444464577 OMMON- 4F13376
OCT -112563645145 RETURN 4F13377
OCT -372321434377 -CALL- 4F13378
OCT 254524747726 END(-F 4F13379
OCT -244523633146 UNCTIO 4F13360
OCT -057777777777 N----- 4F13361
BSS 10 4F133815
REM END OF DICTIONARY. 4F13382
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F13383
REM 4F13384
REM T/ TRANSFER TABLE IUSED BY CC000), 4F13385
T TXI C0100,0 DO, 4F13386
TXI C0200,0 GO TO. 4F13387
TXI C0400,0 IF ISENSE SWITCH. 4F13388
TXI C0500,0 IF (SENSE LIGHT. 4F13389
TXI C0600,0 IF DIVIDE CHECK. 4F13390
TXI C0700,0 IF AC OVERFLOW, 4F13391
TXI C0800,0 IF MO OVERFLOW. 4F13392
TXI C0300,0 IF. 4F13393
TXI C1000,0 A5SIGN. 4F13394
TXI C1300,0 STOP. 4F13395
TXI C0900,0 PAUSE. 4F13396
TXI C1100,0 SENSE LIGHT, 4F13397
TXL C1200,0 DIMENSION* 4F13398
TXL C1500,0 EOUIVALENCE. 4F13399
TXL C1400,0 FREOUENCY, 4F13400
TXI C1600,0 CONTINUE. 4F13401
TXI RBT,0 READ TAPE. 4F13402
TXI RIT,0 READ INPUT TAPE. 4F13403
TXI RDD,0 READ DRUM. 4F13404
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 099/099 ------
TXI RDC,0 READ CARD. 4F13405
TXI WBT,0 WRITE TAPE. 4F13406
TXI WOT,0 WRITE OUTPUT TAPE. 4F13407
TXI WRD,0 WRITE DRUM, 4F13408
TXI RDP,0 PRINT. 4F13409
TXI PDC,0 PUNCH. 4F13410
TXI RWN,0 REWIND. 4F13411
TXI BSP,0 BACKSPACE. 4F13412
TXI EFT,0 END FILE. 4F13413
TXL FOR,0 FORMAT. 4F13414
TXL C3000,0 SUBROUTINE. 4F13415
TXL C3100,0 COMMON. 4F13416
TXI C3200,0 RETURN. 4F13417
TXI C3300,0 CALL. 4F13418
TXL C3400,0 END. 4F13419
TXL C3500,0 FUNCTION. 4F13420
BSS 10 4F134205
REM END OF TRANSFER TABLE. 4F13421
ENDADR BSS 0 4F134215
REM ****************************** * 4F13422
REM 4F13423
ENDA ORG 3783 4F13424
BIN BSS 1 VARIABLE USED BY IOT. 4F13425
CHR BES 6 VARIABLE USED BY IOT. 4F13426
BSS 50 PARAMETERS FOR TLDOS TABLE -IOT. 4F13427
DOLEV BSS 1 PARAMETERS FOR TLDOS TABLE -IOT. 4F13428
OP BSS 1 VARIABLE USED BY IOT. 4F13429
RA BSS 1 VARIABLE USED BY IOT. 4F13430
SA BSS 1 VARIABLE USED BY IOT. 4F13431
SYM BSS 1 VARIABLE USED BY IOT. 4F13432
TLDOS BSS 250 DO TABLE USED BY IOT. 4F13433
REM END OF WORKING STORAGE USED BY STATEA. 4F13434
REM ****************************** *4F13435
REM 4F13436
REM END OF THE NON-ARITHMETIC PART OF SECTION ONE. 4F13437
REM 4F13438
REM ****************************** *4F13439
REM 4F13440
REM ARITHMETIC / STATE B= 4F13441
REM 704 FORTRAN MASTER RECORD CARD / STATE B = F0180000. 4F13442
ORG 0 4F134421
PZE ORGB,,DMWR06 4F134422
PZE ENDB-1 4F134423
REM 4F13443
ORGB ORG 1824 4F13444
REM 4F13445
REM THIS IS A RECODED VERSION OF STATE B OF SECTION ONE, 704 4F13446
REM FORTRAN II. THE SCAN HAS BEEN COMPLETELY RECODED AND LEVEL 4F13447
REM ANALYSIS HAS BEEN FOLDED OVER. 4F13440
REM 4F13449
REM STATE B CONSISTS OF TWO PARTS....SCAN AND LEVEL ANALYSIS. 4F13450
REM THE SCAN IS LEFT TO RIGHT OVER THE SOURCE STATEMENT WHICH IS 4F13451
REM IN THE F REGION OF COMMON AND IS IN BCD. 4F13452
REM EACH FIXED POINT CONSTANT, FLOATING POINT CONSTANT, AND BCD 4F13453
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 100/100 ------
REM ( HOLLERITH) ARGUMENT IN CALL NAME STATEMENTS ARE ENTERED IN 4F13454
REM TABLES AND GIVEN AN INTERNAL VARIABLE NAME. 4F13455
REM LEVEL ANALYSIS IS PREFORMED FOR EACH ELEMENT OF THE STATEMENT4F13456
REM WHERE AN ELEMENT IS DEFINED AS A VARIABLE, FUNCTION NAME OR (4F13457
REM AND THE OPERATOR WHICH PRECEDES IT. 4F13458
SLF 4F13459
CLA SIG1ST 4F13460
STO SIG1IX-3 4F13461
STZ ARGCTR CLEAR 4F13462
STZ CHSAVE X 4F13463
STZ 3LBAR X 4F13464
STZ NBAR X 4F13465
STZ CBAR X 4F13466
STZ ABAR X 4F13467
STZ FSTYPE X 4F13468
LXD 1BAR,4 SET NBAR=-1 4F13469
SXD NBAR,4 X 4F13470
CAL E( SET ARERAS - E( 4F13471
SLW ARERAS X 4F13472
TSX C0190X,4 SET FWA --F AND CHCTR - 0 4F13473
CAL TXHOP SET SWITCHES FOR LEFT SCAN. 4F13474
STP MS093 X 4F13475
STP MS310 X 4F13476
STP MS321 X 4F13477
MS010 CAL ADPLUS SET OP TO ADDITION 4F13478
MS030 SLW E+1 X 4F13479
STZ FNBITS CLEAR FUNCTION NAME INDICATOR 4F13480
STZ FNCTR CLEAR FUNCTION ARG COUNTER. 4F13481
STZ G CLEAR RECEIVING CELL. 4F13482
CLS L(0) SET E = -0 4F13483
STO E X 4F13484
LXA L(6),2 SET IR2 FOR SIX CHARS. 4F13485
MS040 CAL CHSAVE CHAR IN CHSAVE, IF ANY, TO AC. 4F13486
TNZ MS041 X 4F13467
TSX C0190,4 CHSAVE EMPTY, GET NEXT CHAR. 4F13488
MS041 CAS L(9) IS CHAR. NUMERIC 4F13489
TRA MS050 N/, TAKE TRA 4F13490
MS4007 TXH CM4100,0 4F13491
TSX ROYCNV,4 X 4F13492
TRA HOLL RETURN 1, THIS WAS HOLLERITH. 4F13493
TRA LATXH THIS WAS FIXED OR FLOATING CONSTANT. 4F13494
MS050 LXA L(10),4 PREPARE TO TEST FOR PUNCTUATION. 4F13495
MS051 CAS CTEST,4 4F13496
TRA MS052 X 4F13497
TRA MS090 CHAR IS SOME PUNCTUATION. 4F13498
MS052 TIX MS051,4,1 X 4F13499
MS060 ALS 36,2 POSITION CHAR FOR BUILDING SYMBOL. 4F13500
ORS G ADD CHAR TO THOSE IN G. 4F13501
TXI MS061,2,6 UPDATE POSITIONING TAG. 4F13502
MS061 TSX C0190,4 GET NEXT CHAR. 4F13503
MS070 LXA L(10),4 PREPARE TO TEST FOR PUNCTUATION. 4F13504
MS071 CAS CTEST,4 X 4F13505
TRA MS072 X 4F13506
TRA MS091 CHAR IS SOME PUNCTUATION. 4F13507
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 101/101 ------
MS072 TIX MS071,4,1 X 4F13508
TXL MS060,2,18 IF THIS IS CHAR I, 2 /R 3 GO BUILD G. 4F13509
CAS L(F) IS THIS AN F ENDING FUNCTION NAME. 4F13510
TRA MS073 X 4F13511
TRA MS080 MAYBE, GO LOOK AT NEXT CHAR. 4F13512
MS073 TXL MS060,2,36 TEST FOR UNDER 7 CHARS. 4F13513
MS074 TSX DIAG,4 BUILD G, 7TH CHAR IS ERROR. 4F13514
MS080 TSX C0190,4 GET NEXT CHAR. 4F13515
CAS OPEN TEST FOR (. 4F13516
TRA MS081 X 4F13517
TRA MS092 YES, THIS IS A FUNCTION NAME. 4F13518
MS081 STO FIRSTC NO, SAVE CURRENT CHAR. 4F13519
CAL L(F) ADD F TO CONTENTS OF G, 4F13520
ALS 36,2 X 4F13521
ORS G X 4F13522
TXH MS074,2,36 TEST FOR 7TH CHAR, YES IS ERROR, 4F13523
CLA FIRSTC RESTORE CURRENT CHAR. 4F13524
TXI MS070,2,6 UPDATE POSITIONING TAG, 4F13525
MS090 STZ CHSAVE CLEAR 4F13526
TRA TRBLKA,4 4F13527
MS091 SLW CHSAVE OP IS IN NEXT ELEMENT, SAVE, 4F13528
CAL BLANK ADD BLANK TO CHARS IN G. 4F13529
ALS 36,2 X 4F13530
ORS G X 4F13531
LDQ G MOVE G TO E+2 AND TO G+1, 4F13532
STQ E+2 X 4F13533
STQ G+1 X 4F13534
TRA TRBLKB,4 NOW BRANCH TO INDIVIDUAL ROUTINE 4F13535
MS092 PXD ,0 CLEAR 4F13536
LDQ BLANKS ADD BLANKS TO SUBROUTINE NAME IN G. 4F13537
LGL 42,2 X 4F13538
ORA G X 4F13539
SLW G X 4F13540
SLW E+2 MOVE FUNCTION NAME TO E+2. 4F13541
MS093 *** MS335,0 TXH FOR LEFT SIDE, TXL FOR RIGHT SIDE. 4F13542
LXD BK,4 THIS IS ARITH FUNCTION STATEMENT. 4F13543
SLW FORSUB,4 ENTER FUNCTION NAME IN FORSUB TABLE. 4F13544
CAL EIFNO ENTER INTERNAL FORMULA NO IN FORSUB. 4F13545
ANA MASK1 X 4F13546
STO FORSUB+1,4 X 4F13547
TXI FS010,4,-2 UPDATE COUNT OF ENTRIES IN FORSUB. 4F13548
FS010 SXD BK,4 X 4F13549
FS020 TSX C0190,4 GET FIRST CHAR OF ARGUMENT. 4F13550
CAS EQUAL TEST FOR EQUAL, 4F13551
TRA FS030 X 4F13552
TRA MS322 GO MOVE FROM E, E+1, E+2 TO LEFT, LEFT+1,+24F13553
FS030 CAS L(9) TEST FOR ILLEGAL ARGUMENT, 4F13554
TRA FS040 LEGAL, CONTINUE 4F13555
MS9002 TXH CM4200,0 4F13556
TSX DIAG,4 BEGINS NUMERIC, ERROR, 4F13557
FS040 TSX C0160,2 COLLECT ARGUMENT NAME IN 1G, 4F13558
TSX TESTB0,4 TEST CHAR FOLLOWING ARG FOR , OR) 4F13559
LXD ARGCTR,2 GET COUNT OF ARGUMENTS 4F13560
LDQ 1G ENTER ARGUMENT NAME IN ARGREG TABLE. 4F13561
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 102/102 ------
STQ ARGREG,2 X 4F13562
TXI FS050,2,-1 UPDATE COUNT OF ARGUMENTS. 4F13563
FS050 SXD ARGCTR,2 4F13464
TXH FS020,2,-50 TEST FOR ARGREG TABLE OVERFLOW, 4F13565
TSX DIAG,4 YES, ERROR. 4F13566
MS200 TSX DECPNT,4 CONVERT BCD NUMBER TO BINARY 4F13567
TSX DIAG,4 HOLLERITH RETURN, ERROR. 4F13568
TRA LATXH FLOATING POINT CONSTANT RETURN. 4F13569
MS210 SLN 1 TURN , LITE 0N. 4F13570
LXD 3LBAR,1 PERFORM LEVEL ANALYSIS FOR , 4F13571
LXD ABAR,4 4F13572
CLS ALPHA-4,4 4F13573
STO LAMBDA,1 4F13574
CAL ADSPOP 4F13575
SLW LAMBDA+1,1 4F13576
CLA NBAR 4F13577
ARS 18 4F13578
STO LAMBDA+2,1 4F13579
TXI MS211,1,-3 4F13580
MS211 SXD 3LBAR,1 4F13581
LXD NBAR,1 4F13582
SXD CBAR,1 4F13583
TXI MS212,1,-1 4F13584
MS212 SXD NBAR,1 4F13585
TXI MS213,4,3 4F13586
MS213 SXD ABAR,4 4F13587
TRA MS010 4F13588
MS220 LXD ABAR,4 PERFORM LEVEL ANALYSIS FOR ) 4F13589
CLA ALPHA-4,4 4F13590
PAX ,1 4F13591
SXD CBAR,1 4F13592
TXI MS221,4,4 4F13593
MS221 SXD ABAR,4 4F13594
TRA MS020 4F13595
MS230 LXD ABAR,4 PERFORM LEVEL ANALYSIS FOE ENDMK, 4F13596
TXI MS231,4,3 4F13597
MS231 TXL MS232,4,0 FINISHED, HAS LEVEL BEEN REDUCED TO ZERO, 4F13598
TSX DIAG,4 NO, ERROR. 4F13599
MS232 LXD ARGCTR,4 WAS THIS AN ARITH FUNCTION STATEMENT 4F13600
TXL STATEC,4,0 4F13601
CAL FSTYPE YES, UPDATE FUNCTION TYPE AND 4F13602
ADD L(1) COMPLETE FORSUB ENTRY BY ASSIGNING 4F13603
LXD BK,1 TYPE NUMBER. 4F13604
STA FORSUB-1,1 X 4F13605
ORS ARERAS ALSO SAVE FOR LATER REFERENCE. 4F13606
TRA STATEC 4F13607
TRA MS230 ENDMK 4F13608
TRA MS260 ( 4F13609
TRA MS210 , 4F13610
TRA MS220 ) 4F13611
MSERR= TSX DIAG,4 = 4F13612
TRA MS250 - 4F13613
TRA MS250 / 4F13614
TRA MS200 , 4F13615
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 103/103 ------
TRA MS250 + 4F13616
MS240 ALS 30 * SAVE * 4F13617
TRBLKA BSS 0 4F13618
SLW E+1 X 4F13619
TSX C0190,4 GET NEXT CHAR. 4F13620
CAS STAR IS IT * 4F13621
TRA MS041 X 4F13622
TRA MS241 YES, THIS WAS ** 4F13623
TRA MS041 NO, GO COMPARE TO OTHER PUNCTUATION. 4F13624
MS241 CAL STRSTR REPLACE * WITH ** 4F13625
TRA MS251 X 4F13626
MS250 ALS 30 POSITION CHAR WHICH IS + OR - OR / 4F13627
MS251 SLW E+1 PUT CURRENT OP IN E+1. 4F13628
TRA MS040 NOW GO COLLECT SYMBOL, 4F13629
MS260 ALS 30 ( TO SYMBOL WORD 4F13630
SLW E+2 X 4F13631
TRA LATXL GO PERFORM LEVEL ANALYSIS FOR ( 4F13632
TRA MS300 ENDMK 4F13633
TRA MS320 ( 4F13634
TRA MS300 , 4F13635
TRA MS300 ) 4F13636
TRA MS310 = 4F13637
TRA MS300 - 4F13638
TRA MS300 / 4F13639
TSX DIAG,4 . 4F13640
TRA MS300 + 4F13641
MS300 PXD ,0 * CLEAR 4F13642
TRBLKB BSS 0 BASE ADDRESS FOR TAGGED TRANSFER. 4F13643
LGL 6 GET FIRST CHAR OF SYMBOL. 4F13644
TSX TESTFX+1,1 TEST FOR FIXED OR FLOATING POINT. 4F13645
TRA LATXL FLOATING, GO PERFORM LEVEL ANALYSIS. 4F13646
CAL EIFNO FIXED, PREPARE FORVAR ENTRY. 4F13647
ANA MASK1 X 4F13648
SLW G X 4F13649
TSX TET00,1 MAKE FORVAR ENTRY. 4F13650
5 X 4F13651
PXD ,0 4F13652
LDQ LEFT+2 4F13653
LGL 12 4F13654
SUB CALLER 4F13655
TNZ LATXL 4F13656
TSX TET00,1 4F13657
6 4F13658
TRA LATXL GO PERFORM LEVEL ANALYSIS. 4F13659
MS320 STZ CHSAVE CLEAR CELL FOR 0P. 4F13660
MS321 *** MS330,0 TXH ON LEFT, TXL ON RIGHT OF = SIGN. 4F13661
TSX SS000X,4 GO PROCESS SUBSCRIPT COMBINATION 4F13662
TSX C0190,4 GET NEXT CHAR. 4F13663
SUB EQUAL TEST FOR EQUAL SIGN. 4F13664
TNZ MSERR= NO, ERROR. 4F13665
MS322 LXA L(3),4 MOVE CONTENTS OF E WORDS TO LEFT WORDS. 4F13666
MS323 LDQ E+3,4 X 4F13667
STQ LEFT+3,4 X 4F13668
TIX MS323,4,1 X 4F13669
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 104/104 ------
MS311 CAL TXLOP SET SWITCHES FOR RIGHT SIDE SCAN. 4F13670
STP MS093 X 4F13671
STP MS310 X 4F13672
STP MS321 X 4F13673
SLN 1 TURN = OR ) LITE 0N. 4F13674
TRA MS010 GO SCAN NEXT ELEMENT. 4F13675
MS310 *** MSERR=,0 TXH FOR LEFT, TXL FOR RIGHT OF EQUAL SIGN. 4F13676
STZ CHSAVE CLEAR 4F13677
PXD ,0 CLEAR AC 4F136775
LGL 6 GET FIRST CHAR OF SYMBOL. 4F13678
TSX TESTFX+ 1,1 TEST FOR FIXED OR FLOATING POINT 4F13679
TRA MS322 FLOATING, 4F13680
CAL EIFNO FIXED, PREPARE FORVAL ENTRY. 4F13681
ANA MASK1 X 4F13682
SLW G X 4F13683
TSX TET00,1 MAKE FORVAL ENTRY. 4F13684
6 X 4F13685
TRA MS322 4F13686
MS330 TSX DIM1SR,4 SEARCH FOR THIS NAME IN THE DIM1, DIM2, 4F13687
TRA MS331 AND DIM3 TABLES. IF IT IS FOUND IN ONE OF 4F13688
TRA MS333 THESE TABLES IT IS A SUBSCRIPTED VARIABLE 4F13689
MS331 TSX DIM2SR,4 OF THAT NUMBER OF DIMENSIONS, IF IT IS NOT 4F13690
TRA MS332 FOUND IN ANY DIMENSION TABLE THEN IT IS 4F13691
TRA MS333 ASSUMED TO BE THE NAME OF A FORTRAN II 4F13692
MS332 TSX DIM3SR,4 SUBROUTINE OR FUNCTION COMPILED SEPARATELY.4F13693
TRA MS334 X 4F13694
MS333 TSX SS000X,4 GO PROCESS SUBSCRIPT COMBINATIONS 4F13695
TRA LATXH GO PERFORM LEVEL ANALYSIS. 4F13696
MS334 CAL FNIND NOT FOUND, TREAT AS FUNCTION NAME. 4F13697
SLW FNBITS X 4F13698
PXD ,0 X 4F13699
LDQ BLANKS COMPLETE NAME WITH BLANKS. 4F13700
LGL 42,2 X 4F13701
ORS G X 4F13702
ORS E+2 X 4F13703
TSX TET00,1 ENTER NAME IN CLOSUB TABLE. 4F13704
9 X 4F13705
MS335 SLN 2 TURN FUNCTION LITE 0N. 4F13706
TRA LATXL GO PERFORM LEVEL ANALYSIS. 4F13707
HOLL STZ CHSAVE CLEAR CHSAVE 4F13708
CAL HOLCNT GET CURRENT H(+I WORD 4F13709
SLW E+2 4F13710
LXA N,2 GET NUMBER OF CHARACTERS IN THIS ARG 4F13711
LXD CHCTR,4 GET CURRENT RESIDUE CHAR COUNT 4F13712
LDQ RESIDU GET CURRENT RESIDU WORD 4F13713
C3351 LXA L(6),1 SET TO COLLECT SIX CHARS 4F13714
PXD 0,0 CLEAR AC 4F13715
C3352 TNX C3354,4,1 TEST FOR NO MORE CHARS IN RESIDU 4F13716
C33525 LGL 6 GET NEXT CHAR 4F13717
SLW 1G STORE WORD 4F13718
ANA ENDMK BLANK ALL EXCEPT CURRENT CHAR 4F13719
SUB ENDMK TEST FOR INTERNAL ENDMK 4F13720
TNZ C3353 4F13721
TSX DIAG,4 YES, ERROR, GO TO DIAGNOSTIC. 4F13722
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 105/105 ------
C3353 CAL 1G RETREIVE WORD 4F13723
TNX C3358,2,1 TEST FOR ALL CHARS COLLECTED 4F13724
TNX C3356,1,1 TEST FOR SIX CHARS COLLECTED 4F13725
TRA C3352 NOT SIX CHARS YET, CONTINUE C0LLECTING4F13726
C3354 LXD FWA,4 LOAD MQ WITH NEXT F REGION WORD 4F13727
LDQ 0,4 4F13728
TXI C3355,4,-1 UPDATE FWA 4F13729
C3355 SXD FWA,4 4F13730
LXA L(6),4 RESET MQ CHAR COUNT TO SIX 4F13731
TRA C33525 CONTINUE COLLECTING 4F13732
C3356 TSX C3390,1 GO TO ENTER WORD IN HOLARG TABLE 4F13733
C3357 TXI C3351,0,** RETURN TO CONTINUE COLLECTING 4F13734
C3358 STQ RESIDU UPDATE RESIDU 4F13735
SXD CHCTR,4 UPDATE CHCTR 4F13736
TNX C3360,1,1 TEST FOR SIX CHARS IN AC DEC IR1 4F13737
LDQ BLANKS NOT SIX CHARS, PREPARE TO ADD BLANKS 4F13738
C3359 LGL 6 ADD BLANKS 4F13739
TIX C3359,1,1 4F13740
C3360 TSX C3390,1 GO TO ENTER WORD IN HOLARG TABLE 4F13741
CAL ALL1 GET WORD OF ONES 4F13742
TSX C3390,1 GO TO ENTER WORD IN HOLARG TABLE 4F13743
REM LEVEL ANALYSIS 4F13744
LATXL CAL TXLOP 4F13745
TRA LATXL+3 4F13746
LATXH CAL TXHOP 4F13747
STP CM4105 4F13748
LA0000 LXA L(0),A 4F13749
CLA E+2 4F13750
SLT 2 IS THIS A FUNCTION NAME 4F13751
TRA LA0000+36 NO 4F13752
SLN 2 YES - TURN F LITE BACK ON 4F13753
LXD BK,C IS FORSUB EMPTY 4F13754
TXL LA0000+13,C,0 YES. GO SET FS BITS TO 0 4F13755
SXD LA0000+12,C 4F13756
CAS FORSUB,A SEARCH FN NAME IN FORSUB 4F13757
TXI LA0000+12,A,-2 4F13758
TRA LA0000+15 4F13759
TXI LA0000+12,A,-2 4F13760
TXH LA0000+8,A,0 4F13761
STZ FSBITS SET FSBITS TO 0 4F13762
TRA LA0000+25 4F13763
CAL FORSUB+1,A FN NAME IN FORSUB 4F13764
ANA MASK2 EXTRACT TYPE NUMBER 4F13765
LXD ARGCTR,C IS THIS A FUNCTION STATEMENT 4F13766
TXL LA0000+22,C,0 NO 4F13767
CAS FSTYPE YES - UPDATE FS TYPE 4F13768
STA FSTYPE 4F13769
TXH 0,0 4F13770
ALS 7 4F13771
ORA FSIND 4F13772
SLW FSBITS 4F13773
LXD 3LBAR,A LOAD LA COUNTERS 4F13774
LXD NBAR,B 4F13775
LXD ABAR,C 4F13776
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 106/106 ------
TXL LA0003,A,0 4F13777
TXH LA0001,A,-1200 4F13778
TSX DIAG,4 ERROR..LAMBDA TABLE EXCEEDED. 4F13779
LA0001 TXH LA0002,B,-301 4F13780
TSX DIAG,4 ERROR.,BETA TABLE EXCEEDED 4F13781
LA0002 TXL LA0003,C,0 4F13782
TXH LA0003,C,-139 4F13783
TSX DIAG,4 ERROR..ALPHA TABLE EXCEEDED 4F13784
LXD ARGCTR,C VARIABLE OR ( 4F13785
TXL LA0000+13,C,0 NOT AN FS - GO SET FS BITS TO 0 4F13786
SXD LA0000+43,C FUNCTION STATEMENT 4F13787
CAS ARGREG,A SEARCH FREE VARIABLE TABLE 4F13788
TXI LA0000+43,A,-1 4F13789
TRA MS1018 4F13790
TXI LA0000+43,A,-1 4F13791
TXH LA0000+39,A,0 4F13792
TRA LA0000+13 NOT PRESENT - GO SET FSBITS TO 0 4F13793
MS1018 PXD 0,A PRESENT - STORE TYPE IN FSBITS 4F13794
ARS 11 4F13795
TRA LA0000+23 4F13796
LA0003 CLA MS9002 4F13797
STA LA4320 4F13798
PXD 0,0 4F13799
LDQ E+2 4F13800
STQ LAMBDA+11,A 4F13601
STQ LAMBDA+8,A 4F13802
STQ LAMBDA+5,A 4F13803
LGL 6 4F13804
STO FIRSTC 4F13805
SUB OPEN 4F13606
TZE LA003 4F13807
CLA MS4007 4F13808
SLT 2 4F13809
TRA LA002 4F13810
SLN 2 4F13811
CLA FINI03 4F13812
LA002 STA LA4320 4F13813
LA003 CLA E 4F13814
STO LAMBDA+9,A 4F13815
STO LAMBDA+6,A 4F13816
STO LAMBDA+3,A 4F13817
CAL ADSPOP 4F13818
SLW LAMBDA+13,A 4F13819
SLW LAMBDA+10,A 4F13820
SLW LAMBDA+7,A 4F13821
PXD ,0 4F13822
LDQ E+1 4F13823
STQ LAMBDA+1,A 4F13824
LGL 6 4F13825
CAS STAR 4F13826
TRA LA0015 / SIGN 4F13827
TRA LA0010 , OR ,, SIGN 4F13828
SLT 2 + OR - SIGN 4F13829
TRA LA0044 4F13830
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 107/107 ------
TXI MS1033,B,-3 -N TO -(N+3) 4F13831
MS1033 PXD ,B 4F13832
ARS 18 4F13833
STO LAMBDA+14,A STO (N+3) IN LAMBDA+3 (L+4)+2 4F13834
TXI FINI03,B,1 -(N+3) TO - (N+2) 4F13835
FINI03 PXD CM4300,B 4F13836
ARS 18 4F13837
SSM 4F13838
STO LAMBDA+12,A STO -(N+2) IN LAMBDA+3 (L+4) 4F13839
LA0041 SLT 1 4F13840
TXI L43130,B,1 UNARY... -(N+2) TO -(N+1) 4F13841
TXI L13130,B,1 BINARY... -(N+2) TO - (N+1) 4F13842
LA0044 CLA FIRSTC 4F13843
CAS OPEN EXAMINE SYMBOL 4F13844
TRA LA0050 4F13845
TXI LA0058,B,-3 -N TO -(N+3) 4F13846
LA0050 SLT 1 4F13847
TXI LA4000,B,-1 UNARY... -NTO -(N+1) 4F13848
TXI LA1000,B,-1 BINARY... -N TO -(N+1) 4F13849
LA0058 PXD ,B 4F13850
ARS 18 4F13851
STO LAMBDA+11,A STO S(N+3) IN LAMBDA +3(L+3)+2 4F13852
ADD L(1) FORM -(N+2) IN ADD (ACC) 4F13853
TXI LA0041,2,1 4F13854
LA0010 TQP LA0015 GO TO * ROUTINE 4F13855
SLT 2 ** 4F13856
TRA LA0072 4F13857
TXI L23000,B,-1 -N TO -(N+1) 4F13858
LA0072 CLA FIRSTC 4F13859
SUB OPEN 4F13860
TNZ LA2000 4F13861
TXI L22000,B,-1 -N TO -(N+1) 4F13862
LA0015 SLT 2 * OR / 4F13863
TRA LA0021 4F13864
TXI L33000,B,-2 -N TO -(N+2) 4F13865
LA0021 CLA FIRSTC 4F13866
CAS OPEN 4F13867
TXI LA3000,B,-1 4F13868
TXI L32000,B,-2 -N TO -N(+2) 4F13869
TXI LA3000,B,-1 4F13870
L13130 SLW ALPHA+3,C STO -(N+2) IN ALPHA+A+3 4F13871
CLS L(0) 4F13872
STO LAMBDA+9,A STO -0 IN LAMBDA +3(L+3) 4F13873
SLN 1 4F13874
LA1000 CLS CBAR 4F13875
ARS 18 4F13876
SLW ALPHA,C STO -C IN ALPHA+A 4F13877
TXI LA1040,C,-3 -A TO - (A+3) 4F13878
LA1040 SXD ABAR,C 4F13879
TRA LA4010 4F13880
L22000 PXD ,B 4F13881
ARS 18 4F13882
STO LAMBDA+5,A STO S(N+1) IN LAMBDA+3(L+1)+2 4F13883
ADD L(1) 4F13884
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 108/108 ------
TXI L23130,B,1 -(N+1) TO -N 4F13885
L23000 PXD ,B 4F13886
ARS 18 4F13887
STO LAMBDA+8,A STO S(N+1) IN LAMBDA+3(L+2)+2 4F13888
ADD L(1) 4F13889
SSM 4F13890
TXI L23090,B,1 -(N+1) TO -N 4F13891
L23090 STO LAMBDA+6,A STO -N IN LAMBDA+3(L+2) 4F13892
L23130 SLW ALPHA,C STO -N IN ALPHA +A 4F13893
CLS L(0) 4F13894
STO LAMBDA+3,A STO -0 IN LAMBDA+3(L+11 4F13895
SLN 1 4F13896
LA2000 CLS ALPHA-1,C 4F13897
STO LAMBDA,A STO C(ALPHA+A-1) IN LAMBDA+3L 4F13898
CLA NBAR 4F13899
TXI LA4180,A,6 4F13900
L43130 SLW ALPHA,C STO -(N+2) IN ALPHA+A 4F13901
CLS L(0) 4F13902
STO LAMBDA+9,A STO -0 IN LAMBDA+3(L+3) 4F13903
SLN 1 4F13904
LA4000 CLS ALPHA-3,C 4F13905
LA4010 STO LAMBDA,A STO C(ALPHA+A-3) IN LAMBDA+3L 4F13906
CLS NBAR 4F13907
ARS 18 4F13908
SLW ALPHA-2,C STO-N IN ALPHA+A-2 4F13909
SLW LAMBDA+2,A STO S(N) IN LAMBDA+3L+2 4F13910
STO LAMBDA+3,A STO -N IN LAMBOA+3(L+1) 4F13911
PXD ,B 4F13912
ARS 18 4F13913
STO LAMBDA+5,A STO S(N+1) IN LAMBDA+3(L+1)+2 4F13914
STO ALPHA-1,C STO-(N+1) IN ALPHA+A-1 4F13915
SSM 4F13916
STO LAMBDA+6,A STO -(N+1) IN LAMBDA+3(L+2) 4F13917
TXI LA4150,B,-1 -(N+1) TO -(N+2) 4F13918
LA4150 CAL ADSTAR 4F13919
SLW LAMBDA+4,A STO * IN LAMBDA+3(L+1)+1 4F13920
LA4170 PXD ,B 4F13921
LA4180 ARS 18 ' 4F13922
STO LAMBDA+8,A STOS(N+2) IN LAMBDA+3(L+2)+2 4F13923
ORS LAMBDA+9,A STO -(N+2) IN LAMBDA+3(L+3) 4F13924
CAL STRSTR 4F13925
SLW LAMBDA+7,A STO SPOP IN LAMBDA+3(L+2)+1 4F13926
CAL ADSPOP 4F13927
ORA FSBITS 4F13928
ORA FNBITS 4F13929
SLW LAMBDA+10,A STO SPOP IN LAMBDA+3(L+3)+1 4F13930
LA4320 TXI **,A,-9 4F13931
L32000 PXD ,B 4F13932
ARS 18 4F13933
STO LAMBDA+8,A STO 5(N+2) IN LAMBDA+3(L+2)+2 4F13934
ADD L(1) 4F13935
TXI L33130,B,1 -(N+2) TO -(N+1) 4F13936
L33000 PXD ,B 4F13937
ARS 18 4F13938
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 109/109 ------
STO LAMBDA+11,A STO S(N+2) IN LAMBDA+3(L+3)+2 4F13939
ADD L(1) 4F13940
SSM 4F13941
TXI L33090,B,1 -(N+2) TO -(N+1) 4F13942
L33090 STO LAMBDA+9,A STO -(N+1) IN LAMBDA+3(L+3) 4F13943
L33130 SLW ALPHA,C STO -(N+1) IN ALPHA+A 4F13944
CLS L(0) 4F13945
STO LAMBDA+6,A 4F13946
SLN 1 4F13947
LA3000 CLS ALPHA-2,C 4F13948
STO LAMBDA,A STO C(ALPHA+A-2) IN LAMBDA+3L 4F13949
CLS NBAR 4F13950
ARS 18 4F13951
SLW ALPHA-1,C STO -N IN ALPHA+A-1 4F13952
SLW LAMBDA+2,A STO S(N) IN LAMBDA+3L+2 4F13953
STO LAMBDA+3,A STO -N IN LAMBDA+3(L+1) 4F13954
TXI LA4170,A,3 4F13955
CM4100 TXI CM4101,A,-3 LA COUNTER MODIFICATION ROUTINES 4F13956
CM4101 SXD 3LBAR,A 4F13957
CM4102 SXD CBAR,B 4F13958
TXI CM4104,B,-1 4F13959
CM4104 SXD NBAR,B 4F13960
CM4105 *** MS010,0 4F13961
MS020 CAL ADSTAR 4F13962
TRA MS030 4F13963
CM4200 TXI CM4201,A,-3 4F13964
CM4201 SXD 3LBAR,A 4F13965
TXI CM4303,C,-1 4F13966
CM4300 TXI CM4301,A,-6 4F13967
CM4301 SXD 3LBAR,A 4F13968
TXI CM4303,C,-1 4F13969
CM4303 SXD ABAR,C 4F13970
TXI CM4102,B,-1 4F13971
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F13972
REM 4F13973
REM CLOSED SUBROUTINE TO MAKE ENTRIES IN HOLARG TABLE 4F13974
C3390 SXD C3357,1 SAVE CALLING IR 4F13975
SLW 1G MOVE WORD TO BE ENTERED TO 1G 4F13976
TSX TET00,1 GO TO ENTER WORD IN HOLARG TABLE 4F13977
13 4F13978
CLA HOLCNT 4F13979
ADD L(1) UPDATE HOLCNT 4F13980
STO HOLCNT 4F13981
LXD C3357,1 RELOAD CALLING IR 4F13982
TRA 1,1 RETURN TO CALLER+1 4F13983
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F13984
REM 4F13985
REM PROGRAM TO SIMPLIFY THE TREATMENT OF RELATIVE ADDRESSES IN 4F13986
REM SECTION ONE THRU THE USE OF THE RA000 SUBROUTINE BY STATE B. 4F13987
SS000X SXD SSIR4,4 SAVE CALLING TAG. 4F13988
TSX SS000,4 GO TO SUBSCRIPT SCAN AND ANALYSIS ROUTINE. 4F13989
TSX RA000,4 GO TO RELATIVE ADDRESS COMPUTATION ROUTINE.4F13990
CAL GTAG 4F13991
ANA MASK1 4F13992
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 110/110 ------
SLW E+11 4F13993
TSX SIG1IX,4 GO ENTER THIS RELATIVE ADDRESS IN SIGMA1. 4F13994
ALS 15 POSITION SIGMA TAG. 4F13995
ORS E ADD SIGMA TAG TO I-TAU TAGS IN E. 4F13996
LXD SSIR4,4 RELOAD CALLING TAG. 4F13997
TRA 1,4 RETURN TO CALLER +1. 4F13998
REM 4F13999
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F14000
REM 4F14001
REM ROYCNV,4/ CALLS=C0190,FXCNIX,FLCNIX,DIAG. 4F14002
REM ROYCNV DOES FIXED AND FLOATING POINT CONVERSION FOR SECTION 4F14003
REM ARITHMETIC. 4F14004
REM ROYCNV=ENTRY POINT FOR FIXED OR FLOATING POINT INTEGERS, 4F14005
ROYCNV STO N SAVE DECIMAL DIGIT IN N. 4F14006
SXD EXIT,4 SAVE C(XR4) FOR RETURN. 4F14007
STZ DOE CLEAR DOE (IMPLICIT EXPONENT). 4F14008
CLA CM1 PICK UP SWITCH CONTROL. 4F14009
EXIT TXI IN2,0,** AND GO SET SWITCH. 4F14010
REM DECPNT=ENTRY POINT FOR FLOATING POINT FRACTIONS. 4F14011
DECPNT STZ N CLEAR N (NO INTEGER). 4F14012
SXD EXIT,4 SAVE C(XR4) FOR RETURN. 4F14013
STZ DOE CLEAR DOE (IMPLICIT EXPONENT). 4F14014
NC7 CAL CM1 PICK UP SWITCH CONTROL. 4F14015
IN2 STP CM2 SET SWITCHES CM2, AND 4F14016
STP CM3 CM3. 4F14017
TOV NC5 TURN OFF OV TRIGGER. 4F14018
NC5 TSX C0190,4 * GO GET NEXT NB CHARACTER IN THE AC. 4F14019
SLW CHSAVE SAVE IT FOR STATE B, AND THEN 4F14020
CAS L(H) COMPARE IT WITH H. 4F14021
TXI NC1,0 IF H, GO TO HEXIT, 4F14022
SSIR4 TXI HEXIT,0 IF NOT H, CONTINUE 4F14023
NC1 CAS TEN AND COMPARE WITH TEN. 4F14024
CM1 TXL NC2,0 CHAR EXCEEDS IO, SO IS NON-NUMERIC. 4F14025
PXD ,0 CLEAR THE AC (MACHINE ERROR). 4F14026
STO H CHARACTER IS NUMERIC SO HOLD IT. 4F14027
CLA N MULTIPLY THE PREVIOUS 4F14028
ALS 2 PARTIAL RESULT (OR ZERO) 4F14029
ADD N BY 10, 4F14030
ALS 1 AND ADD IN 4F14031
ADD H THE CURRENT DIGIT. 4F14032
CM2 TXH NC3,0 SWITCH (NO TRANSFER IF INTEGER). 4F14033
TOV NC4 TEST OVERFLOW, AND 4F14034
STO N IF NONE, SAVE NEW PARTIAL RESULT. 4F14035
TXI NC5,0 THEN GO PICK UP NEXT CHARACTER. 4F14036
NC2 CAS POINT COMPARE NON-NUMERIC WITH A POINT. 4F14037
TXI CM3,0 IF GREATER THAN 27, GO OUT. 4F14038
TXI NC7,0 IF POINT, GO BACK AND SET SWITCH. 4F14039
CAS L(E) IF LESS THAN 27, COMPARE WITH E. 4F14040
TXI CM3,0 IF GREATER THAN 21, GO OUT. 4F14041
TXI EC1,0 IF E, GO TO EXPONENT ROUTINE. 4F14042
CM3 TXH FN4,0 SWITCH (NO TRANSFER IF INTEGER). 4F14043
CLA N PICK UP CONVERTED CONSTANT, AND 4F14044
MS9506 ALS 18 STORE IN THE 4F14045
STO G DECREMENT OF G, AND 4F14046
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 111/111 ------
TSX FXCNIX,4 * GO MAKE FIXCON ENTRY. 4F14047
ORA FIXVAR CREATE INTERNAL FXD-PT VARIABLE,AND 4F14048
TXI EXITR,0 GO TAKE EXITR. 4F14049
NC3 TOV NC8 IF THERE WAS NO OVERFLOW, 4F14050
STO N SAVE PARTIAL RESULT, AND 4F14051
CLS L(1) SUBTRACT 1 FROM DOE 4F14052
NC9 ADD DOE TO ADJUST EXPONENT 4F14053
STO DOE IN FINAL RESULT. 4F14054
NC8 TXI NC5,0 THEN GO PICK UP NEXT CHARACTER. 4F14055
NC4 CLA L(1) ADD 1 TO DOE , 4F14056
TXI NC9,0 IF THERE WAS INTEGER OVERFLOW. 4F14057
EC1 TSX C0190,4 * GO GET NEXT NB CHARACTER IN THE AC. 4F14058
SLW CHSAVE SAVE IT FOR STATE B, AND 4F14059
STZ EKE CLEAR EKE (EXPLICIT EXPONENT). 4F14060
CAS 11Z COMPARE CHARACTER WITH A DASH. 4F14061
TXI FN5,0 IF GREATER THAN 32, GO OUT. 4F14062
TXI EC3,0 IF A DASH, SET EKE MINUS. 4F14063
CAS 12Z IF LESS THAN 32, COMPARE WITH PLUS. 4F14064
TXI FN5,0 IF GREATER THAN 16, GO OUT. 4F14065
TXI EC6,0 IF PLUS, GO EXAMINE NEXT CHAR. 4F14066
CAS MINUS IF LESS THAN 16,COMPARE WITH MINUS. 4F14067
TXI FN5,0 IF GREATER THAN 12, GO OUT. 4F14068
EC3 CLS EKE IF MINUS, SET EKE TO -0. 4F14069
CAS TEN COMPARE WITH TEN. 4F14070
TXI FN5,0 IF NON-NUMERIC, GO EXAMINE NEXT CH. 4F14071
EC4 PXD ,0 CLEAR ACC, 4F14072
EC5 STO EKE SAVE PARTIAL RESULT(OR 0)IN EKE. 4F14073
EC6 TSX C0190,4 * GO GET NEXT NB CHARACTER IN THE AC. 4F14074
SLW CHSAVE SAVE IT FOR STATE B, 4F14075
CAS TEN AND COMPARE WITH TEN. 4F14076
TXI FN5,0 CHAR EXCEEDS 10, SO IS NON-NUMERIC. 4F14077
PXD ,0 CLEAR THE AC (MACHINE ERROR). 4F14078
STO H CHARACTER IS NUMERIC, SO HOLD IT. 4F14079
CLA EKE MULTIPLY THE PREVIOUS 4F14080
ALS 2 PARTIAL RESULT (OR ZERO) 4F14081
ADD EKE BY 10, 4F14082
ALS 1 AND ADD IN 4F14083
ACL H THE CURRENT DIGIT. 4F14084
TXI EC5,0 CONTINUE UNTIL NON-NUMERIC IS MET. 4F14085
FN5 CLA EKE COMBINE EXPLICIT EXPONENT 4F14086
ADD DOE WITH IMPLICIT EXPONENT, 4F14087
STO DOE AND SAVE IN DOE. 4F14088
FN4 CLA N IF N CONTAINS ZERO, TAKE 4F14089
TZE MS9500 FLO PT CONSTANT RETURN. 4F14090
STA K1 PUT INTEGER INTO FLO PT WORD, 4F14091
ARS 15 ADJUST, AND 4F14092
TZE FN1 IF MORE THAN 15 BITS IN LENGTH 4F14093
ORA K2 AFFIX CORRECT EXPONENT. 4F14094
FN1 FAD K1 THEN FLOATING ADD THE RESULT 4F14095
RQL 8 OF INTEGER CONVERSION, AND 4F14096
RND ROUND --TO OBTAIN 4F14097
ORA K3 NORMALIZED RESULT. 4F14098
LXA DOE,1 EXAMINE THE C(DOE), AND 4F14099
TXL MS9500,1,0 IF ZERO, TAKE FLO PT RETURN. 4F14100
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 112/112 ------
TXL FN2,1,50 IF GREATER THAN 50, THEN 4F14101
TXI CER,0 ERROR. -GO TO DIAGNOSTIC 4F14102
FN2 LDQ DOE DETERMINE WHETHER INTEGER WAS 4F14103
TQP FN3 TO THE RIGHT OR TO THE LEFT OF DP, 4F14104
FDP TAB,1 IF TO THE RIGHT, DIVIDE BY A 4F14105
STQ N SUITABLE CONSTANT 4F14106
CLA N TO ADJUST RESULT 4F14107
ACL K4 AND TEST FOR OUT OF RANGE. 4F14108
PBT IF P=I, SKIP TO ARITH RETURN. 4F14109
TXI CER,0 ERROR. --GO TO DIAGNOSTIC 4F14110
MS9500 STO G STORE IN G, AND 4F14111
TSX FLCNIX,4 * GO MAKE FLOCON ENTRY. 4F14112
ORA FLOVAR CREATE INTERNAL FLO-PT VARIABLE, 4F14113
EXITR SLW E+2 SAVE VARIABLE IN E+2, 4F14114
LXD EXIT,4 RESTORE THE C(XR4), AND 4F14115
TRA 2,4 * RETURN TO MAIN ROUTINE. 4F14116
FN3 STO N IF INTEGER WAS SITUATED 4F14117
LDQ N TO THE LEFT OF THE DECIMAL POINT, 4F14118
FMP TAB,1 MULTIPLY BY A SUITABLE 4F14119
ACL K5 CONSTANT TO ADJUST AND TEST RANGE. 4F14120
PBT IF P=I, SKIP TO ERROR, 4F14121
TXI MS9500,0 RETURN TO ARITHMETIC ROUTINE, 4F14122
CER TSX DIAG,4 * CONVERSION ERROR, GO TO DIAGNOSTIC. 4F14123
HEXIT LXD EXIT,4 RESTORE THE C(XR4), AND 4F14124
TRA 1,4 * RETURN TO MAIN ROUTINE. 4F14125
REM 4F14126
K1 OCT 233000000000 CONSTANT USED BY ROYCNV. 4F14127
K2 OCT 252000000000 CONSTANT USED BY ROYCNV. 4F14128
K3 OCT 400000000 CONSTANT USED BY ROYCNV. 4F14129
K4 OCT 335000000000 CONSTANT USED BY ROYCNV. 4F14130
K5 OCT 43000000000 CONSTANT USED BY ROYCNV. 4F14131
L(E) BCD 100000E CONSTANT USED BY ROYCNV. 4F14132
REM 4F14133
OCT 375536246150 48-TABLE USED BY ROYCNV. 4F14134
OCT 372430204754 47-TABLE USED BY ROYCNV. 4F14135
OCT 366700324573 46-TABLE USED BY ROYCNV. 4F14136
OCT 363546566774 45-TABLE USED BY ROYCNV. 4F14137
OCT 360436770626 44-TABLE USED BY ROYCNV. 4F14138
OCT 354713132675 43-TABLE USED BY ROYCNV. 4F14139
OCT 351557257061 42-TABLE USED BY ROYCNV. 4F14140
OCT 346445677215 41-TABLE USED BY ROYCNV. 4F14141
OCT 342726145174 40-TABLE USED BY ROYCNV. 4F14142
OCT 337570120775 39-TABLE USED BY ROYCNV. 4F14143
OCT 334454732312 38-TABLE USED BY ROYCNV. 4F14144
OCT 330741367020 37-TABLE USED BY ROYCNV, 4F14145
OCT 325601137163 36-TABLE USED BY ROYCNV. 4F14146
OCT 322464114134 35-TABLE USED BY ROYCNV. 4F14147
OCT 316755023372 34-TABLE USED BY ROYCNV. 4F14148
OCT 313612334310 33-TABLE USED BY ROYCNV. 4F14149
OCT 310473426555 32-TABLE USED BY ROYCNV. 4F14150
OCT 304770675742 31-TABLE USED BY ROYCNV. 4F14151
OCT 301623713116 30-TABLE USED BY ROYCNV. 4F14152
OCT 276503074076 29-TABLE USED BY ROYCNV. 4F14153
OCT 273402374713 28-TABLE USED BY ROYCNV. 4F14154
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 113/113 ------
OCT 267635456171 27-TABLE USED BY ROYCNV. 4F14155
OCT 264512676456 26-TABLE USED BY ROYCNV. 4F14156
OCT 261410545213 25-TABLE USED BY ROYCNV. 4F14157
OCT 255647410337 24-TABLE USED BY ROYCNV. 4F14158
OCT 252522640262 23-TABLE USED BY ROYCNV. 4F14159
OCT 247417031702 22-TABLE USED BY ROYCNV. 4F14160
OCT 243661534466 21-TABLE USED BY ROYCNV. 4F14161
OCT 240532743536 20-TABLE USED BY ROYCNV. 4F14162
OCT 235425434430 19-TABLE USED BY ROYCNV. 4F14163
OCT 231674055530 18-TABLE USED BY ROYCNV. 4F14164
OCT 226543212741 17-TABLE USED BY ROYCNV. 4F14165
OCT 223434157116 16-TABLE USED BY ROYCNV. 4F14166
OCT 217706576512 15-TABLE USED BY ROYCNV. 4F14167
OCT 214553630410 14-TABLE USED BY ROYCNV. 4F14168
OCT 211443023471 13-TABLE USED BY ROYCNV. 4F14169
OCT 205721522451 12-TABLE USED BY ROYCNV. 4F14170
OCT 202564416672 11-TABLE USED BY ROYCNV. 4F14171
OCT 177452013710 10-TABLE USED BY ROYCNV. 4F14172
OCT 173734654500 09-TABLE USED BY ROYCNV. 4F14173
OCT 170575360400 08-TABLE USED BY ROYCNV. 4F14174
OCT 165461132000 07-TABLE USED BY ROYCNV. 4F14175
OCT 161750220000 06-TABLE USED BY ROYCNV. 4F14176
OCT 156606500000 05-TABLE USED BY ROYCNV. 4F14177
OCT 153470400000 04-TABLE USED BY ROYCNV. 4F14178
OCT 147764000000 03-TABLE USED BY ROYCNV. 4F14179
OCT 144620000000 02-TABLE USED BY ROYCNV. 4F14180
OCT 141500000000 01-TABLE USED BY ROYCNV. 4F14181
TAB OCT 136400000000 00-TABLE USED BY ROYCNV. 4F14182
REM END OF PROGRAM ROYCNV. 4F14183
REM ****************************** *4F14184
REM 4F14185
SIG1ST PZE SIGMA1+2,,1 4F14186
ENDBDR BSS 0 4F141865
REM 4F14187
ENDB ORG 2701 4F14188
ARGREG BSS 50 4F14189
CBAR BSS 1 4F14190
ABAR BSS 1 4F14191
FSTYPE BSS 1 4F14192
FSBITS BSS 1 4F14193
FNBITS BSS 1 4F14194
FNCTR BSS 1 4F14195
ALPHA BSS 139 4F14196
LAMBDA BSS 1200 4F14197
REM END OF ARITHMETIC / STATE B. 4F14198
REM ****************************** *4F14199
REM 4F14200
REM ARITHMETIC / STATE C= 4F14201
REM 704 FORTRAN MASTER RECORD CARD / STATE C = F0170000. 4F14202
ORG 0 4F142021
PZE ORGC,,DMWR03 4F142022
PZE ENDC-1 4F142023
REM 4F14203
REM STATE C. PERFORMS OPTIMIZATION ON LAMBDA TABLE, 4F14204
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 114/114 ------
REM 4F14205
ORGC ORG 1824 4F14206
R00000 LDQ L(0) CLEAR MQ 4F14207
LXD NBAR,A LDXA WITH -N 4F14208
SXD R00700,A 4F14209
SXD R05200,A 4F14210
SXD AS0800,A 4F14211
SXD AS2900,A 4F14212
LXA L(0),7 CLEAR XA,XB,XC, 4F14213
R00500 STQ BETA,B 4F14214
TXI R00700,B,-1 4F14215
R00700 TXH R00500,B,0 4F14216
CLA 3LBAR 4F14217
STD R01700 4F14218
STD R06200 4F14219
R01000 CLA LAMBDA,A ADD INTO GAMMA COUNTERS 4F14220
PAX 0,B 4F14221
CLA BETA,B 4F14222
ADD BETAD1 (-3)*2**18+(-3) 4F14223
STD BETA,B 4F14224
STA BETA,B 4F14225
TXI R01700,A,-3 4F14226
R01700 TXH R01000,A,0 -3L IN XA AT END 4F14227
R01800 TXH R04200,A,-6 EXIT FROM SINGLE ELEMENT REDUCTION 4F14228
CLA LAMBDA-3,A 4F14229
PAX 0,B 4F14230
CLA BETA,B 4F14231
SUB BETAD1 4F14232
TZE R02600 4F14233
TXI R01800,A,3 4F14234
R02600 LDQ LAMBDA-2,A SINGLE ELEMENT 4F14235
LGL 6 EXAMINE OPERATION 4F14236
SUB 11Z 4F14237
TNZ R03200 4F14238
TXI R01800,A,3 4F14239
R03200 CAL MASK1 SINGLE ELEMENT, NON-UNARY OP 4F14240
ANS LAMBDA-3,A EXTRACT TAGS AND STORE BACK 4F14241
CLA LAMBDA-6,A 4F14242
ORA LAMBDA-3,A 4F14243
SLW LAMBDA-6,A 4F14244
CAL LAMBDA-2,A EXTRACT FS BITS AND STORE BACK 4F14245
ANA MASK5 4F14246
ORS LAMBDA-5,A 4F14247
CAL LAMBDA-1,A STORE BACK SYMBOL 4F14248
SLW LAMBDA-4,A 4F14249
STZ BETA,3 REDUCE GAMMA COUNT TO 0 4F14250
STZ LAMBDA-3,A CLEAR TAG WORD 4F14251
TXI R01800,A,3 RESUME SCAN-BACK 4F14252
R04200 STZ G 4F14253
LXA L(0),7 CLEAR XA,XB,XC 4F14254
R04500 CLA BETA,B SET ORIGINS OF SCRIPL TABLE 4F14255
TZE R05100 4F14256
LDQ G 4F14257
SLQ BETA,B 4F14258
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 115/115 ------
ADD G 4F14259
STD G 4F14260
R05100 TXI R05200,B,-1 4F14261
R05200 TXH R04500,B,0 DEC(K)=DEC(ACC)=-3P AT END 4F14262
R05300 CAL LAMBDA,A STRING BEADS... COMPRESS LAMBDA TABLE 4F14263
TZE R06100 4F14264
SLW LAMBDA,C 4F14265
CLA LAMBDA+1,A 4F14266
STO LAMBDA+1,C 4F14267
CLA LAMBDA+2,A 4F14268
STO LAMBDA+2,C 4F14269
TXI R06100,C,-3 4F14270
R06100 TXI R06200,A,-3 4F14271
R06200 TXH R05300,A,0 4F14272
SXD R07800,C -3P IN XC AT END 4F14273
SXD CS0760,C 4F14274
LXA L(0),A 4F14275
R06400 CLA LAMBDA,A STORE ORDERED, REDUCED LAMBDA TABLE 4F14276
PAX 0,B IN SCRIPL TABLE 4F14277
CLA BETA,B 4F14278
PDX 0,C 4F14279
CLA LAMBDA,A 4F14260
STO SCRIPL,C 4F14281
CLA LAMBDA+1,A 4F14282
STO SCRIPL+1,C 4F14283
CLA LAMBDA+2,A 4F14284
STO SCRIPL+2,C 4F14265
TXI R07500,C,-3 4F14286
R07500 PXD 0,C 4F14287
STD BETA,B 4F14288
TXI R07800,A,-3 4F14289
R07800 TXH R06400,A,0 -3P IN XA AT END 4F14290
CS0000 LDQ L(0) ELIMINATE COMMON SEGMENTS 4F14291
CS0010 CAL SCRIPL-3,A 4F14292
TZE CS0080 ERASED SEGMENT - CONTINUE BACK-SCAN 4F14293
CS0030 PAX 0,B 4F14294
TXL CS0660,B,0 EXIT FROM CS ROUTINE 4F14295
STA CS0030 4F14296
CLA BETA,B 4F14297
CS0060 PAX 0,C 4F14298
TXL CS0090,C,-6 AT LEAST TWO ELEMENTS 4F14299
CS0080 TXI CS0010,A,3 ONE ELEMENT OR ERASED SEGMENT 4F14300
CS0090 SXD CS0470,A SAVE XA 4F14301
SXD LENGTH,C SAVE XC, CONTAINING LENGTH OF SEGMENT 4F14302
CS0100 TXL CS0130,C,0 SEARCH UP FOR MATCHING SEGMENT 4F14303
TXI CS0120,A,3 4F14304
CS0120 TXI CS0100,C,3 4F14305
CS0130 CAL SCRIPL-3,A 4F14306
TNZ CS0151 4F14307
TXI CS0130,A,3 ERASED SEGMENT 4F14308
CS0151 PAX 0,B 4F14309
TXL CS0610,B,0 GO ON TO NEXT SEGMENT 4F14310
STA CS0060 4F14311
CLA BETA,B 4F14312
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 116/116 ------
PAX 0,C 4F14313
PXD 0,C 4F14314
SUB LENGTH 4F14315
TNZ CS0100 NOT SAME LENGTH SEGMENT-CONTINUE SEARCH 4F14316
LXD CS0470,B SAME LENGTH SEGMENT 4F14317
SXD CS0600,A 4F14318
CS0250 TXL CS0430,C,0 MATCHING SEGMENTS 4F14319
CLA SCRIPL-1,B 4F14320
SUB SCRIPL-1,A 4F14321
TNZ CS0100 4F14322
CAL SCRIPL-3,B SYMBOLS MATCH 4F14323
ANA MASK1 4F14324
SLW G 4F14325
CAL SCRIPL-3,A 4F14326
ANA MASK1 4F14327
COM 4F14328
ACL G 4F14329
COM 4F14330
TNZ CS0100 4F14331
CLA SCRIPL-2,B TAGS MATCH 4F14332
ARS 6 4F14333
ALS 6 4F14334
SUB SCRIPL-2,A 4F14335
TNZ CS0100 4F14336
TXI CS0360,A,3 OPS MATCH 4F14337
CS0360 TXI CS0370,B,3 4F14338
CS0370 TXI CS0250,C,3 4F14339
CS0430 CAL SCRIPL,A MATCHING SEGMENTS 4F14340
ANA MASK2 SEARCH FOR REFERENCES 4F14341
CS0450 CAS SCRIPL-1,A 4F14342
TXI CS0450,A,3 4F14343
CS0470 TXI CS0490,0,0 4F14344
TXI CS0450,A,3 4F14345
CS0490 CLA CS0030 CHANGE REFERENCE 4F14346
STA SCRIPL-1,A 4F14347
LXD LENGTH,C 4F14348
LXD CS0600,A 4F14349
CS0530 TXL CS0570,C,0 ERASE DUPLICATE SEGMENT 4F14350
STQ SCRIPL-3,A 4F14351
TXI CS0560,A,3 4F14352
CS0560 TXI CS0530,C,3 4F14353
CS0570 LXA CS0060,C 4F14354
STQ BETA,C 4F14355
CAL 11Z STORE CS BIT 4F14356
ORS SCRIPL+1,B 4F14357
CS0600 TXI CS0130,0,0 4F14358
CS0610 LXD CS0470,A 4F14359
LXD LENGTH,C 4F14360
CS0630 TXL CS0010,C,0 4F14361
TXI CS0650,A,3 4F14362
CS0650 TXI CS0630,C,3 4F14363
CS0660 LXA L(0),5 STRING BEADS... COMPRESS SCRIPL TABLE 4F14364
CS0670 CAL SCRIPL,A 4F14365
TZE CS0750 4F14366
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 117/117 ------
SLW SCRIPL,C 4F14367
CLA SCRIPL+1,A 4F14368
STO SCRIPL+1,C 4F14369
CLA SCRIPL+2,A 4F14370
STO SCRIPL+2,C 4F14371
TXI CS0750,C,-3 4F14372
CS0750 TXI CS0760,A,-3 4F14373
CS0760 TXH CS0670,A,0 4F14374
SXD PM0080,C -3Q IN XC AT END 4F14375
SXD AS1800,C 4F14376
SXD AS3600,C 4F14377
PM0000 SLF TURN OFF ALL SENSE LITES 4F14378
LXA L(0),A PERMUTE * AND / 4F14379
PM0010 CLA SCRIPL,A 4F14380
PAX 0,B 4F14381
CLA BETA,B 4F14382
PAX 0,C LDXC WITH SEGMENT LENGTH 4F14383
SXD PM0070,C 4F14384
TXL PM0100,C,-9 4F14385
PM0070 TXI PM0080,A,0 LENGTH LESS THAN 3 OR OD NOT = TO * 4F14386
PM0080 TXL AS0000,A,0 EXIT FROM PERMUTATION ROUTINE 4F14387
TRA PM0010 4F14388
PM0100 LDQ SCRIPL+1,A SEGMENT LENGTH AT LEAST = TO 3 4F14389
PXD 0,0 4F14390
LGL 6 4F14391
SUB STAR 4F14392
TNZ PM0070 4F14393
TQP PM0170 4F14394
TRA PM0070 4F14395
PM0170 SXD PM0260,C 4F14396
SXD PM0400,C 4F14397
SXD PM0680,C 4F14398
LXA L(0),C LDXC WITH 0 4F14399
TXI PM0240,A,-3 4F14400
PM0240 SLN 3 TURN * LITE ON 4F14401
PM0250 TXI PM0260,C,-3 4F14402
PM0260 TXL PM0790,C,0 EXIT 4F14403
SXD PM0340,C 4F14404
LXD PM0290,B 4F14405
PM0290 TXI PM0300,3,0 XA TO XA AND XB 4F14406
PM0300 PXD 0,0 4F14407
LDQ SCRIPL+1,A 4F14408
LGL 6 4F14409
CAS SLASH 4F14410
FEXUB HTR 0,0,7 4F14411
PM0340 TXL PM0640,0,0 / SIGN 4F14412
SLT 3 * SIGN... IS * LITE ON 4F14413
TXI PM0240,A,-3 NO 4F14414
TXI PM0390,B,-3 YES - SEARCH FOR / SIGN 4F14415
PM0390 TXI PM0400,C,-3 4F14416
PM0400 TXL PM0770,C,0 EXIT 4F14417
PXD 0,0 4F14418
LDQ SCRIPL+1,B 4F14419
LGL 6 4F14420
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 118/118 ------
SUB SLASH 4F14421
TZE PM0480 4F14422
TXI PM0390,B,-3 4F14423
PM0480 CLA SCRIPL,A PERMUTE TAG WORDS 4F14424
LDQ SCRIPL,B 4F14425
STQ SCRIPL,A 4F14426
STO SCRIPL,B 4F14427
CLA SCRIPL+1,A PERMUTE OP WORDS 4F14428
LDQ SCRIPL+1,B 4F14429
STQ SCRIPL+1,A 4F14430
STO SCRIPL+1,B 4F14431
CLA SCRIPL+2,A PERMUTE SYMBOL WORDS 4F14432
LDQ SCRIPL+2,B 4F14433
STQ SCRIPL+2,A 4F14434
STO SCRIPL+2,B 4F14435
LXD PM0340,C 4F14436
TXI PM0250,A,-3 RESUME SEGMENT SCAN 4F14437
PM0640 SLT 3 / SIGN... IS * LITE ON 4F14438
PM0650 TXI PM0670,B,-3 NO 4F14439
TXI PM0250,A,-3 4F14440
PM0670 TXI PM0680,C,-3 4F14441
PM0680 TXL PM0770,C,0 4F14442
PXD 0,0 4F14443
LDQ SCRIPL+1,B 4F14444
LGL 6 4F14445
SUB SLASH 4F14446
TZE PM0650 4F14447
SLN 3 TURN * LITE ON 4F14448
TRA PM0480 4F14449
PM0770 LXD PM0780,A 4F14450
PM0780 TXI PM0790,3,0 XB TO XA,XB 4F14451
PM0790 PXD 0,0 4F14452
LDQ SCRIPL-2,A 4F14453
LGL 6 4F14454
SUB SLASH 4F14455
TZE PM0080 ... / - EXIT FROM SEGMENT SCAN 4F14456
PXD 0,0 4F14457
LDQ SCRIPL-5,A 4F14458
LGL 6 4F14459
SUB SLASH 4F14460
TZE PM0080 ... / * - EXIT FROM SEGMENT SCAN 4F14461
CLA SCRIPL-3,A ... ** 4F14462
STO E 4F14463
CLA SCRIPL-2,A 4F14464
STO E+1 4F14465
CLA SCRIPL-1,A 4F14466
STO E+2 4F14467
TXI PM0980,A,3 4F14468
PM0980 TXI PM0990,C,3 4F14469
PM0990 TXL PM1070,C,0 FINIS 4F14470
CLA SCRIPL-3,A 4F14471
STO SCRIPL,A 4F14472
CLA SCRIPL-2,A 4F14473
STO SCRIPL+1,A 4F14474
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 119/119 ------
CLA SCRIPL-1,A 4F14475
STO SCRIPL+2,A 4F14476
TXI PM0980,A,3 4F14477
PM1070 CLA E 4F14478
STO SCRIPL,A 4F14479
CLA E+1 4F14480
STO SCRIPL+1,A 4F14481
CLA E+2 4F14482
STO SCRIPL+2,A 4F14483
CAL SCRIPL+4,A PRESERVE CS BIT 4F14484
ANA 11Z 4F14485
ORS SCRIPL+1,A 4F14486
TRA PM0070 4F14487
AS0000 LXA L(0),7 RENUMBER SEGMENT OF SCRIPL 4F14488
AS0100 CLA BETA,B 4F14489
TZE AS0700 4F14490
PXD 0,C 4F14491
ARS 18 4F14492
STA BETA,B 4F14493
TXI AS0700,C,-1 4F14494
AS0700 TXI AS0800,B,-1 4F14495
AS0800 TXH AS0100,B,0 4F14496
AS0900 CLA SCRIPL,A 4F14497
PAX 0,B 4F14498
CLA BETA,B 4F14499
STA SCRIPL,A 4F14500
LDQ SCRIPL+2,A 4F14501
LGL 1 4F14502
LBT 4F14503
TQP AS2000 4F14504
TXI AS1800,A,-3 4F14505
AS1800 TXH AS0900,A,0 4F14506
TRA AS2500 4F14507
AS2000 LGL 35 4F14508
PAX 0,B 4F14509
CLA BETA,B 4F14510
STA SCRIPL+2,A 4F14511
TXI AS1800,A,-3 4F14512
AS2500 LXA L(0),3 LDXA,XB WITH 0 4F14513
LDQ L(0) CLEAR MQ 4F14514
AS2700 STO BETA,B RECLEAR BETA TABLE 4F14515
TXI AS2900,B,-1 4F14516
AS2900 TXH AS2700,B,0 4F14517
AS3000 CLA SCRIPL,A ADD INTO GAMMA COUNTERS 4F14518
PAX 0,B 4F14519
CLA BETA,B 4F14520
ADD BETAD2 3*2**18+(-3) 4F14521
STD BETA,B 4F14522
STA BETA,B 4F14523
TXI AS3600,A,-3 4F14524
AS3600 TXH AS3000,A,0 -30 IN XA AT END 4F14525
SXD 3QBAR,A -30 TO 3QBAR = 3LBAR 4F14526
CCS000 CAL SCRIPL-3,A ELIMINATE COMMON SUBEXPRESSIONS 4F14527
PAX 0,B LOAD XB WITH S(1) 4F14528
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 120/120 ------
TXL CCS240,B,0 EXIT AT S(O) 4F14529
CAL BETA,B OBTAIN LENGTH OF S(I) 4F14530
STD CCS060 AND BACK UP TO 4F14531
CCS060 TXI CCS070,A,0 BEGINNING OF CURRENT SEGMENT 4F14532
CCS070 CAL SCRIPL+1,A OBTAIN OP1 (S(I)) 4F14533
ANA 11Z EXTRACT CS-BIT 4F14534
TZE CCS000 CONTINUE TO S(I-1) 4F14535
PXD 0,B 4F14536
ARS 18 4F14537
LXA L(0),C TO S(I) 4F14538
LXD CCS140,B AND KEEP COUNT OF SAME 4F14539
CCS140 TXI CCS150,3,0 XA TO XA,XB 4F14540
CCS150 TXL CCS200,B,0 SEARCH-UP FINISHED, EXAMINE COUNT 4F14541
CAS SCRIPL-1,B 4F14542
TXI CCS150,B,3 CONTINUE SEARCH 4F14543
TXI CCS190,C,1 RAISE REF COUNTER AND 4F14544
CCS190 TXI CCS150,B,3 CONTINUE SEARCH 4F14545
CCS200 TXH CCS000,C,1 MULTIPLE REFERENCE 4F14546
CAL MASK4 SINGLE REFERENCE - SO SET 4F14547
ANS SCRIPL+1,A OP1(S(I))3O TO O, AND 4F14548
TRA CCS000 CONTINUE FOR S(I-1) 4F14549
CCS240 LXD AS3600,A -3Q TO XA 4F14550
PL0000 TXL LK0000,A,0 GO TO LINKAGE 4F14551
CLA SCRIPL-3,A 4F14552
PAX 0,B 4F14553
CAL BETA,B 4F14554
PAX 0,C 4F14555
STD PL0060 4F14556
PL0060 TXI PL0070,A,0 SET XA TO BEGINNING OF S(I) 4F14557
PL0070 PXD 0,0 4F14558
LDQ SCRIPL+1,A OBTAIN 4F14559
LGL 6 AND 4F14560
CAS SPECOP EXAMINE OP1 (S(I)) 4F14561
TRA PL0680 4F14562
TRA PL0460 4F14563
PL0130 PXD 0,0 0P1 (S(I)) IS +, - OR * 4F14564
LDQ SCRIPL+2,A OBTAIN 4F14565
LGL 1 AND 4F14566
LBT EXAMINE SYM1 (S(I)) 4F14567
TQP PL0300 4F14568
LGL 5 EX (IN)TERNAL VARIABLE 4F14569
PL0135 CAS L(H) IS SYM1 (S(I)) FIX OR FLO PT 4F14570
CAS L(0) 4F14571
TRA PL0240 FLO PT... SET 0P1 (S(I)) 32 = 1 4F14572
TRA PL0240 FLO PT... DITTO 4F14573
TRA PL0000 FIX PT... OP1 (S(I)) 32 = 0 4F14574
PL0240 CAL L(8) SET OP1 (S(I)) 32 = 1 4F14575
PL0250 ORS SCRIPL+1,A 4F14576
PL0260 TXI PL0000,0,0 CONTINUE SCAN 4F14577
PL0300 LXD PL0310,B SYM1 (S(I)) = SOME S(J) 4F14578
PL0310 TXI PL0320,3,0 XA TO XA,XB 4F14579
PL0320 SXD PL0330,C 4F14580
PL0330 TXI PL0340,B,0 4F14581
PL0340 CAL SCRIPL,B 4F14582
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 121/121 ------
PAX 0,C 4F14583
ANA MASK2 4F14584
SUB SCRIPL+2,A 4F14585
TZE PL0420 4F14586
CLA BETA,C 4F14587
PAX 0,C 4F14588
TRA PL0320 4F14589
PL0420 CAL SCRIPL+1,B SYM1(S(I)) = S(J) 4F14590
ANA L(8) EXTRACT OP1 (S(J)) 32 AND GO 4F14591
TRA PL0250 SET OP1 (S(I)) 32 = OP1 (S(J)) 32 4F14592
PL0460 LGL 7 OP1 (S(I)) IS SPOP 4F14593
TQP PL0465 4F14594
PL0461 LDQ SCRIPL+2,A FS NAME - 4F14595
PXD 0,0 EXAMINE SUM1 (S(I)) S,1-5 4F14596
LGL 6 4F14597
SUB L(X) 4F14598
TNZ PL0240 FLO PT... GO SET OP1 (S(I)) 32 = 1 4F14599
TRA PL0000 FIX PT ... OP1 (S(I)) 32 = 0 4F14600
PL0465 LBT 4F14601
TRA PL0470 4F14602
LDQ SCRIPL+2,A 4F14603
PXD ,0 4F14604
LGL 6 4F14605
TRA PL0135 4F14606
PL0470 CLA SCRIPL+2,A NOT AN FS NAME 4F14607
LXA L(0),B 4F14608
PL0480 CAS OPSUB,B 4F14609
TXI PL0520,B,-1 4F14610
TRA PL0650 4F14611
TXI PL0520,B,-1 4F14612
PL0520 TXH PL0480,B,-20 4F14613
STO G 4F14614
SXD PL0260,A 4F14615
TSX TET00,A 4F14616
HTR 9 4F14617
LXD PL0260,A 4F14618
TRA PL0461 4F14619
PL0650 CAL L(4) SET OP1 (S(I)) 33 =I 4F14620
ORS SCRIPL+1,A 4F14621
TRA PL0461 4F14622
PL0680 TQP PL0130 4F14623
PXD 0,0 OP1 (S(I) IS ** 4F14624
LDQ SCRIPL+2,A OBTAIN AND 4F14625
LGL 1 EXAMINE 4F14626
LBT SYM1 (S(I)) 4F14627
TQP PL1000 4F14628
LGL 5 EX (IN)TERNAL VARIABLE 4F14629
CAS L(H) IS OT FIX OR FLO PT 4F14630
CAS L(0) 4F14631
TRA PL0800 4F14632
TRA PL0800 4F14633
TRA PL0830 FIX PT 4F14634
PL0800 CAL L(8) FLO PT... SET OP1 (S(I)) 32 = 1 4F14635
PL0820 ORS SCRIPL+1,A 4F14636
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 122/122 ------
PL0830 PXD 0,0 4F14637
LDQ SCRIPL+5,A OBTAIN 4F14638
LGL 1 AND 4F14639
LBT EXAMINE 4F14640
TQP PL1200 SYM2 (S(I)) 4F14641
LGL 5 4F14642
CAS L(H) 4F14643
CAS L(0) 4F14644
TRA PL0940 SYM2 (S(I)) IS FLO PT, SO GO 4F14645
TRA PL0940 SET OP2 (S(I)) 32 = 1 4F14646
PL0850 PXD 0,0 SYM2(S(I)) IS FIX PT 4F14647
LGL 6 4F14648
SUB OPEN 4F14649
TNZ PL0000 SYM2 (S(I)) IS EXTERNAL 4F14650
LGL 25 SYM2 (S(I)) IS INTERNAL (AND FIX PT) 4F14651
ADD PL0880 4F14652
STA PL0850 4F14653
RDR FXCODR 4F14654
LDA PL0850 4F14655
CPY G 4F14656
CPY 6+1 4F14657
CLA G 4F14658
CAS G+1 4F14659
TRA *+2 GO TO THE DIAGNOSTIC 4F14660
TRA PL1570 4F14661
TSX DIAG,4 * GO TO THE DIAGNOSTIC 4F14662
PL1570 TZE PL0000 EXP IS 0, SO OP1 (S(I)) 33 = 0 4F14663
CAS FEXUB 4F14664
PL0880 TXH FIXCON,0,0 EXP NOT LESS THAN 7, SO 4F14665
TRA PL0000 OP1 (S(I)) 33 = 0 4F14666
STO SCRIPL+5,A EXP LESS THAN 7, SO STORE EXP 4F14667
CAL L(4) AS SYM2 (S(I)) AND SET 4F14668
ORS SCRIPL+1,A OP1 (S(I)) 33 = 1 4F14669
TRA PL0000 4F14670
PL0940 CAL L(8) SYM2 (S(I)) IS FLO PT 4F14671
ORS SCRIPL+4,A SET OP2 (S(I)) 32 = 1 4F14672
TRA PL0000 4F14673
PL1000 LXD PL1010,B SYM1 (S(I)) IS SOME S(J) 4F14674
PL1010 TXI PL1020,3,0 XA TO XA,XB 4F14675
PL1020 SXD PL1030,C 4F14676
PL1030 TXI PL1040,B,0 4F14677
PL1040 CAL SCRIPL,B 4F14678
PAX 0,C 4F14679
ANA MASK2 4F14680
SUB SCRIPL+2,A 4F14681
TZE PL1130 4F14682
CLA BETA,C 4F14683
PAX 0,C 4F14684
TRA PL1020 4F14685
PL1130 CAL SCRIPL+1,B 4F14686
ANA L(8) 4F14687
TRA PL0820 4F14688
PL1200 LXD PL1210,B SYM2 (S(I)) = SOME S(K) 4F14689
PL1210 TXI PL1220,3,0 XA TO XA,XB 4F14690
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 123/123 ------
PL1220 LXD PL1330,C LKXC WITH -6 4F14691
PL1230 SXD PL1240,C 4F14692
PL1240 TXI PL1250,B,0 4F14693
PL1250 CAL SCRIPL,B 4F14694
PAX 0,C 4F14695
ANA MASK2 4F14696
SUB SCRIPL+5,A 4F14697
TZE PL1340 SYM2(S(I)) = S(K) 4F14698
CLA BETA,C 4F14699
PAX 0,C 4F14700
PL1330 TXI PL1230,0,-6 4F14701
PL1340 CAL SCRIPL+1,B SET OP2(S(I)) 32 = 0P1 (S(K)) 32 4F14702
ANA L(8) 4F14703
ORS SCRIPL+4,A 4F14704
TRA PL0000 RESUME SCAN 4F14705
LK0000 LXD AS3600,A -3Q TO XA 4F14706
LK0030 CAL SCRIPL-3,A 4F14707
PAX 0,B S(I) TO XB 4F14708
TXL LK1610,8,0 EXIT UPON ENCOUNTERING S(0) 4F14709
LDQ SCRIPL-2,A PLACE LAST OP OP S(I) IN MQ 4F14710
CLA BETA,B 4F14711
STD LK0110 4F14712
LK0110 TXI LK0120,A,0 MOVE XA TO BEGINNING OF S(I) 4F14713
LK0120 LXD LK0130,C 4F14714
LK0130 TXI LK0140,5,0 XA TO XA,XC 4F14715
LK0140 SXD AS3600,A 4F14716
CLA BETA-1,B 4F14717
PDX 0,B LENGTH OF S(I-1) TO XB 4F14718
SXD LK0180,B 4F14719
LK0180 TXI LK0190,C,0 MOVE XC TO BEGINNING OF S(I-1) 4F14720
LK0190 TQP LK1200 S(I) TYPE AC 4F14721
RQL 1 4F14722
TQP LK1200 S(I) TYPE AC 4F14723
CAL 12Z S(I) RESULTS IN MQ (TYPE MQ) 4F14724
ORS SCRIPL+1,A SET OP1 (S(I)) 31 = 1 4F14725
PXD 0,0 4F14726
LDQ SCRIPL+1,C PLACE OP1 (S(I-1)) IN MQ 4F14727
LGL 6 4F14728
CAS SPECOP 4F14729
TRA LK0320 4F14730
TRA LK0950 4F14731
TRA LK0030 S(I)TYPTMQ, S(I-1)TYPEAC . OP1(S(I))29=0 4F14732
LK0320 TQP LK0570 4F14733
LGL 27 S(I)TYPE MQ, OP1(S(I-1) = ** 4F14734
CAL SCRIPL,A 4F14735
ANA MASK2 EXTRACT S(I) IN ACC 4F14736
TQP LK0480 OP1 (S(I-1)) 33 = 0 4F14737
SUB SCRIPL+2,C OP1 (S(I-1)) 33 = 1, OPEN ** SUBROUTINE. 4F14738
TNZ LK0030 SET OP1 (S(I)) 29 = OP1 (S(I-1)) 35 = 0 4F14739
CAL L(3) S(I) = SYM1 (S(I-1)), SO 4F14740
LK0430 ORS SCRIPL+1,C 4F14741
LK0440 CAL BIT29 4F14742
ORS SCRIPL+1,A 4F14743
TRA LK0030 OP1 (S(I-1)) = 0, CLOSED ** SUBROUTINES 4F14744
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 124/124 ------
LK0480 SUB SCRIPL+5,C 4F14745
TNZ LK0030 SET OPKS(I))29=OPKS(I-1))35=0 4F14746
CAL L(1) S(I) = SYM2 (S(I-1)), SO 4F14747
ORS SCRIPL+4,C SET OP2 (S(I-1)) 35 = 1 4F14748
TRA LK0440 4F14749
LK0570 PXD 0,0 S(I) TYPE MO, OP1 (S(I-1)) = * 4F14750
LDQ SCRIPL+4,C PLACE PO2 (S(I-1)) IN MQ 4F14751
LGL 6 IS OP2 (S(I-1)) = * 4F14752
SUB STAR 4F14753
TNZ LK0030 NO - SET OP1 (S(I)) 29 = OP1 (S(I-1)) 35 =04F14754
CAL L(2) YES 4F14755
ORS SCRIPL+1,C SET OP1(S(I-1))34=1 4F14756
LK0630 CAL SCRIPL,A 4F14757
ANA MASK2 SEARCH FOR S(I) IN S(I-1) 4F14758
LK0650 TXL LK0000,B,0 NOT FOUND AT ALL 4F14759
CAS SCRIPL-1,A 4F14760
TXI LK0700,A,3 4F14761
TRA LK0710 4F14762
TXI LK0700,A,3 NOT FOUND - CONTINUE SEARCH 4F14763
LK0700 TXI LK0650,B,-3 4F14764
LK0710 LDQ SCRIPL-2,A S(I) IS SYMJ (S(I-1)) 4F14765
RQL 1 IS OPJ (S(I-1)) = * 4F14766
TQP LK0750 4F14767
TXI LK0700,A,3 NO... CONTINUE SEARCH 4F14768
LK0750 CLA SCRIPL,C YES...PERMUTE EL1(S(I-1)) WITH ELJ(S(I-1)) 4F14769
LDQ SCRIPL-3,A EXCHANGE 4F14770
STO SCRIPL-3,A TAG 4F14771
STQ SCRIPL,C WORDS 4F14772
CAL SCRIPL+1,C PLACE OP1 (S(I-1)) IN ACC 4F14773
LDQ SCRIPL-2,A PLACE OPJ (S(I-1)) IN MQ 4F14774
SLW SCRIPL-2,A EXCHANGE 4F14775
STQ SCRIPL+1,C OP 4F14776
ANA MASK2 WORDS AND 4F14777
ORS SCRIPL+1,C SET OP1(S(I-1))30-33= OPJ(S(I-1))30-33 4F14778
CLA SCRIPL+2,C THEN 4F14779
LDQ SCRIPL-1,A EXCHANGE 4F14780
STO SCRIPL-1,A SYMBOL 4F14781
STQ SCRIPL+2,C WORDS 4F14762
LXD AS3600,A RESTORE XA 4F14783
LK0900 CAL L(1) AND 4F14784
TRA LK0430 4F14785
LK0950 RQL 27 S(I) TYPE MQ, OP1 (S(I-1)) = SPOP 4F14786
CAL SCRIPL,A 4F14787
ANA MASK2 EXTRACT S(I) IN ACC 4F14788
TQP LK1050 OP1 (S(I-1)) 33 = 0 (CLOSED 5UBROUTINE) 4F14789
TXH LK0030,B,6 OPEN MULTIV... SET OP1 (S(I)) 29 = 0 4F14790
SUB SCRIPL+5,C OPEN UNIV... IS S(I) = SUM2 (S(I-1)) 4F14791
TNZ LK0030 N0... SET 0P1 (S(I))29 = OP2 (S(I-1))35 =0 4F14792
CAL L(3) AND 4F14793
ORS SCRIPL+4,C SET OP2 (S(I-1))34 = OP2 (S(I-1))35 = 1 4F14794
TRA LK0440 4F14795
LK1050 RQL 15 4F14796
TQP LK1100 TEST OP1(S(I-1))12 4F14797
TRA LK0030 FN-NAME 4F14798
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 125/125 ------
LK1100 TXL LK0030,B,6 CLOSED UNIV. SBRTN 4F14799
SUB SCRIPL+8,C CLOSED MULTIV. SBRTN 4F14800
TNZ LK0030 S(I) NOT = SYM3 (S (I-1)) 4F14801
CAL L(1) S(I) = SYM3 (S(I-1)), SO 4F14802
ORS SCRIPL+7,C SET OP3 (S(1-1)135 = 1 4F14803
TRA LK0440 4F14804
LK1200 PXD 0,0 S(I) TYPE AC 4F14805
LDQ SCRIPL+1,C PLACE OP1 (S(I-1)) IN MO 4F14806
LGL 6 4F14807
CAS SPECOP 4F14808
TRA LK1340 4F14809
TRA LK1470 4F14810
CAL SCRIPL,A S(I) TYPE AC OP1 (S(I-1)) = + OR - 4F14811
ANA MASK2 SEARCH FOR S(I) IN S(I-1) 4F14812
LK1280 TXL LK0000,B,0 NOT FOUND AT ALL 4F14813
CAS SCRIPL-1,A 4F14814
TXI LK1330,A,3 4F14815
TRA LK0750 S(I) = SOME SYMJ (S(I-1))... GO PERMUTE 4F14816
TXI LK1330,A,3 NOT FOUND... CONTINUE SEARCH 4F14817
LK1330 TXI LK1280,B,-3 4F14818
LK1340 TQP LK1410 4F14819
CAL SCRIPL,A S(I) TYPE AC OP1 (S(I-1)) = ** 4F14820
ANA MASK2 4F14821
SUB SCRIPL+2,C IS S(I) = SYM1 (S(I-1)) 4F14822
TNZ LK0030 NO 4F14823
TRA LK0900 YES 4F14824
LK1410 PXD 0,0 S(I) TYPE AC OP1 (S(I-1)) = * 4F14825
LDQ SCRIPL+4,C 4F14826
LGL 6 IS OP2 (S(I-1)) = 1 4F14827
SUB SLASH 4F14828
TZE LK0630 YES 4F14829
CAL L(2) NO 4F14830
ORS SCRIPL+1,C SET OP1 (S(I-1)) 34 = 1 4F14831
TRA LK0000 4F14832
LK1470 RQL 27 S(I) TYPE AC OP1 (S(I-1)) = SPOP 4F14833
CAL SCRIPL,A 4F14834
ANA MASK2 EXTRACT S(I) IN ACC 4F14835
TQP LK1530 4F14836
TXH LK0030,B,6 OPEN MULTIV. 4F14837
LK1520 TRA LK0480 4F14838
LK1530 RQL 15 4F14839
TQP LK0480 4F14840
TRA LK0030 FN-NAME 4F14841
LK1610 LXD BETA,B IS S(0) A SINGLE ELEMENT 4F14842
PXD 0,0 4F14843
LDQ SCRIPL-2,A 4F14844
TXH LK1780,B,3 NO 4F14645
LGL 6 YES 4F14846
SUB 11Z IS OP (S(0)) = + OR - 4F14847
TZE LKK000 OP (S(0)) = - 4F14648
CAL SCRIPL+2 OP (S(0)) = + 4F14849
ANA MASK1 DOES SYM (S(0)) = S(1) 4F14850
TNZ LKK000 NO 4F14851
CAL SCRIPL+4 YES - PLACE OP1 (S(I)) IN ACC 4F14852
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 126/126 ------
ANA 12Z 4F14853
TZE LKK000 OP1 (S(1)) 31 = 0 4F14854
ORS SCRIPL+1 SET OP (S(0)) 31 = 1 4F14855
ALS 2 4F14856
ORS SCRIPL+4 SET OP1 (S(1)) 29 = 1 4F14857
ARS 6 4F14658
TRA LK1820 4F14859
LK1780 TQP LKK000 S(0) TYPE AC 4F14860
RQL 1 4F14861
TQP LKK000 S(0) TYPE AC 4F14862
CAL 12Z S(0) TYPE MQ, SO 4F14863
LK1820 ORS SCRIPL+1 4F14864
LKK000 LXD 3QBAR,5 -3Q TO XA,XC 4F14865
CAL SCRIPL-3,C 4F14866
PAX 0,8 4F14867
CLA BETA,B 4F14868
STD LKK050 4F14869
LKK050 TXI LKK060,C,0 BACK UP XA TO 1ST ELEMENT OF LAST SEGMENT 4F14870
LKK060 PXD 0,0 4F14871
LDQ SCRIPL+1,C PLACE OP1 OF LAST SEGMENT IN MQ 4F14872
LGL 6 4F14873
SUB STAR 4F14874
TNZ PC0000 4F14875
TQP LKK130 4F14876
TRA PC0000 4F14877
LKK130 LDQ SCRIPL+4,C OP1 OF LAST SEGMENT IS * 4F14878
LGL 2 4F14879
LBT 4F14880
ORS SCRIPL+1,C OP2 IS *, SO SET OP1 (S(L)) 34 = 1 4F14881
PC0000 LXD ARGCTR,C IS THIS AN FS 4F14882
TXH PC0030,C,0 4F14883
TXI PC0040,C,1 NO 4F14884
PC0030 LXA L(0),C YES 4F14885
PC0040 CAL SCRIPL-3,A 4F14886
PAX 0,B 4F14887
TXL PC0190,B,0 EXIT AT S(0) 4F14888
CLA BETA,B 4F14889
STD PC0100 4F14890
PC0100 TXI PC0110,A,0 4F14891
PC0110 LDQ SCRIPL+1,A PLACE OP1 (S(1)) IN MQ 4F14892
LGL 30 4F14893
LBT 4F14894
PC0140 TXI PC0160,0,300 4F14895
TQP PC0040 OP1 (S(1)) 29= 1 AND OP1 (S(1)) 30 = 0 4F14896
PC0160 PXD 0,C OP1 (S(I)) 29 = 0 OR OP1 (S(1)) 30 = 1 4F14897
STD BETA,B STORE ERAS. REL, ADD. COUNT IN BETA, 4F14898
TXI PC0040,C,1 AND UPDATE FOR NEXT SEGMENT 4F14899
PC0190 LXD PC0140,B 4F14900
PC0200 CLA BETA+300,B 4F14901
STO CPBETA+300,B 4F14902
TIX PC0200,B,1 4F14903
TRA STATED GO FETCH STATE D 4F14904
REM ******* *********************** * 4F14905
REM 4F14906
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 127/127 ------
REM DICTIONARY OF OPEN SUBROUTINES FOLLOWS 4F14907
OPSUB OCT 672122626060 XABS 4F14908
OCT 212262606060 ABS 4F14909
OCT 673145636060 XINT 4F14910
OCT 314563606060 INT 4F14911
OCT 674446246060 XMOD 4F14912
OCT 444624606060 MOD 4F14913
OCT 674421670060 XMAXO 4F14914
OCT 442167016060 MAX1 4F14915
OCT 674421670160 XMAX1 4F14916
OCT 442167006060 MAXO 4F14917
OCT 674431450060 XMINO 4F14918
OCT 443145016060 MINI 4F14919
OCT 674431450160 XMIN1 4F14920
OCT 443145006060 MIN0 4F14921
OCT 264346216360 FLOAT 4F14922
OCT 672631676060 XFIX 4F14923
OCT 623127456060 SIGN 4F14924
OCT 676231274560 XSIGN 4F14925
OCT 672431446060 XDIM 4F14926
OCT 243144606060 DIM 4F14927
BSS 10 4F14928
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F14929
ENDCDR BSS 0 4F149295
REM 4F14930
ENDC ORG 2596 4F14931
BETA BSS 300 4F14932
REM END OF ARITHMETIC / STATE C* 4F14933
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F14934
REM 4F14935
REM ARITHMETIC / STATE D= 4F14936
REM 704 FORTRAN MASTER RECORD CARD / STATE D = F0160000. 4F14937
ORG 0 4F149371
PZE ORGD,,CLDR00 4F149372
PZE ENDD-1 4F149373
REM 4F14938
ORGD ORG 1824 4F14939
MC0000 LXD 3QBAR,A MODE CHECKING ROUTINE 4F14940
SXD MC0420,A 4F14941
LXA L(0),A 4F14942
MC0030 SXD XASAVE,A 4F14943
CAL SCRIPL,A 4F14944
MC0050 PAX ,2 S(1) TO XB 4F14945
CLA CPBETA,B 4F14946
MC0070 PAX TAU2,B 4F14947
SXD MC0410,B 4F14948
SXD MC0460,B 4F14949
TXH MC0410,B,-6 SINGLE ELEMENT - GO ONTO S(I+1) 4F14950
SLF TURN OFF ALL SENSE LITES 4F14951
PXD 0,0 CLEAR ACC 4F14952
LDQ SCRIPL+1,A PLACE OP1 (S(I)) IN MQ 4F14953
LGL 6 4F14954
CAS SPECOP 4F14955
TQP MC0180 4F14956
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 128/128 ------
XASAVE TXI MC0410,0,0 4F14957
MC0180 LGL 26 OP1 (S(I)) = +, - OR * 4F14958
TQP MC0210 FIX PT 4F14959
SLN 1 FLO PT 4F14960
MC0210 PXD 0,0 4F14961
LDQ SCRIPL+2,A PLACE SYMJ (S(I)) IN MQ - J = I,... 4F14962
LGL 1 4F14963
LBT 4F14964
TQP MC0440 4F14965
LGL 5 SYMJ (S(I)) IS A VARIABLE 4F14966
CAS L(H) 4F14967
CAS L(0) 4F14968
XBSAVE TXI MC0340,0,0 FLO PT 4F14969
TRA MC0340 FLO PT 4F14970
MC0310 SLT 1 SYMJ (S(I)) IS A FIX PT VARIABLE 4F14971
TXI MC0380,B,3 OK 4F14972
TSX DIAG,4 ERROR.. FLO PT LITE ON 4F14973
MC0340 SLT 1 SYMJ(S(I)) IS A FLO PT VARIABLE 4F14974
TSX DIAG,4 ERROR.. FLO PT LITE OFF 4F14975
SLN 1 RESTORE FLO PT LITE 4F14976
TXI MC0380,B,3 4F14977
MC0380 TXL MC0400,B,0 FINISHED WITH S(I) 4F14978
TXI MC0210,A,-3 CONTINUE SCANNING S(I). J TO J+1 4F14979
MC0400 LXD XASAVE,A GO TO S(I+1) 4F14980
MC0410 TXI MC0420,A,0 4F14981
MC0420 TXH MC0030,A,0 4F14982
TRA CP0000 EXIT TO COMPILER 4F14983
MC0440 SXD XBSAVE,B SYMJ (S(ITT = SAME S(K) 4F14984
LXD XASAVE,C 4F14985
MC0460 TXI MC0470,C,0 MOVE XC TO 1ST ELEMENT OF S(I+1) 4F14986
MC0470 CAL SCRIPL,C 4F14987
ANA MASK2 EXTRACT S(K) IN ACC 4F14988
CAS SCRIPL+2,A AND COMPARE WITH SYMJ (S(I)) 4F14989
TRA MC0520 4F14990
TRA MC0570 4F14991
MC0520 PAX SIGMA1,B S(K) TO XB 4F14992
CLA CPBETA,B 4F14993
MC0540 PAX TAU1,B 4F14994
SXD MC0560,B 4F14995
MC0560 TXI MC0470,C,0 4F14996
MC0570 LXD XBSAVE,B SYMJ (S(I)) = S(K) FOR SOME K 4F14997
CAL SCRIPL+1,C PLACE OP1 (S(K)) IN ACC 4F14998
ARS 3 4F14999
LBT 4F15000
TRA MC0310 S(K) IS FIX PT 4F15001
TRA MC0340 S(K) IS FLO PT 4F15002
REM 4F15003
CP0000 SLF TURN OFF ALL SENSE LITES 4F15004
STZ FNSW 4F15005
LXD ARGCTR,C IS THIS AN FS STATEMENT 4F15006
TXL CP0090,C,0 NO 4F15007
TSX CIT00,C YES - COMPILE FOUR 36 - BIT 4F15008
HTR ALL1 STRINGS IN 1 AS A PRELUDE TO 4F15009
HTR ALL1 FS STATEMENT COMPILATION 4F15010
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 129/129 ------
HTR ALL1 4F15011
HTR ALL1 4F15012
CP0090 CAL EIFNO 4F15013
ANA MASK1 4F15014
SLW CW STO INT. FORM. NO. IN DEC FIELD OF CW. 4F15015
LXD 3QBAR,A -30 TO XA 4F15016
CP0130 CLA SCRIPL-3,A EXTRACT CURRENT S(I) 4F15017
CP0140 PAX ,2 4F15018
CLA CPBETA,B 4F15019
STD PHI(I) STO ERAS. REL. ADD. IN PHI (I) 4F15020
ANA MASK2 4F15021
CP0180 PAX TAU3,B 4F15022
SXD CP0400,B 4F15023
COM 4F15024
ADD L(1) 4F15025
ALS 18 4F15026
STD CP0240 4F15027
CP0240 TXI CP0250,A,0 MOVE XA TO 1ST ELEMENT OF CURRENT S(I) 4F15028
CP0250 SXD 3QBAR,A 4F15029
LDQ SCRIPL+1,A EXAMINE OP1 (S(I)) 29,30,31,32 4F15030
LGL 30 4F15031
LBT 4F15032
TRA CP0310 OP1 (S(I)) 29 = 0 4F15033
TQP CP0370 OP1 (S(I)) 30 = 0 4F15034
CP0310 SLN 1 OP1 (S(I)) 29 = 0 OR OP1 (S(I)) 30 = 1, SO 4F15035
RQL 1 SET STORE LITE 4F15036
TQP CP0350 OP1 (S(I)) 31 = 0, SO SET STO LITE 4F15037
SLN 2 OP1 (S(I)) 31 = 1, SO SET STQ LITE 4F15038
CP0350 RQL 1 4F15039
TRA CP0380 4F15040
CP0370 RQL 2 4F15041
CP0380 TQP CP0420 TEST OP1 (S(I)) 32 4F15042
SLT 4 OP1 (S(I)) 32 = 1, SO SET FLPTSW 4F15043
CP0400 TXH 0,0,0 4F15044
TRA CP0430 4F15045
CP0420 SLN 4 OP1 (S(I)) 32 = 0, SO SET FXPTSW 4F15046
CP0430 PXD 0,0 4F15047
LDQ SCRIPL+1,A PLACE OP1 (S(I)) IN MQ 4F15048
LGL 6 4F15049
CAS SPECOP 4F15050
TXI CP0960,0,0 4F15051
TXI CP2040,A,-3 4F15052
SUB 11Z 4F15053
TZE CP0760 4F15054
LGL 29 OP1 (S(I)) = + 4F15055
TQP CP1130 OP1 (S(I)) 35 = 0 4F15056
CP0540 LXD CP0400,B OP1 (S(I)) 35 = 1 4F15057
TXI CP0560,B,3 4F15058
CP0560 TXL ES0000,B,0 GO TO END-OF-SEGMENT SBRTN 4F15059
SXD CP0400,B 4F15060
TXI CP0590,A,-3 4F15061
CP0590 PXD 0,0 4F15062
LDQ SCRIPL+1,A PLACE OPJ (S(I)) IN MQ 4F15063
LGL 6 4F15064
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 130/130 ------
CAS STAR 4F15065
TRA CP1200 OPJ (S(I)) = / 4F15066
TRA CP1720 OPJ (S(I)) = * 4F15067
SUB 11Z 4F15068
TZE CP0880 OPJ (S(I)) = - 4F15069
CAL L(FAD) OPJ (S(I)) = + 4F15070
SLT 4 4F15071
TRA CP0740 4F15072
SLN 4 FIX PT. RESTORE FXPTSW 4F15073
CAL L(ADD) 4F15074
CP0740 SLW CW+1 4F15075
TRA CP1690 4F15076
CP0760 LGL 29 0P1 (S(I)) = - 4F15077
TQP CP0850 4F15078
CAL L(CHS) 0P1 (S(I)) 35 = 1, SO 4F15079
SLW CW+1 COMPILE CHS FOR 1ST ELEMENT 4F15080
STZ CW+2 4F15081
STZ CW+3 4F15082
TSX COMP,B 4F15083
TRA CP0540 4F15064
CP0850 CAL L(CLS) 0P1 (S(I)) 35 = O, SO 4F15085
SLW CW+1 COMPILE CLS SYM1 (S(I)) FOR 1ST ELEMENT 4F15086
TRA CP1150 4F15087
CP0880 CAL L(FSB) OPJ (S(I)) = - 4F15088
SLT 4 4F15089
TRA CP0940 4F15090
SLN 4 FIX PT. RESTORE FXPTSW 4F15091
CAL L(SUB) 4F15092
CP0940 SLW CW+1 4F15093
TRA CP1690 4F15094
CP0960 TQP CP0980 4F15095
TRA CP4140 4F15096
CP0980 LGL 29 0P1 (S(I)) = * 4F15097
SLN 3 TURN LITE 3 ON 4F15098
LBT TEST 0P1 (S(I)) 34 4F15099
TRA CP1050 0P1 (S(I)) 34 = 0, SO LEAVE LITE 3 ON 4F15100
SLT 3 0P1 (S(I)) 34 = 1, SO TURN LITE 3 OFF 4F15101
TXH 0,0,0 4F15102
CP1050 TQP CP1070 4F15103
TRA CP0540 0P1 (S(I)) 35 = 1, SO GO MODIFY J 4F15104
CP1070 CAL L(LDQ) 0P1 (S(I)) 35 = 0 4F15105
SLT 3 4F15106
TRA CP1140 ELI (S(II) TO MQ 4F15107
SLN 3 ELI (S(II) TO ACC 4F15108
CP1130 CAL L(CLA) 4F15109
CP1140 SLW CW+1 4F15110
CP1150 TSX AC0000,C ADDRESS COMPILE SYM1 (S(I)) 4F15111
TSX COMP,B 4F15112
STZ CW RESET CW 4F15113
TRA CP0540 GO MODIFY J 4F15114
CP1200 SLT 3 OPJ (S(I)) = / 4F15115
TRA CP1330 4F15116
SLT 4 PREDECESSOR IN ACC 4F15117
TRA CP1670 FLO PT. 4F15118
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 131/131 ------
SLN 4 FIX PT. RESTORE FXPTSW 4F15119
TSX CIT00,C COMPILE LRS 35 4F15120
HTR L(0) 4F15121
HTR L(LRS) 4F15122
HTR L(0) 4F15123
HTR DEC35 4F15124
TRA CP1450 4F15125
CP1330 SLT 4 PREDECESSOR IN MQ 4F15126
TRA CP1570 AND SEGMENT IS 4F15127
SLN 4 FIX PT. RESTORE FXPTSW 4F15128
CP1450 CLA L(DVP) 4F15129
STO CW+1 4F15130
TSX AC0000,C ADDRESS COMPILE SYMJ (S(I)) 4F15131
TSX COMP,B COMPILE DVP SYMJ (S(I)) 4F15132
TSX CIT00,C COMPILE CLM 4F15133
HTR L(0) 4F15134
HTR L(CLM) 4F15135
HTR L(0) 4F15136
HTR L(0) 4F15137
TSX CIT00,C COMPILE LLS 18 4F15138
HTR L(0) 4F15139
HTR L(LLS) 4F15140
HTR L(0) 4F15141
HTR DEC18 4F15142
TRA CP0540 GO MODIFY J 4F15143
CP1570 CLA L(STQ) PREDECESSOR IN MQ 4F15144
STO CW+1 AND SEGMENT IS FLO PT 4F15145
CLA X( 4F15146
STO CW+2 4F15147
STZ CW+3 4F15148
TSX COMP,B COMPILE STO 700000 4F15149
CLA L(CLA) 4F15150
STO CW+1 4F15151
TSX COMP,B COMPILE CLA 700000 4F15152
CP1670 CLA L(FDP) 4F15153
STO CW+1 COMPILE FOP SYMJ (S(I)) 4F15154
CP1690 TSX AC0000,C ADDRESS COMPILE SYMJ (S(I)) 4F15155
TSX COMP,B 4F15156
TRA CP0540 GO MODIFY J 4F15157
CP1720 SLT 3 OPJ(S(I))=* 4F15158
TRA CP1840 4F15159
CLA L(STO) PREDECESSOR IN ACC 4F15160
STO CW+1 4F15161
CLA X( 4F15162
STO CW+2 4F15163
STZ CW+3 4F15164
TSX COMP,B COMPILE STO 700000 4F15165
CLA L(LDQ) 4F15166
STO CW+1 4F15167
TSX COMP,B COMPILE LDQ 700000 4F15168
CP1840 SLN 3 TURN LATE 3 ON 4F15169
TSX AC0000,C ADDRESS COMPILE SYMJ(S(I)) 4F15170
SLT 4 4F15171
TRA CP2000 4F15172
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 132/132 ------
SLN 4 FIX PT. RESTORE FXPTSW 4F15173
CLA L(MPY) 4F15174
STO CW+1 4F15175
TSX COMP,B COMPILE MPY SYMJ(S(I)) 4F15176
TSX CIT00,C COMPILE ALS 17 4F15177
HTR L(0) 4F15178
HTR L(ALS) 4F15179
HTR L(0) 4F15180
HTR DEC17 4F15181
TRA CP0540 GO MODIFY J 4F15182
CP2000 CLA L(FMP) FLO PT. 4F15183
STO CW+1 4F15184
TSX COMP,B COMPILE FMP SYMJ(S(I)) 4F15185
TRA CP0540 GO MODIFY J. 4F15186
CP2040 LGL 7 OPI(S(I))=SPOP 4F15187
LBT TEST OP1(S(I))12 4F15188
TQP CP2650 LIB OR OPEN FUNCTION 4F15189
TQP CP5000 FN-FUNCTION 4F15190
PXD 0,0 FS-FUNCTION 4F15191
LLS 15 PUT TYPE NO IN ADD(ACC) 4F15192
ORA P( FORM 4...TYPE NO. 4F15193
SLW ARGORG AND STO IN ARGORG 4F15194
ANA MASK2 4F15195
ORA X( FORM 7...TYPE NO. 4F15196
SLW XRSAVE AND STO IN XRSAVE 4F15197
CLA SCRIPL+1,A 4F15198
LBT EXAMINE OP2(S(I))35 4F15199
TRA CP2150 1ST ARG STORED 4F15200
CP2100 TSX CIT00,C 1ST ARG IN ACC 4F15201
HTR L(0) COMPILE STO 4...TYPE NO. + 0 4F15202
HTR L(STO) 4F15203
HTR ARGORG 4F15204
HTR L(0) 4F15205
TXI CP2200,A,-3 GO ON TO OP3(S(I)) 4F15206
CP2150 CAL L(CLA) 4F15207
SLW CW+1 4F15208
TSX AC0000,C ADDRESS COMPILE SYM2(S(I)) 4F15209
TSX COMP,B COMPILE CLA SYM2(S(I)) 4F15210
TRA CP2100 4F15211
CP2200 STZ CW RESET CW 4F15212
LXD CP0400,B 4F15213
TXI CP2230,B,3 4F15214
CP2230 TXH CP2500,B,-6 FINISHED WITH S(I) 4F15215
SXD CP0400,B 4F15216
CLA SCRIPL+1,A 4F15217
LBT EXAMINE OP3(S(I))35 4F15218
TRA CP2300 2ND ARG STORED 4F15219
CP2250 TSX CIT00,C 2ND ARG IN MQ 4F15220
HTR L(0) COMPILE STO 4...TYPE NO, + 1 4F15221
HTR L(STO) 4F15222
HTR ARGORG 4F15223
HTR 2E18 4F15224
TXI CP2350,A,-3 GO ON TO SYM4(S(I)) 4F15225
CP2300 CAL L(LDQ) 4F15226
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 133/133 ------
SLW CW+1 4F15227
TSX AC0000,C ADDRESS COMPILE SYM3(S(I)) 4F15228
TSX COMP,B COMPILE LDQ SYM3(S(I)) 4F15229
TRA CP2250 4F15230
CP2350 CLA DECMI2 INITIALIZE DEC(P(CNTR) TO 2 4F15231
SLW P(CNTR 4F15232
CP2370 LXD CP0400,B 4F15233
TXI CP2390,B,3 4F15234
CP2390 TXH CP2500,B,-6 FINISHED WITH S(I) 4F15235
SXD CP0400,B 4F15236
CAL L(CLA) 4F15237
SLW CW+1 4F15236
TSX AC0000,C ADDRESS COMPILE SYMJ(S(I)), J=4,... 4F15239
TSX COMP,B COMPILE CLA SYMJ(S(I)), J=4,... 4F15240
TSX CIT00,C COMPILE STO 4...TYPE NO, + J-2, J=4,... 4F15241
HTR L(0) 4F15242
HTR L(STO) 4F15243
HTR ARGORG 4F15244
HTR P(CNTR 4F15245
CLA P(CNTR UPDATE P(CNTR 4F15246
ADD 2E18 4F15247
STO P(CNTR 4F15248
TXI CP2370,A,-3 4F15249
CP2500 LXD 3QBAR,A FINISHED WITH S(I) 4F15250
CAL L(SXD) 4F15251
SLW CW+1 4F15252
CAL XRSAVE 4F15253
SLW CW+2 4F15254
CAL L(4) 4F15255
SLW CW+3 4F15256
TSX COMP,B COMPILE SXD 7...TYPE NO. , 4 4F15257
CAL L(TSX) 4F15258
SLW CW+1 4F15259
CAL SCRIPL+2,A 4F15260
SLW CW+2 4F15261
TSX COMP,B COMPILE TSX SYMI(S(I)),4 4F15262
CAL L(LXD) 4F15263
SLW CW+1 4F15264
CAL XRSAVE 4F15265
SLW CW+2 4F15266
TRA CP6000 4F15267
CP5830 TXI ES0000,0,0 4F15268
REM 4F15269
CP2650 LGL 20 TEST OPI(S(I))33 4F15270
TQP CP3060 0... LIB. SBRTN 4F15271
CLS CW 1... OPEN SBRTN 4F15272
STO CW CW TO -CW 4F15273
CLA SCRIPL-1,A 4F15274
STO CW+2 4F15275
TSX COMP,B COMPILE FUNCTION NAME 4F15276
STZ CW RESET CW 4F15277
LXD CP0400,B 4F15278
TXL CP2930,B,-9 4F15279
CAL ALL1 OPEN UNIVARIATE FUNCTION 4F15280
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 134/134 ------
SLW CW 4F15281
CLA SCRIPL+1,A 4F15282
LBT EXAMINE OP2(S(I))35 4F15283
TRA CP2900 0... ARG STORED 4F15284
ARS 1 1... ARG NOT STORED 4F15285
LDQ ADPLUS 4F15286
LBT 4F15287
TRA CP2860 4F15286
LDQ ADSTAR 4F15289
CP2860 STQ CW+2 4F15290
STZ CW+3 4F15291
CP2880 TSX COMP,B COMPILE ACC OR MQ INDICATOR 4F15292
STZ CW RESET CW 4F15293
TRA ES0000 4F15294
CP2900 TSX AC0000,C ADDRESS COMPILE SYM2(S(II) 4F15295
TRA CP2880 GO COMPILE SYM2(S(I)) 4F15296
CP2930 TSX AC0000,C OPEN MULTIVARIATE FUNCTION 4F15297
LXD CP0400,B 4F15298
TXI CP2960,B,3 4F15299
CP2960 TXH CP3000,B,-6 4F15300
SXD CP0400,B 4F15301
TSX COMP,B COMPILE SYMJ(S(I)) 4F15302
TXI CP2930,A,-3 4F15303
CP3000 CAL ALL1 4F15304
SLW CW 4F15305
TSX COMP,B COMPILE LAST ARGUMENT NAME 4F15306
STZ CW RESET CW 4F15307
TRA ES0000 GO TO END-OF-SEGMENT SBRTN 4F15308
CP3060 TXL CP3350,B,-9 4F15309
CLA SCRIPL+1,A CLOSED UNIVARIATE FUNCTION 4F15310
LBT EXAMINE OP2(S(I))35 4F15311
TRA CP3280 0... ARG STORED 4F15312
CP3100 CLA L(SXD) 1... ARG IN ACC 4F15313
STO CW+1 4F15314
CLA X( 4F15315
STO CW+2 4F15316
CLA L(4) 4F15317
STO CW+3 4F15318
TSX COMP,B COMPILE SXD7...0,4 4F15319
CLA L(TSX) 4F15320
STO CW+1 4F15321
CLA SCRIPL-1,A 4F15322
STO CW+2 4F15323
TSX COMP,B COMPILE TSX SYMI(S(I)),4 4F15324
TRA CP5780 COMPILE FLOW TRACE INFO AND LXD 7(,4 4F15325
CP3280 CLA L(CLA) 4F15331
STO CW+1 4F15332
TSX AC0000,C ADDRESS COMPILE SYM2(S(I)) 4F15333
TSX COMP,B COMPILE CLA SYM2(S(I)) 4F15334
STZ CW RESET CW 4F15335
TRA CP3100 GO COMPILE SXD,TSX,LXD SEQUENCE 4F15336
CP3350 TXL CP3560,B,-12 4F15337
CLA SCRIPL+1,A CLOSED BIVARIATE FUNCTION 4F15338
LBT EXAMINE OP2(S(I))35 4F15339
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 135/135 ------
TRA CP3450 0... ARG1 STORED 4F15340
CP3390 CLA L(LDQ) 1... ARG1 IN ACC 4F15341
STO CW+1 4F15342
TXI CP3420,A,-3 4F15343
CP3420 TSX AC0000,C ADDRESS COMPILE SYM3(S(I)) 4F15344
TSX COMP,B COMPILE LDQ SYM3(S(I)) 4F15345
TXI CP3100,A,3 GO COMPILE SXD,TSX,LXD SEQUENCE 4F15346
CP3450 CLA SCRIPL+4,A 4F15347
LBT EXAMINE OP3(S(I))35 4F15348
TRA CP3490 0... ARG2 STORED 4F15349
TRA CP3280 1... ARG2 IN MO 4F15350
CP3490 CLA L(CLA) 4F15351
STO CW+1 4F15352
TSX AC0000,C ADDRESS COMPILE SYM2(S(I)) 4F15353
TSX COMP,B COMPILE CLA SYM2(S(I)) 4F15354
STZ CW REST CW 4F15355
TRA CP3390 GO COMPILE LDQ,SXD,TSX,LXD SEQUENCE 4F15356
CP3560 CLA SCRIPL+1,A CLOSED MULTIVARIATE FUNCTION 4F15357
LBT EXAMINE OP2(S(II)35 4F15358
TXI CP3820,A,-6 0... ARG1 STORED 4F15359
TXI CP3600,A,-6 1... ARG1 IN ACC 4F15360
CP3600 CLA DECMI2 4F15361
STO P(CNTR INITIALIZE P(CNTR TO -2 4F15362
CP3620 CLA L(LDQ) 4F15363
STO CW+1 4F15364
TSX AC0000,C ADDRESS COMPILE SYMJ(S(I)) FOR J=4,5,... 4F15365
TSX COMP,B COMPILE LDQ SYMJ(S(I)) 4F15366
CLA L(STQ) 4F15367
STO CW+1 4F15368
CLA P( 4F15369
STO CW+2 4F15370
CLA P(CNTR 4F15371
STO CW+3 4F15372
SUB 2E18 4F15373
STO P(CNTR 4F15374
TSX COMP,B COMPILE STQ 4...0-(J-2) 4F15375
LXD CP0400,B 4F15376
TXI CP3770,B,3 4F15377
CP3770 TXL CP3800,B,-12 4F15378
LXD 3QBAR,A FINISHED WITH ARG VECTOR 4F15379
TXI CP3390,A,-3 4F15380
CP3800 SXD CP0400,B 4F15381
TXI CP3620,A,-3 GO PICK UP NEXT ARG. 4F15382
CP3820 CLA SCRIPL-2,A 4F15383
LBT EXAMINE OP3(S(I))35 4F15384
TXI CP4070,A,6 0... ARG2 STORED 4F15385
CLA DECMI2 1... ARG2 IN MQ 4F15386
STO P(CNTR 4F15387
CP3870 CLA L(CLA) 4F15388
STO CW+1 4F15389
TSX AC0000,C ADDRESS COMPILE SYMJ(S(I)) FOR J=4,5,... 4F15390
TSX COMP,B COMPILE CLA SYMJ(S(I)) 4F15391
CLA L(STO) 4F15392
STO CW+1 4F15393
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 136/136 ------
CLA P( 4F15394
STO CW+2 4F15395
CLA P(CNTR 4F15396
STO CW+3 4F15397
SUB 2E18 4F15398
STO P(CNTR 4F15399
TSX COMP,B COMPILE STO 4...0-(J-2) 4F15400
LXD CP0400,B 4F15401
TXI CP4020,B,3 4F15402
CP4020 TXL CP4050,B,-12 4F15403
LXD 3QBAR,A FINISHED WITH ARG VECTOR 4F15404
TXI CP3280,A,-3 4F15405
CP4050 SXD CP0400,B 4F15406
TXI CP3870,A,-3 GO PICK UP NEXT ARG 4F15407
CP4070 CLA L(CLA) 4F15408
STO CW+1 4F15409
TSX AC0000,C ADDRESS COMPILE SYM2(S(II) 4F15410
TSX COMP,B COMPILE CLASYM2(S(I)) 4F15411
STZ CW RESET CW 4F15412
TXI CP3600,A,-6 4F15413
CP4140 LGL 27 OP1(S(I))=** 4F15414
TQP CP4410 CLOSED SBRTN SINCE OP1(S(I))33=0 4F15415
LBT OPEN SBRTN SINCE OP1(S(I))33=1 4F15416
TRA CP4200 BASE FIX PT SINCE OP1(S(1))32=0 4F15417
CLA STRSTR BASE FLO PT SINCE OP1(S(1))32=1 4F15418
TRA CP4210 4F15419
CP4200 CLA ADSTAR 4F15420
CP4210 STO CW+1 4F15421
LGL 2 EXAMINE OP1(S(I))35 4F15422
TQP CP4310 0... BASE STORED 4F15423
LDQ ADSTAR 1... BASE NOT STORED 4F15424
LBT EXAMINE OP1(S(I)34 4F15425
LDQ ADPLUS 0... BASE IN ACC 4F15426
STO CW+2 1...BASE IN MQ 4F15427
STZ CW+3 4F15428
TRA CP4320 4F15429
CP4310 TSX AC0000,C ADDRESS COMPILE SYMI(S(I)) 4F15430
CP4320 CLS CW 4F15431
STO CW CW TO -CW 4F15432
TSX COMP,B COMPILE BASE 4F15433
STZ CW RESET CW 4F15434
CLA SCRIPL+5,A 4F15435
STO CW+2 4F15436
TSX COMP,B COMPILE FIX PT CONSTANT EXPONENT 4F15437
STZ CW+1 RESET CW+1 4F15438
TRA ES0000 4F15439
CP4410 LGL 3 CLOSED EXP. SBRTN 4F15440
LBT EXAMINE OP1(S(I))35 4F15441
TRA CP4860 0... BASE STORED 4F15442
CP4440 CLA L(LDQ) 1... BASE IN ACC. 4F15443
STO CW+1 4F15444
TXI CP4470,A,-3 4F15445
CP4470 TSX AC0000,C ADDRESS COMPILE SYM2(S(I)) 4F15446
TSX COMP,B COMPILE LDQ SYM2 (S(I)) 4F15447
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 137/137 ------
CP4490 CLA L(SXD) 4F15448
STO CW+1 4F15449
CLA X( 4F15450
STO CW+2 4F15451
CLA L(4) 4F15452
STO CW+3 4F15453
TSX COMP,B COMPILE SXD 7...0.4 4F15454
CLA L(TSX) 4F15455
STO CW+1 4F15456
CLA SCRIPL+1,A 4F15457
ARS 3 4F15458
LBT EXAMINE OP2(S(I))32 4F15459
TXI CP4660,A,3 O... 4F15460
CLA FLFL 1... FLO**FLO 4F15461
LDQ SCRIPL-2,A EXAMINE OPI(S(I)I32 TO CHECK 4F15462
RQL 32 FOR MIXED EXPONENTIAL EXPRESSION 4F15463
TQP MC0310+2 ERROR FIX PT BASE, FLOAT EXP. 4F15464
TRA CP4730 4F15465
CP4660 LDQ SCRIPL+1,A 4F15466
RQL 32 EXAMINE OP1(S(I))32 4F15467
CLA FXFX 4F15468
TQP CP4730 0...FX**FX 4F15469
CLA FLFX 1... FL**FX 4F15470
CP4730 STO CW+2 4F15471
STO G 4F15472
TSX COMP,B COMPILE TSX FXFX/FLEX/FLFL,4 4F15473
TSX TET00,A 4F15474
HTR 9 4F15475
TRA CP5780 COMPILE FLOW TRACE INFO AND LXD 7(,4 4F15476
CP4860 CLA L(CLA) 4F15462
STO CW+1 4F15483
TSX AC0000,C ADDRESS COMPILE SYM1(S(I)) 4F15484
TSX COMP,B COMPILE CLA SYMI(S(I)) 4F15485
STZ CW 4F15486
CLA SCRIPL+4,A 4F15487
LBT EXAMINE OP2*S(I))35 4F15488
TXI CP4440,0,0 0...EXP STORED 4F15489
TXI CP4490,A,-3 1... EXP IN MQ 4F15490
REM 4F15491
CP5000 CLA EIFNO FN FUNCTION 4F15492
ADD 2E18 UPDATE EIFNO 4F15493
STO EIFNO AND 4F15494
STO FNSW SET FN SWITCH 4F15495
STD 1C KEEP 1C UPDATED FOR PENDING TIFGO ENTRY, 4F15496
LXA L(1),C INITIALIZE 5TAIX TO 1 4F15497
CP5050 CLA SCRIPL,A EXAMIN TAGJ(S(I)), J=2,... 4F15498
TMI CP5180 NONSUBSCRIPTED 4F15499
SXD CP5830,B SUBSCRIPTED-IS THERE A GENERAL TAG 4F15500
SXD STACTR,C 4F15501
TSX AC0000,C 4F15502
CAL TAGPRT 4F15503
TNZ CP5220 GENERAL TAG PRESENT 4F15504
CAL CW+3 NO GENERAL TAG PRESENT,SO PLACE 4F15505
ARS 11 RELATIVE ADDRESS IN OPJ(S(I))14-28 AND 4F15506
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 138/138 ------
ORA NGTBIT SET OPJ(S(I))10=I FROM NGTBIT 4F15507
ORS SCRIPL+1,A 4F15508
CP5160 LXD STACTR,C 4F15509
LXD CP5830,B 4F15510
CP5180 TXI CP5190,B,3 4F15511
CP5190 TXH CP5460,B,-6 FINISHED WITH PRELUDE,IF ANY 4F15512
TXI CP5210,C,1 NOT FINISHED-STAIX=STAIX+1 4F15513
CP5210 TXI CP5050,A,-3 GO ON TO NEXT ARGUMENT 4F15514
CP5220 CAL L(PXD) 4F15515
SLW CW+1 4F15516
TSX COMP,B COMPILE PXD SYMJ(S(I)), TAGJ(S(I)) 4F15517
STZ CW RESET CW 4F15518
TSX CIT00,C COMPILE ARS 18 4F15519
HTR L(0) 4F15520
HTR L(ARS) 4F15521
HTR L(0) 4F15522
HTR DEC18 4F15523
TSX CIT00,C COMPILE ADD *-2 4F15524
HTR L(0) 4F15525
HTR L(ADD) 4F15526
HTR PROCTR 4F15527
HTR DECMI2 4F15528
CAL L(STA) 4F15529
SLW CW+1 4F15530
CAL EIFNO 4F15531
ANA MASK1 4F15532
SLW CW+2 4F15533
LXD STACTR,C 4F15534
PXD 0,C 4F15535
SLW CW+3 4F15536
TSX COMP,B COMPILE STA IFN+STAIX 4F15537
TXI CP5160,0,0 GO ON TO NEXT ARGUMENT,IF ANY 4F15538
CP5460 LXD 3QBAR,A 4F15539
CAL L(SXD) 4F15540
SLW CW+1 4F15541
CAL X( 4F15542
SLW CW+2 4F15543
CAL L(4) 4F15544
SLW CW+3 4F15545
TSX COMP,B COMPILE SXD 7,4 4F15546
CAL EIFNO 4F15547
ANA MASK1 4F15548
SLW CW 4F15549
CAL L(TSX) 4F15550
SLW CW+1 4F15551
CAL SCRIPL+2,A 4F15552
SLW CW+2 4F15553
TSX COMP,B COMPILE TSX SYMI(S(I)),4 4F15554
STZ CW RESET CW 4F15555
TXI CP5680,A,-3 POSITION XA TO SYM2(S(I)) 4F15556
CP5680 CLA SCRIPL,A 4F15557
TPL CP5700 4F15558
TSX AC0000,C NONSUBSCRIPTED 4F15559
STACTR TXI CP5720,0,0 4F15560
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 139/139 ------
CP5700 LDQ SCRIPL+1,A SUBSCRIPTED 4F15561
LGL 11 4F15562
LBT 4F15563
LDQ L(0) GENERAL TAG PRESENT 4F15564
STQ CW+3 NO GENERAL TAG PRESENT 4F15565
CAL SCRIPL+2,A 4F15566
SLW CW+2 4F15567
CP5720 TSX COMP,B COMPILE TSX SYMJ(S(I)) , J=2,,., 4F15568
LXD CP0400,B 4F15569
TXI CP5750,B,3 4F15570
CP5750 TXH CP5780,B,-6 FINISHED SCANNING 4F15571
SXD CP0400,B 4F15572
TXI CP5680,A,-3 4F15573
CP5780 TSX FLTR00,4 COMPILE FLOW TRACE INFO AND LXD 7(,4 4F15574
HTR L(0) 4F15575
HTR L(LXD) 4F15576
HTR X( 4F15577
HTR L(4) 4F15578
ES0000 LXD 3QBAR,A -3Q TO XA 4F15579
SLT 1 4F15580
TRA CP0130 GO TO NEXT SEGMENT 4F15581
CAL SCRIPL,A 4F15582
ANA MASK2 4F15583
TZE ES0160 4F15584
CLA ARERAS S(I) NOT = S(O) 4F15585
STO CW+2 4F15586
CLA PHI(I) 4F15587
STO CW+3 4F15588
CLA L(STQ) 4F15589
SLT 2 4F15590
CLA L(STO) 4F15591
STO CW+1 4F15592
TSX COMP,B COMPILE STO/STQ 1... TYPE NO + PHI(I) 4F15593
TRA CP0130 GO TO NEXT SEGMENT 4F15594
ES0160 LDQ LEFT+2 S(I)=S(O) 4F15595
LGL 12 4F15596
CAS IFSYM IS THIS AN IF STATEMENT 4F15597
TRA ES0200 4F15598
TRA ES1500 4F15599
ES0200 CAS CALLER IS THIS A CALL STATEMENT 4F15600
TRA ES0210 4F15601
TRA ES1520 4F15602
ES0210 CAS SAPSYM 4F15603
TRA ES0220 4F15604
TRA ES1710 4F15605
ES0220 ARS 6 4F15606
LXD ARGCTR,C IS THIS A FUNCTION STATEMENT 4F15607
TXH ES1300,C,0 YES 4F15608
CAS L(H) NOT A FUNCTION STATEMENT 4F15609
CAS L(0) 4F15610
TRA ES0300 4F15611
TRA ES0300 4F15612
SLT 4 4F15613
TRA ES0870 4F15614
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 140/140 ------
ES0710 CLA L(STO) FX(FLO) PT ON LEFT, FX(FLO) PT ON RIGHT 4F15615
SLT 2 4F15616
ES0730 CLA L(STO) 4F15617
STO CW+1 4F15618
CLA LEFT 4F15619
STO TAGWRD 4F15620
CLA LEFT+1 4F15621
STO OPWORD 4F15622
CLA LEFT+2 4F15623
STO SYMWRD 4F15624
TSX AC0060,C ADDRESS COMPILE VARIABLE ON LEFT 4F15625
TSX COMP,B COMPILE STO/STQ LEFT+2 4F15626
TRA ES1590 EXIT TO FETCH STATE A 4F15627
ES0870 SLT 2 FX PT ON LEFT, FLO PT ON RIGHT 4F15628
TRA ES0990 4F15629
CLA L(STQ) RESULT ON RIGHT APPEARS IN MQ 4F15630
STO CW+1 4F15631
CLA X( 4F15632
STO CW+2 4F15633
STZ CW+3 4F15634
TSX COMP,B COMPILE STQ 700000 4F15635
CLA L(CLA) 4F15636
STO CW+1 4F15637
TSX COMP,B COMPILE CLA 700000 4F15638
ES0990 TSX CIT00,C COMPILE FIXING INSTRUCTIONS, WHEN 4F15639
HTR L(0) RESULT ON RIGHT IS IN ACC. 4F15640
HTR L(UFA) 4F15641
HTR O( 4F15642
HTR L(0) 4F15643
TSX CIT00,C 4F15644
HTR L(0) 4F15645
HTR L(LRS) 4F15646
HTR L(0) 4F15647
HTR L(0) 4F15648
TSX CIT00,C 4F15649
HTR L(0) 4F15650
HTR L(ANA) 4F15651
HTR O( 4F15652
HTR 2E18 4F15653
TSX CIT00,C 4F15654
HTR L(0) 4F15655
HTR L(LLS) 4F15656
HTR L(0) 4F15657
HTR L(0) 4F15658
TSX CIT00,C 4F15659
HTR L(0) 4F15660
HTR L(ALS) 4F15661
HTR L(0) 4F15662
HTR DEC18 4F15663
TRA ES0610 4F15664
ES0300 SLT 4 4F15665
TRA ES0710 4F15666
ES0320 SLT 2 FLO PT ON LEFT, FX PT ON RIGHT 4F15667
TRA ES0440 4F15668
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 141/141 ------
CLA L(STQ) RESULT ON RIGHT APPEARS IN MO 4F15669
STO CW+1 4F15670
CLA X( 4F15671
STO CW+2 4F15672
STZ CW+3 4F15673
TSX COMP,B COMPILE STO 700000 4F15674
CLA L(CLA) 4F15675
STO CW+1 4F15676
TSX COMP,B COMPILE CLA 700000 4F15677
ES0440 TSX CIT00,C COMPILE FLOATING INSTRUCTIONS, WHEN 4F15678
HTR L(0) RESULT ON RIGHT IS IN ACC 4F15679
HTR L(LRS) 4F15680
HTR L(0) 4F15681
HTR DEC18 4F15682
TSX CIT00,C 4F15683
HTR L(0) 4F15684
HTR L(ORA) 4F15685
HTR O( 4F15686
HTR L(0) 4F15687
TSX CIT00,C 4F15688
HTR L(0) 4F15689
HTR L(FAD) 4F15690
HTR O( 4F15691
HTR L(0) 4F15692
ES0610 LXD ARGCTR,C IS THIS A FUNCTION STATEMENT 4F15693
TXL ES0730,C,0 NO 4F15694
ES0630 CLA L(TRA) YES 4F15695
STO CW+1 4F15696
STZ CW+2 4F15697
CAL 2E18 4F15698
ORA L(4) 4F15699
SLW CW+3 4F15700
TSX COMP,B COMPILE TRA 1,4 4F15701
TRA ES1590 EXIT TO FETCH STATE A 4F15702
ES1300 SUB L(X) 4F15703
TZE ES1360 4F15704
SLT 4 4F15705
TRA ES1380 4F15706
TRA ES0320 4F15707
ES1360 SLT 4 4F15708
TRA ES0870 4F15709
ES1380 SLT 2 4F15710
TRA ES0630 4F15711
CLA L(STQ) 4F15712
STO CW+1 4F15713
CLA X( 4F15714
STO CW+2 4F15715
STZ CW+3 4F15716
TSX COMP,B COMPILE STQ 700000 4F15717
CLA L(CLA) 4F15718
STO CW+1 4F15719
TSX COMP,B COMPILE CLA 700000 4F15720
TRA ES0630 4F15721
ES1500 TSX TET00,1 * GO TO PROGRAM TET TO ENTER 1C,1C+1 4F15722
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 142/142 ------
PZE 2 INTO TIFGO TABLE (TABLE 2), 4F15723
TRA ES1530 4F15724
ES1520 LXD EIFNO,4 4F15725
SXD CALLNM,4 PREPARE ENTRY FOR TABLE OF CALL FIRST AND 4F15726
TSX TET00,1 LAST IFN NUMBERS, 4F15727
REM 16 4F15728
ES1530 SLT 2 4F15729
TRA ES1590 EXIT TO FETCH STATE A 4F15730
TSX CIT00,C COMPILE LLS 37 4F15731
L(0) 4F15732
L(STQ) 4F15733
X( 4F15734
L(0) 4F15735
TSX CIT00,4 4F15736
L(0) 4F15737
L(CLA) 4F15738
X( 4F15739
L(0) 4F15740
ES1590 CLA FNSW 4F15741
TZE MTR000 4F15742
CLA F-1 4F15743
SUB 5BLANS 4F15744
TZE MTR000 4F15745
CLS EIFNO 4F15746
STO EIFNO 4F15747
TSX TET00,A 4F15748
HTR 0 4F15749
CLS EIFNO 4F15750
STO EIFNO 4F15751
TRA MTR000 4F15752
ES1710 LXD BBOX,B 4F15753
CLA OPNWRD 4F15754
STO CIB-3,B 4F15755
TRA MTR000 4F15756
REM 4F15757
COMP TSX CIT00,C 4F15758
HTR CW 4F15759
HTR CW+1 4F15760
HTR CW+2 4F15761
HTR CW+3 4F15762
TRA I,B 4F15763
REM 4F15764
AC0000 CLA SCRIPL,A 4F15765
STO TAGWRD 4F15766
CLA SCRIPL+1,A 4F15767
STO OPWORD 4F15768
CLA SCRIPL+2,A 4F15769
STO SYMWRD 4F15770
AC0060 CAL TAGWRD 4F15771
ANA MASK1 EXTRACT TAGS IN ACC. 4F15772
PBT 4F15773
TRA AC0540 4F15774
PXD 0,0 NON-SUBSCRIPTED SYMBOL 4F15775
LDQ SYMWRD 4F15776
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 143/143 ------
LGL 1 4F15777
LBT 4F15778
TQP AC0460 SYMBOL IS SOME S(K) 4F15779
LGL 11 NON-SUBSCRIPTED EX/INTERNAL VARIABLE 4F15760
SUB L(A() IS THIS A FLO PT CONSTANT 4F15781
TZE AC0410 YES 4F15782
ADD L(A() NO 4F15783
SUB L(I() IS THIS A FIX PT CONSTANT 4F15784
TZE AC0390 YES 4F15785
ADD L(I() NO 4F15786
SUB L(H() IS THIS A HOLLERITH FIELD 4F15787
TZE AC0350 YES 4F15788
LDQ OPWORD NON-SUBSCRIPTED EXTERNAL VARIABLE 4F15789
LGL 13 IS THIS A FREE VARIABLE 4F15790
TQP AC0340 NO 4F15791
LLS 15 YES 4F15792
COM 4F15793
SUB L(1) 4F15794
PAX 0,B 4F15795
PXD 0,8 4F15796
SLW CW+3 STORE ARGUMENT BUFFER RELATIVE ADDRESS 4F15797
LXD BK,B 4F15798
CAL FORSUB-1,B 4F15799
ANA MASK2 EXTRACT FUNCTION STATEMENT TYPE 4F15600
ORA P( 4F15801
AC0320 SLW CW+2 4F15802
TRA 1,C RETURN 4F15803
AC0340 STZ CW+3 NON-SUBSCRIPTED, REAL VARIABLE 4F15804
CAL SYMWRD 4F15805
TRA AC0320 4F15806
AC0350 CAL H( 4F15807
TRA AC0420 4F15808
AC0390 CLA I( FIX PT INTERNAL VARIABLE 4F15809
TRA AC0420 4F15810
AC0410 CLA A( FLO PT INTERNAL VARIABLE 4F15811
AC0420 STO CW+2 4F15812
RQL 6 4F15813
STQ CW+3 4F15814
TRA 1,C RETURN 4F15815
AC0460 LGL 35 SYMBOL IS SOME S(K) 4F15616
TDRADD PAX 0,B 4F15817
CAL CPBETA,6 4F15618
ANA MASK1 EXTRACT PHI(K) 4F15819
SLW CW+3 4F15820
CAL ARERAS 4F15621
TRA AC0320 4F15822
AC0540 SLW TAGWRD SUBSCRIPTED VARIABLE 4F15823
LDQ TAGWRD 4F15824
PXD ,0 CLEAR AC. 4F15825
LGL 12 I-TAU TAGS TO AC 4F15826
SLW CW+3 STORE FOR NEXT CIT ENTRY. 4F15827
TQP *+3 4F15828
STZ CW+3 4F15829
CAL 2E18 REPLACE NULL TAG, 4F15830
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 144/144 ------
SLW TAGPRT SAVE FOR LATER USE. 4F15831
LGL 1 4F15832
PXD ,0 CLEAR AC 4F15833
LGL 8 FORM TWICE SIGMA TAG. 4F15834
ALS 1 4F15835
ADM SIG1IX-2 FORM BASE OF TABLE + SIGMA TAG. 4F15836
STA SDRADD 4F15837
SDRADD PXD **,0 4F15838
RDR 2 4F15839
LDA SDRADD 4F15840
CAD DUMP 4F15841
COM 4F15842
CAD DUMP 4F15843
COM 4F15844
TZE *+2 CHECK SUM TEST, 4F15845
TSX DIAG,4 ERROR SIGMA1 CKSUM FAILS 4F15846
CAL DUMP 4F15847
ORS CW+3 ADD RELATIVE ADDRESS TO I-TAU TAG. 4F15848
CLA SYMWRD MOVE VARIABLE NAME FOR NEXT CIT ENTRY. 4F15849
STO CW+2 4F15850
TRA 1,4 RETURN TO CALLER 4F15851
REM 4F158511
CP6000 TSX FLTR00,4 COMPILE FLOW TRACE INFORMATION AND THEN 4F158512
CW COMPILE LXD 7(TYPE =*4 4F158513
CW+1 4F158514
CW+2 4F158515
CW+3 4F158516
TRA ES0000 4F158517
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F15852
ENDDDR BSS 0 4F158525
REM 4F15853
ENDD ORG 3184 4F15854
FNSW BSS 1 4F15855
P(CNTR BSS 1 4F15856
ARGORG BSS 1 4F15857
XRSAVE BSS 1 4F15858
CW BSS 4 4F15859
TAGWRD BSS 1 4F15860
OPWORD BSS 1 4F15861
SYMWRD BSS 1 4F15862
TAGPRT BSS 1 4F15863
CPBETA BSS 300 4F15864
SCRIPL BSS 600 4F15865
REM END OF ARITHMETIC / STATE D. 4F15866
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F15867
REM 4F15868
REM SYNONYMS USED BY SECTION ONE. 4F15869
1E SYN ERASE COMMON WORKING STORAGE. 4F15870
1TOCS SYN 4 ENTRY TO SYSTEM TAPE MONITOR. 4F15871
2E SYN ERASE+1 COMMON WORKING STORAGE. 4F15872
2P SYN 11 4F15873
36ONES SYN ALL1 4F15874
3E SYN ERASE+2 COMMON WORKING STORAGE. 4F15875
3QBAR SYN 3LBAR 4F15876
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 145/145 ------
4E SYN ERASE+3 COMMON WORKING STORAGE. 4F15877
A EQU 1 4F15878
ABLANK SYN BLANK 4F15879
ACOMMA SYN COMMA 4F15880
ADD SYN L(ADD) 4F15881
AEQUAL SYN EQUAL 4F15882
ALPAR SYN OPEN 4F15883
ARITH SYN STATEB 4F15884
ARPAR SYN CLOS 4F15885
ARS SYN L(ARS) 4F15886
B EQU 2 4F15887
C EQU 4 4F15888
CAL SYN L(CAL) 4F15889
CIT SYN CIT00 4F15890
CITMQR SYN E1C ERASABLE STORAGE. 4F15891
CITTAP SYN 147 COMPILED INSTRUCTION TAPE, 4F15892
CITXR1 SYN ERASE+1 ERASABLE STORAGE. 4F15893
CITXR2 SYN ERASE+2 ERASABLE STORAGE. 4F15894
CPY SYN L(CPY) 4F15895
D1 SYN 2E18 4F15896
D12 SYN ERASE+1 COMMON WORKING STORAGE. 4F15897
D18 SYN DEC18 4F15898
D3 SYN ERASE+2 COMMON WORKING STORAGE. 4F15899
DED SYN L(DED) 4F15900
DEL(A) SYN 0 DRUM ORIGIN FOR STATE A, 4F15901
DEL(B) SYN 1160 DRUM ORIGIN FOR STATE B. 4F15902
DEL(C) SYN 1275 DRUM ORIGIN FOR STATE C. 4F15903
DEL(D) SYN 722 DRUM ORIGIN FOR STATE D. 4F15904
DIM1 SYN 0200 DRUM TABLE ORIGIN -DRTABS,DIM.SR, 4F15905
DIM2 SYN 0500 DRUM TABLE ORIGIN -DRTABS,DIM,SR. 4F15906
DIM3 SYN 0800 DRUM TABLE ORIGIN -DRTABS,DIM,SR. 4F15907
DIMCTR SYN ERASE COMMON WORKING STORAGE. 4F15908
DMP SYN E( 4F15909
DOE SYN ERASE COMMON WORKING STORAGE. 4F15910
DRCKSM SYN ERASE+3 COMMON WORKING STORAGE. 4F15911
DRMADR SYN ERASE+4 ERASABLE STORAGE. 4F15912
DRMERC SYN L(5) NUMBER OF DRUM READING ATTEMPTS. 4F15913
DRSYM SYN ERASE COMMON WORKING STORAGE. 4F15914
E1TDR SYN ERASE COMMON WORKING STORAGE. 4F15915
E2C SYN ERASE+1 COMMON WORKING STORAGE. 4F15916
E2TDR SYN ERASE+1 COMMON WORKING STORAGE. 4F15917
E3C SYN ERASE+2 COMMON WORKING STORAGE. 4F15918
E3TDR SYN ERASE+2 COMMON WORKING STORAGE. 4F15919
EKE SYN ERASE+1 COMMON WORKING STORAGE. 4F15920
ENOND SYN ERASE+3 COMMON WORKING STORAGE. 4F15921
FEOD SYN ERASE+4 COMMON WORKING STORAGE. 4F15922
FIXCON SYN 0002 DRUM TABLE ORIGIN -DRTABS, 4F15923
FLOCON SYN 202 DRUM TABLE ORIGIN -DRTABS. 4F15924
FXCODR SYN 2 4F15925
H SYN ERASE+2 COMMON WORKING STORAGE. 4F15926
H( SYN ADSPOP 4F15927
HPR SYN L(HPR) 4F15928
LDA SYN L(LDA) 4F15929
LXD SYN L(LXD) 4F15930
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 146/146 ------
L(10) SYN TEN 4F15931
L(11) SYN EQUAL 4F15932
L(12) SYN MINUS 4F15933
L(1D) SYN 2E18 4F15934
L(63) SYN ENDMK 4F15935
MEMORG SYN 1824 MEMORY ORIGIN FOR ALL STATES. 4F15936
MSK SYN MASK2 4F15937
MTR000 SYN STATEA 4F15938
MTR300 SYN MTR3 4F15942
N SYN ERASE+3 COMMON WORKING STORAGE. 4F15943
PLUS SYN 122 4F15945
PXD SYN L(PXD) 4F15946
RAXR4 SYN ERASE COMMON WORKING STORAGE. 4F15947
SIGMA1 SYN 0662 DRUM TABLE ORIGIN -DRTABS. 4F15948
SR6WRK SYN ERASE+1 ERASABLE STORAGE. 4F15949
ST SYN L(8) 4F15950
STA SYN L(STA) 4F15951
STCKSM SYN ERASE+4 COMMON WORKING STORAGE, 4F15952
TABTAP SYN 148 TABLE TAPE. 4F15953
TAG4 SYN 2E17 4F15954
TAU1 SYN 0000 DRUM TABLE ORIGIN -DRTABS. 4F15955
TAU2 SYN 0300 DRUM TABLE ORIGIN -DRTABS. 4F15956
TAU3 SYN 3750 DRUM TABLE ORIGIN -DRTA8S. 4F15957
TERC SYN L(5) TAPE ERROR COUNTER. 4F15958
TETMQR SYN ERASE+3 ERASABLE STORAGE, 4F15959
TETWRK SYN ERASE+2 ERASABLE STORAGE. 4F15960
TETXR2 SYN ERASE ERASABLE STORAGE. 4F15961
TETXR4 SYN ERASE+1 ERASABLE STORAGE. 4F15962
TIX SYN L(TIX) 4F15963
ZER SYN 01 4F15964
.. EQU 0 4F15965
REM END OF SYNONYMS USED BY SECTION ONE. 4F15966
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *4F15967
REM 4F15968
REM END OF SECTION ONE. 4F15969
END 4F15970
REM 704 FORTRAN MASTER RECORD CARD / DIAGNOSTIC = F0200000. 4F1D0010
REM ----------FILE: 147.PNG-----------------------------INCLUDE PREV LINE
ORG 0 4F1D0020
PZE DIAG,,DIAG 4F1D0030
PZE 8191 4F1D0040
REM 704 FORTRAN TWO, SECTION ONE DIAGNOSTIC RECORD F020. 4F1D0050
REM 4F1D0060
REM THIS RECORD IS CALLED IN FROM TAPE ONCE FOR EACH ERROR IN 4F1D0070
REM SECTION ONE AND ONCE AT THE END OF SECTION ONE, 4F1D0080
REM 4F1D0090
DIAG ORG 1824+4096 MOD 4K OR 8K MACHINE SIZE 4F1D0100
A EQU 1 4F1D0110
B EQU 2 4F1D0120
C EQU 4 4F1D0130
EXITX EQU 32767 4F1D0140
EDIT TXH ERENT,C,0 IF IR4 IS ZERO THIS IS THE END OF SEC ONE. 4F1D0150
CLA 16 IF NON ZERO IT IS AN ERROR CALL, 4F1D0160
ANA L(4)D IF IT IS THE END OF SEC ONE WERE THERE ANY 4F1D0170
TZE 4 ERRORS DURING SECTION ONE ( INDICATED BY 4F1D0180
TSX PRINT,C 4F1D0190
HTR STOP,0,XCOM 4F1D0200
TSX PRINT,C BIT IN WORD 20 OCTAL), IF THERE WERE NO 4F1D0210
PZE RESTR,0,RESTR+1 ERRORS GO TO SEC ONE PRIME. IF THERE WERE 4F1D0220
LXA DCELL1,4 GET INDICATOR OF SOURCE PROGRAM ERRORS. 4F1D0230
TXH SOURCE,4,0 TEST IF ANY OF ERROR WERE SOURCE. 4F1D0240
LXA L(8),4 NONE WERE, SO BACKSPACE TAPE 1 TO MACHINE 4F1D0250
BST 1 ERROR RECORD. 4F1D0260
TIX *-1,4,1 4F1D0270
TRA 4 NOW GO TO 1 TO CS FOR MACHINE ERROR RECORD.4F1D0280
SOURCE LXA L(12),4 SOME SOURCE PROGRAM ERRORS, RECOMPILATION 4F1D0290
BST 1 MEANINGLESS. BACKSPACE TAPE 1 TO SOURCE 4F1D0300
TIX *-1,4,1 PROGRAM ERROR RECORD. 4F1D0310
TRA 4 NOW GO TO 1 TO CS FOR THIS RECORD. 4F1D0320
BSS 10 EXPANSION AREA. FOR PESSIMISM... 4F1D0330
REM NUMBERS OF MACHINE ERROR CALL FROM SECTION ONE, 4F1D0340
MACERR BCD 1002034 4F1D0350
BCD 1002062 4F1D0360
BCD 1002266 4F1D0370
BCD 1002433 4F1D0380
BCD 1002434 4F1D0390
BCD 1002435 4F1D0400
BCD 1002436 4F1D0410
BCD 1002523 4F1D0420
BCD 1002565 4F1D0430
BCD 1003272 4F1D0440
BCD 1003561 4F1D0450
BCD 1005715 4F1D0460
BCD 1004347 4F1D0470
BCD 1005233 4F1D0480
BCD 1000553 4F1D0490
BCD 1000560 4F1D0500
BCD 1000563 4F1D0510
BCD 1000566 4F1D0520
BCD 1010534
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 148/148 ------
BCD 1012750
BSS 18 MORE PESSIMISM...
COUNT 20 4F1D0540
REM 4F1D0550
REM THIS IS AN ERROR CALL. 4F1D0560
ERENT PXD 0,C 4F1D0570
COM CONSTRUCT OCTAL STOP 4F1D0580
ADD L(1)D 4F1D0590
PDX 0,B 4F1D0600
PXD 0,B 4F1D0610
LRS 35 4F1D0620
LXD L(6)D,B 4F1D0630
ALS ALS 3 4F1D0640
LGL 3 4F1D0650
TIX ALS,B,1 4F1D0660
STO NUMB 4F1D0670
LXA L(0),1 SET TO SEARCH TABLE OF NUMBERS OF MACHINE 4F1D0680
LXA COUNT,2 ERRORS, 4F1D0690
CAS MACERR,1 COMPARE EACH ENTRY IN TABLE TO OCTAL 4F1D0700
TXI *+3,1,1 NUMBER IN AC 4F1D0710
TRA *+4 EXIT IF FOUND. 4F1D0720
TXI *+1,1,1 4F1D0730
TIX *-4,2,1 CONTINUE. 4F1D0740
STA DCELL1 SET INDICATOR TO NON-ZERO FOR SOURCE ERROR 4F1D0750
LXA L(0),3 4F1D0760
CLA XXX CONSTRUCT CALLING SEQUENCE WORD FOR 4F1D0770
ONE CAS TABLE,A PRINTING COMMENT 4F1D0780
TRA TWO 4F1D0790
TRA FOUR 4F1D0800
TWO TXI THREE,A,-1 4F1D0810
THREE TXH ONE,A,0 4F1D0820
CLA NUMB 4F1D0830
STO XCOM 4F1D0840
CAL XKEY 4F1D0850
TRA EIGHT 4F1D0860
FOUR TXH FIVE,B,0 4F1D0870
SUB TABLE+1,A 4F1D0880
TZE SEVEN 4F1D0890
CLA NUMB 4F1D0900
SUB TABLE+1,A 4F1D0910
TZE NINE 4F1D0920
CLA XXX 4F1D0930
TRA TWO 4F1D0940
NINE TXI FIVE,A,-1 4F1D0950
FIVE PXD 0,A 4F1D0960
COM 4F1D0970
ADD L(1)D 4F1D0980
PDX 0,C 4F1D0990
PXD 0,C 4F1D1000
ADD TABAD 4F1D1010
TXH SIX,B,0 4F1D1020
ARS 18 4F1D1030
STO KEY 4F1D1040
CLA XXX 4F1D1050
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 149/149 ------
TXI THREE,B,1 4F1D1060
SIX ORA KEY 4F1D1070
TRA EIGHT 4F1D1080
SEVEN CLA NUMB 4F1D1090
STO XCOM 4F1D1100
CLA XKEY 4F1D1110
EIGHT STO COMM 4F1D1120
CLA F-1 4F1D1130
STO F-2 4F1D1140
CLA BLANK 4F1D1150
STO F-1 4F1D1160
LXD L(X)D,A CONSTRUCT CALLING SEQUENCE WORD 4F1D1170
CLA ONES 4F1D1180
STA05 CAS F+111,A 4F1D1190
TRA STA10 4F1D1200
TRA STA20 4F1D1210
STA10 TIX STA05,A,1 4F1D1220
LXD L(0),A 4F1D1230
STA20 PXD 0,A 4F1D1240
STO SES 4F1D1250
CLA L(X)D 4F1D1260
SUB SES 4F1D1270
ADD FORG 4F1D1280
STO SES 4F1D1290
CLA FORG 4F1D1300
ARS 18 4F1D1310
ORA SES 4F1D1320
STO STATE 4F1D1330
CLA 16 WAS THERE A PREVIOUS ERROR CALL 4F1D1340
ANA L(4)D 4F1D1350
TNZ PROG 4F1D1360
CLA L(4)D NO, MAKE ERROR CALL INDICATION 4F1D1370
ORS 16 4F1D1380
TSX PRINT,C AND PRINT HEADING 4F1D1390
HTR START,0,STOP 4F1D1400
WPR 4F1D1410
WPR 4F1D1420
WPR 4F1D1430
WPR 4F1D1440
PROG TSX SETNBC,4 4F1D1450
TSX NNBC,4 4F1D1460
TSX NNBC,4 4F1D1470
SUB L(10) 4F1D1480
TNZ EXIT 4F1D1490
TSX SETNBC,4 4F1D1500
TSX NNBC,4 4F1D1510
SUB L(X) 4F1D1520
TNZ CALLBK 4F1D1530
CLA L(I) 4F1D1540
TSX REP,4 4F1D1550
TSX NNBC,4 4F1D1560
CLA L(F) 4F1D1570
TSX REP,4 4F1D1580
TSX NNBC,4 4F1D1590
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 150/150 ------
SUB L(=) 4F1D1600
TNZ EXIT 4F1D1610
CLA L(LP) 4F1D1620
TSX REP,4 4F1D1630
TXE TXL EXIT,1,-110 4F1D1640
TSX NNBC,4 4F1D1650
SUB ENDM 4F1D1660
TNZ TXE 4F1D1670
CLA L(RP) 4F1D1680
TSX REP,4 4F1D1690
TRA EXIT 4F1D1700
CALLBK CLA L(C) CHANGE Z BACK TO C 4F1D1710
TSX REP,4 4F1D1720
TSX NNBC,4 4F1D1730
CLA L(A) CHANGE TEN BACK TO A 4F1D1740
TSX REP,4 4F1D1750
TSX NNBC,4 4F1D1760
CLA L(L) CHANGE EQUAL BACK TO FIRST L 4F1D1770
TSX REP,4 4F1D1780
TIX SECL,2,1 4F1D1790
TXI SECL,1,-1 ADJUST COUNTS FOR NEXT CHAR 4F1D1800
SECL CLA L(L) CHANGE BLANK BACK TO SECOND L 4F1D1810
TSX REP,4 4F1D1620
TRA EXIT 4F1D1830
SETNBC LXD TXI,1 4F1D1840
LXA LGL,2 4F1D1850
LDQ F 4F1D1860
TRA 1,4 4F1D1870
NNBC PXD 4F1D1880
LGL LGL 6 4F1D1890
TIX CAS,2,1 4F1D1900
LDQ F,1 4F1D1910
TXI TXI TXI+1,1,-1 4F1D1920
LXA LGL,2 4F1D1930
CAS CAS BLANKX 4F1D1940
TRA 1,4 4F1D1950
TRA NNBC 4F1D1960
TRA 1,4 4F1D1970
REP STQ ES1 4F1D1980
SXD ES2,2 4F1D1990
SXD ES3,1 4F1D2000
LRS 35 4F1D2010
CAL ENDM 4F1D2020
TXL TXL TXL+2,2,5 4F1D2030
TXI TXL+4,1,1 4F1D2040
LGL 6 4F1D2050
TIX TIX TIX-1,2,1 4F1D2060
COM 4F1D2070
ANS F-1,1 4F1D2080
LGL 36 4F1D2090
ORS F-1,1 4F1D2100
LXD ES3,1 4F1D2110
LXD ES2,2 4F1D2120
LDQ ES1 4F1D2130
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 151/151 ------
TRA 1,4 4F1D2140
L(I) BCD 100000I 4F1D2150
L(F) BCD 100000F 4F1D2160
L(=) BCD 100000= 4F1D2170
L(LP) BCD 100000( 4F1D2180
L(RP) BCD 100000) 4F1D2190
BLANKX BCD 100000 4F1D2200
L(X) BCD 100000X 4F1D2210
L(C) BCD 100000C 4F1D2220
L(A) BCD 100000A 4F1D2230
L(L) BCD 100000L 4F1D2240
L(8) 8 4F1D2250
L(10) OCT 12 4F1D2260
L(12) 12 4F1D2270
ENDM OCT 77 4F1D2280
ES1 HTR 4F1D2290
ES2 HTR 4F1D2300
ES3 HTR 4F1D2310
SECND TSX PRINT,C PRINT STATEMENT 4F1D2320
STATE HTR 4F1D2330
TSX PRINT,C PRINT COMMENT 4F1D2340
COMM HTR 4F1D2350
WPR 4F1D2360
WPR 4F1D2370
BST BST 1 TAPE 4F1D2380
TRA MON AND RETURN TO SEC ONE MONITOR 4F1D2390
L(1)D OCT 1000000 4F1D2400
L(4)D OCT 4000000 4F1D2410
L(6)D OCT 6000000 4F1D2420
L(0) HTR 4F1D2430
ONES OCT 777777777777 4F1D2440
XXX BCD 1XXXXXX 4F1D2450
HALT OCT 77777 4F1D2460
L(X)D OCT 161000000 4F1D2470
TABAD HTR 0,0,TABLE 4F1D2480
FORG HTR 0,0,F-2 4F1D2490
RESTR BCD 11 4F1D2500
BLANK BCD 1 4F1D2510
XKEY HTR XCOM,0,XXCOM 4F1D2520
NUMB HTR 4F1D2530
KEY HTR 4F1D2540
SES HTR 4F1D2550
START BCD 71 4F1D2560
BCD 6FORTRAN DIAGNOSTIC PROGRAM RESULTS 4F1D2570
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 152/152 ------
STOP BCD 70 4F1D2580
BCD 6END OF DIAGNOSTIC PROGRAM RESULTS 4F1D2590
XCOM HTR 4F1D2600
BCD THIS ERROR IS NOT LISTED IN THE DIAGNOSTIC PROGRAM ERR 4F1D2610
BCD 2OR LIST. 4F1D2620
XXCOM BSS 0 4F1D2630
PRINT BSS 0 4F1D2640
RAN CLA 1,4 4F1D2650
STA RNA 4F1D2660
ARS 18 4F1D2670
STO RNB 4F1D2680
SXD RNC,4 4F1D2690
RN40 CLA RNA 4F1D2700
ADD RND 4F1D2710
CAS RNB 4F1D2720
NOP 4F1D2730
TRA RN50 4F1D2740
ALS 18 4F1D2750
ADD RNA 4F1D2760
STO RAN10 4F1D2770
TSX WOT,C 4F1D2780
RAN10 HTR 4F1D2790
CLA RAN10 4F1D2800
ARS 18 4F1D2610
SUB RNE 4F1D2820
STA RN20 4F1D2830
SUB RNE 4F1D2840
STA RN30 4F1D2850
STA RNA 4F1D2860
CLA BLNKS 4F1D2870
RN20 STO 4F1D2880
RN30 STO 4F1D2890
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 153/153 ------
TRA RN40 4F1D2900
RN50 CLA RNB 4F1D2910
ALS 18 4F1D2920
ADD RNA 4F1D2930
STO RN60 4F1D2940
TSX WOT,C 4F1D2950
RN60 HTR 4F1D2960
LXD RNC,C 4F1D2970
TRA 2,C 4F1D2980
RNA HTR 4F1D2990
RNB HTR 4F1D3000
RNC HTR 4F1D3010
RND HTR 20 4F1D3020
RNE HTR 1 4F1D3030
WOT SXD X1,1 4F1D3040
SXD X2,2 4F1D3050
CLA 1,4 PRINT ROUTINE 4F1D3060
STA T5 X 4F1D3070
STD X4 X 4F1D3080
ARS 18 X 4F1D3090
ADD X4 X 4F1D3100
STA PR2 X 4F1D3110
STA CI9 X 4F1D3120
SUB 1,4 B-A+1 IN AC 4F1D3130
TZE 2,4 4F1D3140
TMI 2,4 4F1D3150
SXD X4,4 4F1D3160
L11 PAX 11,4 4F1D3170
SXD PR6,4 4F1D3180
CAL WP INITIALIZE SWITCH 4F1D3190
STO WP X 4F1D3200
PR6 TXH T4 4F1D3210
T4 WPR 4F1D3220
Z2 TXL S3 4F1D3230
OZ2 TXL 4F1D3240
SP4 SPR 4 4F1D3250
TXL RPR+2 4F1D3260
S3 CLS WP SET SWITCH FOR MASKING 4F1D3270
STO WP CHARACTER FROM TYPE WHEEL 1 4F1D3280
T5 CAL * OBTAIN FIRST CHARACTER 4F1D3290
ARS 30 X 4F1D3300
TZE SP4 DOUBLE SPACE IF ZERO 4F1D3310
CAS YZONE TEST FOR SPACE SUPPRESS 4F1D3320
TXL BK NO 4F1D3330
TXL RPR+1 SUPPRESS SPACE 4F1D3340
BK CAS BNK TEST FOR BLANK 4F1D3350
TXL DIGF NO 4F1D3360
TXL RPR+2 BLANK 4F1D3370
DIGF SPR 10 SET CHANNEL SKIP 4F1D3380
ANA MK MASK OUT ZONE 4F1D3390
MK PAX 15,1 OBTAIN SPR COMBINATION 4F1D3400
TXI N2,1,1 X 4F1D3410
N2 TNX N3,1,8 X 4F1D3420
SPR 8 X 4F1D3430
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 154/154 ------
N3 TNX N4,1,4 X 4F1D3440
SPR 4 X 4F1D3450
N4 TNX N5,1,2 X 4F1D3460
SPR 2 X 4F1D3470
N5 TNX RPR,1,1 X 4F1D3480
SPR 1 X 4F1D3490
RPR WPR 4F1D3500
SPR 5 SUPPRESS SPACE 4F1D3510
CLA BLNKS FIND LAST NON-BLANK GROUP 4F1D3520
LXD CI4,4 X 4F1D3530
PR2 CAS 0,4 X 4F1D3540
TXI PR1,4,-1 X 4F1D3550
TXI PR2,4,1 X 4F1D3560
TXI PR1,4,-1 X 4F1D3570
PR1 SXD CI6,4 STORE END TEST 4F1D3560
SXD CI8,4 X 4F1D3590
SXD PR8,4 X 4F1D3600
SXD WP4,4 X 4F1D3610
LXD PR6,4 X 4F1D3620
PR8 TNX PR5,4 4F1D3630
TXL PR3,4,12 4F1D3640
SPR 8 FIRST CYCLE 4F1D3650
PR3 LXD PR6,4 INITIALIZE GROUP COUNT 4F1D3660
PR5 LXA PR7,2 INITIALIZE LEFT SETUP 4F1D3670
LXD YZ1,1 CLEAR CARD IMAGE 4F1D3680
PR7 PXD X 4F1D3690
PR4 SLW LT,1 X 4F1D3700
SLW RT,1 X 4F1D3710
TIX PR4,1,1 X 4F1D3720
CIR CAL COL1 INITIALIZE COLUMN INDICATOR 4F1D3730
CI2 SLW COL X 4F1D3740
CI9 LDQ 0,4 OBTAIN GROUP 4F1D3750
SXD OZ2,4 STORE GROUP COUNT 4F1D3760
LXA Q6,4 SET CHARACTER COUNT 4F1D3770
CI1 PXD 4F1D3780
Q6 LGL 6 4F1D3790
PAX 0,1 4F1D3800
CAL COL POSITION COLUMN INDICATOR 4F1D3810
ARS 6,4 X 4F1D3820
TIX YZ1,1,16 TEST FOR DIGIT 4F1D3830
TXH YZ2,1,15 TEST FOR Y-ZONE 4F1D3840
CI5 ORS D,3 STORE DIGIT 4F1D3850
CI4 TIX CI1,4,1 COUNT CHARACTERS 4F1D3860
CI3 ARS 1 SHIFT AND TEST COLUMN 4F1D3870
LXD OZ2,4 RESTORE GROUP COUNT 4F1D3880
TXI CI6,4,-1 COUNT GROUPS 4F1D3890
CI6 TXL CI7,4 TEST FOR LAST NON-BLANK GROUP 4F1D3900
TNZ CI2 TEST FOR END OF ROW 4F1D3910
CI7 CAL 8.3,2 FORM TRUE 8,4 4F1D3920
ORS D-8,2 AND 3 ROWS AND 4F1D3930
ORS D-3,2 MOVE 8,4 AND 8.3 4F1D3940
SLW 8.2,2 ROWS 4F1D3950
CAL 8.4,2 FORM TRUE 8,4 4F1D3960
ORS D-8,2 X 4F1D3970
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 155/155 ------
ORS D-4,2 X 4F1D3980
SLW 8.3,2 X 4F1D3990
CI8 TXL WP,4 TEST FOR END 4F1D4000
TXH WP,2,15 TEST FOR RIGHT HALF 4F1D4010
TXI CIR,2,16 INITIALIZE RIGHT HALF 4F1D4020
YZ1 TIX XZ1,1,16 TEST FOR 16/CH/32 4F1D4030
TXH XZ2,1,15 TEST FOR X-ZONE 4F1D4040
ORS D,3 STORE DIGIT 4F1D4050
YZ2 ORS Y,2 STORE Y-ZONE 4F1D4060
TIX CI1,4,1 COUNT CHARACTERS 4F1D4070
X1 TXL CI3 OBTAIN NEXT GROUP 4F1D4080
XZ1 TIX OZ1,1,16 TEST FOR 32/CH/48 4F1D4090
TXH CI4,1,15 TEST FOR BLANK 4F1D4100
ORS D,3 STORE DIGIT 4F1D4110
XZ2 ORS X,2 STORE X-ZONE 4F1D4120
TIX CI1,4,1 COUNT CHARACTERS 4F1D4130
X2 TXL CI3 OBTAIN NEXT GROUP 4F1D4140
OZ1 ORS Z,2 STORE 0-ZONE 4F1D4150
ORS D,3 STORE DIGIT 4F1D4160
TIX CI1,4,1 COUNT CHARACTERS 4F1D4170
TXL CI3 4F1D4180
WP TXH WP9 INVERTED TO TXL IF PROGRAM CARRIAGE CONTROL 4F1D4190
TXL WP7 NO PROGRAM 4F1D4200
WP9 LXD WP2,1 MASK OUT FIRST COL, OF CARD IMAGE 4F1D4210
CAL MK2 X 4F1D4220
ANS ANS LT,1 X 4F1D4230
TIX ANS,1,1 X 4F1D4240
WP7 LXD Z2,1 COPY LOOP 4F1D4250
CRAN CPY LT-12,1 4F1D4260
CPY RT-12,1 X 4F1D4270
TXI T2,1,-1 4F1D4280
T2 TXH CRAN,1,-12 4F1D4290
CAL WP RESET SWITCH FOR SECOND CYCLE 4F1D4300
STO WP X 4F1D4310
WP4 TXH WP5,4 4F1D4320
LXD X1,1 NO, RELOAD INDEX REGISTERS AND RETURN 4F1D4330
LXD X2,2 X 4F1D4340
WT2 LXD X4,4 X 4F1D4350
L2 TRA 2,4 X 4F1D4360
RPR2 WPR 4F1D4370
TXL PR2-2 4F1D4380
WP5 WPR 4F1D4390
SPR 9 SECOND CYCLE 4F1D4400
WP2 TXL PR5,0,12 CONVERT REST OF LINE 4F1D4410
BLNKS BCD 1 4F1D4420
X4 HTR 4F1D4430
YZONE OCT 20 4F1D4440
BNK OCT 60 4F1D4450
MK2 OCT 377777777777 4F1D4460
COL1 MZE 4F1D4470
COL BSS 1 4F1D4460
RT BES 16 4F1D4490
8.5 BSS 1 4F1D4500
8.4 BSS 1 4F1D4510
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 156/156 ------
8.3 BSS 1 4F1D4520
8.2 BSS 1 4F1D4530
D BES 9 4F1D4540
Z BSS 1 4F1D4550
X BSS 1 4F1D4560
Y BSS 1 4F1D4570
LT SYN Y+1 4F1D4580
8.4L SYN LT-14 4F1D4590
8.4R SYN RT-14 4F1D4600
BSS 27 4F1D4610
EXIT SYN SECND 4F1D4620
REM ADDRESS REQUIRED FROM SECTION ONE.......... 4F1D4630
F SYN 618 ADDRESS OF 1ST WORD OF F REGION 4F1D4640
MON SYN 1282 ADDRESS OF ENTRY TO MONITOR FOR A 4F1D4650
DCELL1 SYN 1271 4F1D4660
REM 4F1D4670
REM 4F1D4680
REM TABLE OF DIAGNOSTIC COMMENTS, SECTION ONE OF 704 FORTRAN II. 4F1D4690
REM 4F1D4700
REM 4F1D4710
REM COMMON 4F1D4720
REM 4F1D4730
TABLE BSS 0 4F1D4740
BCD XXXXXX000001 DIM3 TABLE EXCEEDED, THE NUMBER OF 3-DIMEN4F1D4750
BCD SIONAL VARIABLES WHICH APPEAR IN DIMENSION STATEMENTS EXCEED4F1D4760
BCD 1S 9O. 4F1D4770
REM 4F1D4780
BCD XXXXXX000002 DIM2 TABLE EXCEEDED, THE NUMBER OF 2-DIMEN4F1D4790
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 157/157 ------
BCD SIONAL VARIABLES WHICH APPEAR IN DIMENSION STATEMENTS EXCEED4F1D4800
BCD 1S 100. 4F1D4810
REM 4F1D4820
BCD XXXXXX000003 DIM1 TABLE EXCEEDED. THE NUMBER OF 1-DIMEN4F1D4830
BCD SIONAL VARIABLES WHICH APPEAR IN DIMENSION STATEMENTS EXCEED4F1D4840
BCD 1S 100, 4F1D4850
REM 4F1D4860
BCD XXXXXX000004 SIGMA TABLE EXCEEDED. MORE THAN 30 DIFFERE4F1D4870
BCD NT RELATIVE ADDRESSES RESULTING FROM THE ADDENDS IN SUBSCRIP4F1D4880
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 158/158 ------
BCD TS OF THIS STATEMENT. (SIGN CONSIDERED, ONE RELATIVE ADDRESS4F1D4890
BCD 3OF 0 ASSUMMED) 4F1D4900
REM 4F1D4910
BCD XXXXXX000005 TAU3 TABLE EXCEEDED. THE TOTALITY OF DIFFE4F1D4920
BCD RENT 3-DIMENSIONAL SUBSCRIPT COMBINATIONS EXCEEDS 75 FOR THI4F1D4930
BCD 2S PROGRAM. 4F1D4940
REM 4F1D4950
BCD XXXXXX000006 TAU2 TABLE EXCEEDED. THE TOTALITY OF DIFFE4F1D4960
BCD RENT 2-DIMENSIONAL SUBSCRIPT COMBINATIONS EXCEEDS 90 FOR THI4F1D4970
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 159/159 ------
BCD 2S PROGRAM. 4F1D4980
REM 4F1D4990
BCD XXXXXX000O07 TAU1 TABLE EXCEEDED. THE TOTALITY OF DIFFE4F1D5000
BCD RENT 1-DIMENSI0NAL SUBSCRIPT COMBINATIONS EXCEEDS 100 FOR TH4F1D5010
BCD 2IS PROGRAM. 4F1D5020
REM 4F1D5030
BCD XXXXXX000010 FLOCON TABLE EXCEEDED. MORE THAT 450 DIFFE4F1D5040
BCD RENT FLOATING POINT CONSTANTS IN THIS PROBLEM. (SIGN NOT CONS4F1D5050
BCD 2IDERED) 4F1D5060
REM 4F1D5070
BCD XXXXXX000011 FIXCON TABLE EXCEEDED. MORE THAN 100 DIFFE4F1D5080
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 160/160 ------
BCD RENT FIXED POINT CONSTANTS IN THIS PROGRAM. (SIGN NOT CONSID4F1D5090
BCD 1ERED) 4F1D5100
REM 4F1D5110
BCD XXXXXX001635 MORE THAN SIX CHARACTERS IN SOME SYMBOL.4F1D5120
REM 4F1D5130
BCD XXXXXX001643 ILLEGAL PUNCTUATION IN THIS STATEMENT.4F1D5140
REM 4F1D5150
BCD XXXXXX002034 MACHINE ERROR. CAS CONTRADICTS PREVIOUS TL4F1D5160
BCD 1Q. 4F1D5170
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 161/161 ------
REM 4F1D5180
BCD XXXXXX002062 REPEATED CHECK SUM ERROR IN READING DRUM 34F1D5190
BCD 1. 4F1D5200
REM 4F1D5210
BCD XXXXXX002266 MACHINE ERROR. INDEX FAILURE. 4F1D5220
REM 4F1D5230
BCD XXXXXX002433 REPEATED FAILURE IN READING STATE C FROM D4F1D5240
BCD 2RUM 4. 4F1D5250
REM 4F1D5260
BCD XXXXXX002434 REPEATED FAILURE IN READING STATE B FROM D4F1D5270
BCD 2RUM 3. 4F1D5280
REM 4F1D5290
BCD XXXXXX002435 REPEATED FAILURE IN READING STATE D FROM D4F1D5300
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 162/162 ------
BCD 2RUM 2. 4F1D5310
REM 4F1D5320
BCD XXXXXX002436 REPEATED FAILURE IN READING STATE A FROM D4F1D5330
BCD 2RUM 1. 4F1D5340
REM 4F1D5350
BCD XXXXXX002523 MACHINE ERROR. INDEX FAILURE. 4F1D5360
REM 4F1D5370
BCD XXXXXX002565 REPEATED CHECK SUM ERROR IN READING TABLES4F1D5380
BCD 4FROM DRUM 2, 3 OR 4, 4F1D5390
REM 4F1D5400
BCD XXXXXX002577 NON-NUMERIC CHARACTER IN NUMERIC FIELD OR 4F1D5410
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 163/163 ------
BCD 8POSSIBLE MISSING PUNCTUATION BETWEEN FIELDS. 4F1D5420
REM 4F1D5430
BCD XXXXXX002656 A SUBSCRIPT IS NOT A FIXED POINT VARIABLE.4F1D5440
REM 4F1D5450
BCD XXXXXX002666 A SUBSCRIPT HAS A DOUBLE MULTIPLIER. 4F1D5460
REM 4F1D5470
BCD XXXXXX002673 A SUBSCRIPT MULTIPLIER IS NOT A CONSTANT. 4F1D5480
REM 4F1D5490
BCD XXXXXX002720 MORE THAN SIX CHARACTERS IN A SYMBOL WITHI4F1D5500
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 164/164 ------
BCD 8N A SUBSCRIPT OR POSSIBLE MISSING PUNCTUATION. 4F1D5510
REM 4F1D5520
BCD XXXXX002722 THERE IS AN ILLEGAL CHARACTER IN SOME SUBS4F1D5530
BCD 2SCRIPT. 4F1D5540
REM 4F1D5550
BCD XXXXXX002741 A SUBSCRIPT HAS A DOUBLE ADDEND. 4F1D5560
REM 4F1D5570
BCD XXXXXX002744 A SUBSCRIPT IS NOT A FIXED POINT VARIABLE.4F1D5580
REM 4F1D5590
BCD XXXXXX002764 A SUBSCRIPT IS NOT A FIXED POINT VARIABLE.4F1D5600
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 165/165 ------
REM 4F1D5610
BCD XXXXXX003023 A SUBSCRIPT ADDEND IS NOT A CONSTANT. 4F1D5620
REM 4F1D5630
BCD XXXXXX003026 THERE IS A PARENTHESIS MISSING IN SOME SUB4F1D5640
BCD 4SCRIPT COMBINATION. 4F1D5650
REM 4F1D5660
BCD XXXXXX003064 A 3 DIMENSIONAL SUBSCRIPTED VARIABLE DOES 4F1D5670
BCD 7NOT HAVE A DIMENSION STATEMENT ENTRY. 4F1D5680
REM 4F1D5690
BCD XXXXXX003151 A 2 DIMENSIONAL SUBSCRIPTED VARIABLE DOES 4F1D5700
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 166/166 ------
BCD 7NOT HAVE A DIMENSION STATEMENT ENTRY. 4F1D5710
REM 4F1D5720
BCD XXXXXX003254 PROGRAM EXPECTS COMMA OR END OF STATEMENT.4F1D5730
REM 4F1D5740
BCD XXXXXX003262 PROGRAM EXPECTS COMMA OR RIGHT PARENTHESIS4F1D5750
BCD 1. 4F1D5760
REM 4F1D5770
BCD XXXXXX003270 PROGRAM EXPECTS LEFT PARENTHESIS OR END OF4F1D5780
BCD 2 STATEMENT. 4F1D5790
REM 4F1D5800
BCD XXXXXX003272 MACHINE ERROR. AC GREATER THAN OCTAL 77. 4F1D5810
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 167/167 ------
REM 4F1D5820
BCD 9XXXXXX003274 PROGRAM EXPECTS END OF STATEMENTS 4F1D5830
REM 4F1D5840
BCD 9XXXXXX003300 PROGRAM EXPECTS LEFT PARENTHESIS. 4F1D5850
REM 4F1D5860
BCD 9XXXXXX003304 PROGRAM EXPECTS RIGHT PARENTHESIS. 4F1D5870
REM 4F1D5880
BCD 7XXXXXX003310 PROGRAM EXPECTS COMMA. 4F1D5690
REM 4F1D5900
BCD XXXXXX003314 SYMBOL BEGINS NUMERIC WHICH IS ILLEGAL IN 4F1D5910
BCD 3THIS CONTEXT. 4F1D5920
BCD XXXXXX003316 SYMBOL BEGINS NON-NUMERIC WHICH IS ILLEGAL4F1D5940
BCD 3 IN THIS CONTEXT. 4F1D5950
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 168/168 ------
REM 4F1D5960
REM STATE A 4F1D5970
REM 4F1D5980
BCD XXXXXX003542 THE CHARACTER $ OCCURS IN THIS STATEMENT 4F1D5990
BCD 8 SOMEWHERE OTHER THAN IN HOLLERITH TEXT. 4F1D6000
REM 4F1D6010
BCD XXXXXX003545 THE ILLEGAL CHARACTER (0-8-2 PUNCH) OCC4F1D6020
BCD 4URS INTHIS STATEMENT. 4F1D6030
REM 4F1D6040
BCD XXXXXX003550 THE ILLEGAL CHARACTER -0 (11-8-2 PUNCH) O 4F1D6050
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 169/169 ------
BCD 4CCURS IN THIS STATEMENTS. 4F1D6060
REM 4F1D6070
BCD XXXXXX003553 THE ILLEGAL CHARACTER +0 112-6-2 PUNCH) 0 4F1D6080
BCD 4CCURS IN THIS STATEMENT. 4F1D6090
REM 4F1D6100
BCD XXXXXX003556 THE ILLEGAL CHARACTER - (8-4 PUNCH) OCCUR 4F1D6110
BCD 4S IN THIS STATEMENT. 4F1D6120
REM 4F1D6130
BCD XXXXXX003561 THE NON BCD CHARACTER 001010 HAS BEEN RE 4F1D6140
BCD 8AD FROM TAPE WHILE PROCESSING THIS STATEMENT. 4F1D6150
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 170/170 ------
REM 4F1D6160
BCD 8XXXXXX003615 TOO MANY RIGHT PARENTHESIS. 4F1D6170
REM 4F1D6180
BCD XXXXXX003624 NON-ARITHMETIC STATEMENT OF A TYPE WHICH I4F1D6190
BCD 4S NOT IN DICTIONARY. 4F1D6200
REM 4F1D6210
BCD XXXXXX004055 TOO FEW RIGHT PARENTHESES. 4F1D6220
REM 4F104230
BCD 7XXXXXX004225 PROGRAM EXPECTS TO . 4F1D6240
REM 4F106250
BCD XXXXXX004304 A VARIABLE IN THIS LIST APPEARED PREVIOUSL4F1D6260
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 171/171 ------
BCD 5Y IN ADIMENSION STATEMENT. 4F1D6270
REM 4F1D6280
BCD XXXXXX004323 MORE THAN 3 DIMENSIONS OR MISSING RIGHT PA4F1D6290
BCD 2RENTHESIS. 4F1D6300
REM 4F1D6310
BCD XXXXXX004444 A SUBROUTINE OR FUNCTION STATEMENT APPEARS4F1D6320
BCD LATER THAN THE FIRST STATEMENT OF THE PROGRAM. PROBABLY ATTE4F1D6330
BCD MPT TOBATCH COMPILE WITHOUT SENSE SWITCH 6 DOWN. 4F1D6340
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 172/172 ------
REM 4F1D6350
BCD XXXXXX004544 A RETURN STATEMENT HAS OCCURRED IN A PROGR4F1D6360
BCD AM NOTDEFINED TO BE A SUBROUTINE OR FUNCTION SUBPROGRAM. 4F1D6370
REM 4F1D6380
BCD XXXXXX004663 SENSE SWITCH SETTING OTHER THAN 0,1 OR 2 4F1D6390
BCD 7OR MORE THAN 5 SETTINGS OR WRONG FORMAT. 4F1D6400
REM 4F1D6410
BCD 8XXXXXX004705 VARIABLE FORMAT NUMBER. 4F1D6420
REM 4F1D6430
BCD 6XXXXXX004707 NO FORMAT NUMBER. 4F1D6440
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 173/173 ------
REM 4F1D6450
BCD XXXXXX005170 MORE THAN SIX CHARACTERS IN SOME SYMBOL. 4F1D6460
REM 4F1D6470
BCD XXXXXX005200 ILLEGAL CHARACTER IN THIS LIST. 4F1D6480
REM 4F1D6490
BCD XXXXXX005260 MORE THAN THREE LEVELS IN THIS LIST (NESTE4F1D6500
BCD 30 PARENTHESIS). 4F1D6510
REM 4F1D6520
BCD XXXXXX005263 ATTEMPT TO SPECIFY SUBSCRIPT RANGE WITHO 4F1D6530
BCD 4UT USEOF PARENTHESIS. 4F1D6540
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 174/174 ------
REM 4F1D6550
BCD XXXXXX005305 INCOMPLETE STATEMENT OR INCOMPLETE CLOSURE4F1D6560
BCD 3OF PARENTHESIS. 4F1D6570
REM 4F1D6580
BCD XXXXXX005306 ILLEGAL CHARACTER IN D0 SPECIFICATION IN L4F1D6590
BCD 1IST, 4F1D6600
REM 4F1D6610
BCD 8XXXXXX005401 TOO MANY RIGHT PARENTHESIS. 4F1D6620
REM 4F1D6630
BCD 6XXXXXX005416 CONSTANT IN LIST. 4F1D6640
REM 4F1D6650
BCD 8XXXXXX005552 TOO MANY LEFT PARENTHESIS. 4F1D6660
REM 4F1D6670
BCD XXXXXX005607 ILLEGAL CHARACTER IN THIS STATEMENT. 4F1D6680
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 175/175 ------
REM 4F1D6690
BCD XXXXXX005715 A TAPE CHECK HAS OCCURRED THREE TIMES IN A4F1D6700
BCD TTEMPTING TO READ A RECORD OF THE SOURCE PROGRAM FROM TAPE 24F1D6710
BCD . ATTEMPT TO READ ABANDONED. THE STATEMENT INVOLVED IS NOT P4F1D6720
BCD ROCESSED. IF THE RECORD WAS NOT THE LAST RECORD OF A STATEME4F1D6730
BCD NT THEFOLLOWING DIAGNOSTIC COMMENT IS MEANINGLESS AND WAS C 4F1D6740
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 176/176 ------
BCD AUSED BY AN ATTEMPT TO PROCESS A PARTIAL STATEMENT. 4F1D6750
REM 4F1D6760
BCD XXXXXX006042 ILLEGAL USE OF FLOATING POINT VARIABLE. 4F1D6770
REM 4F1D6780
REM STATE B 4F1D6790
REM 4F1D6800
BCD 8XXXXXX003527 TOO MANY CHARACTERS IN SYMBOL, 4F1D6810
REM 4F1D6820
BCD 8XXXXXX003602 ILLEGAL USE OF . CHARACTER. 4F1D6830
REM 4F1D6840
BCD 7XXXXXX003613 ARGREG SIZE EXCEEDED. 4F1D6850
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 177/177 ------
REM 4F1D6860
BCD XXXXXX003615 ILLEGAL USE OF HOLLERITH SPECIFICATION. 4F1D6870
REM 4F1D6880
BCD 8XXXXXX003654 NON-ZERO LEVEL REDUCTION. 4F1D6890
REM 4F1D6900
BCD 8XXXXXX003671 ILLEGAL USE OF = SIGN. 4F1D6910
REM 4F1D6920
BCD 8XXXXXX003724 ILLEGAL USE OF . SIGN, 4F1D6930
REM 4F1D6940
BCD XXXXXX004046 THE NUMERIC CONTROL OF A HOLLERITH TEXT IS4F1D6950
BCD 9LARGER THAN THE NUMBER OF CHARACTERS FOLLOWING THE H. 4F1D6960
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 178/178 ------
REM 4F1D6970
BCD 8XXXXXX004136 LAMBDA TABLE SIZE EXCEEDED, 4F1D6980
REM 4F1D6990
BCD 6XXXXXX004140 BETA TABLE SIZE EXCEEDED. 4F1D7000
REM 4F1D7010
BCD 8XXXXXXG04143 ALPHA TABLE SIZE EXCEEDED, 4F1D7020
REM 4F1D7030
BCD XXXXXX0C4647 FLOATING POINT CONSTANT OUTSIDE RANGE OF M4F1D7040
BCD 2ACHINE. 4F1D7050
REM 4F1D7060
REM STATE C 4F1D7070
REM 4F1D7080
BCD XXXXXX004347 CHECK SUM ERROR IN READING FIXED POINT CON4F1D7090
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 179/179 ------
BCD 3STANT FROM DRUM 2. 4F1D7100
REM 4F1D7110
REM STATE D 4F1D7120
REM 4F1D7130
BCD 6XXXXXX003501 MIXED EXPRESSION. 4F1D7140
REM 4F1D7150
BCD 6XXXXXX003503 MIXED EXPRESSION 4F1D7160
REM 4F1D7170
BCD XXXXXXOO5233 CHECK SUM ERROR IN READING SIGMA TABLE ENT
BCD 3RY FROM DRUM 2.
REM
REM LOCATIONS OF STAE B,C,D CALLS IN 8K SECTION ONE.
REM
BCD 8XXXXXX006412 TOO MANY CHARACTERS IN SYMBOL.
REM
BCD 8XXXXXXOO6465 ILLEGAL USE OF . CHARACTER,
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 180/180 ------
REM
BCD 7XXXXXX006476 ARGREG SIZE EXCEEDED.
REM
BCD XXXXXX006500 ILLEGAL USE OF HOLLERITH SPECIFICATION.
REM
BCD 8XXXXXX006537 NON-ZERO LEVEL REDUCTION.
REM
BCD 8XXXXXX006554 ILLEGAL USE OF = SIGN.
REM
BCD 8XXXXXX006554 ILLEGAL USE OF . SIGN,
REM
BCD XXXXXX006731 THE NUMERIC CONTROL OF A HOLLERITH TEXT IS
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 181/181 ------
REM
BCD 9LARGER THAN THE NUMBER OF CHARACTERS FOLLOWING THE H.
REM
BCD 8XXXXXX007021 LAMBDA TABLE SIZE EXCEEDED.
REM
BCD 6XXXXXX007023 BETA TABLE SIZE EXCEEDED.
REM
BCD 8XXXXXX007026 ALPHA TABLE SIZE EXCEEDED.
REM
BCD XXXXXX007532 FLOATING POINT CONSTANT OUTSIDE RANGE OF M
REM
BCD 2ACHINE.
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 182/182 ------
REM
BCD XXXXXX010534 CHECK SUM ERROR TN READING FIXED POINT CON
BCD 3STANT FROM DRUM 2.
REM
BCD 6XXXXXX011216 MIXED EXPRESSION.
REM
BCD 6XXXXXX011220 MIXED EXPRESSION
REM
BCD XXXXXX012750 CHECK SUM ERROR IN READING SIGMA TABLE ENT
BCD 3RY FROM DRUM 2.
REM
REM 4F1D7200
REM 4F1D7210
REM 1NITALIZATION RECORD F015. 4F1D7220
REM 4F1D7230
BCD XXXXXX000553 FIVE CONSECUTIVE FAILURES IN ATTEMPTING T04F1D7240
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 183/183 ------
BCD 7 WRITESTATE A OF SECTION ONE ON DRUM 1. 4F1D7250
REM 4F1D7260
BCD XXXXXX000560 FIVE CONSECUTIVE FAILURES IN ATTEMPTING TO4F1D7270
BCD 7 WRITESTATE D OF SECTION ONE ON DRUM 2. 4F1D7280
REM 4F1D7290
BCD XXXXXX000563 FIVE CONSECUTIVE FAILURES IN ATTEMPTING TO4F1D7300
BCD 7 WRITESTATE B OF SECTION ONE ON DRUM 3, 4F1D7310
REM 4F1D7320
BCD XXXXXX000566 FIVE CONSECUTIVE FAILURES IN ATTEMPTING TO4F1D7330
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 184/184 ------
BCD 7 WRITESTATE C OF SECTION ONE ON DRUM 4, 4F1D7340
REM 4F1D7350
BCD 2XXXXXXXXXXXX 4F1D7360
END 4F1D7370
REM 704 FORTRAN MASTER RECORD CARD / 1 PRIME PART A = F0220000, F1P00010
REM ----------FILE: 185.PNG-----------------------------BEFORE LINE ABOVE
ORG 0 F1P00020
PZE ORG1PA,,ORG1PA F1P00030
PZE END1PA-1 F1P00040
REM F1P00050
REM THIS IS PART A OF 2 PARTS OF SECTION ONE PRIME F1P00060
REM F1P00070
ORG1PA ORG 614 F1P00080
NOP TO PERMIT STOP FOR TESTING RUNS, F1P00090
PARTA WEF 4 F1P00100
REM TABLE SAVING PROGRAM F1P00110
REM WRITE FIXCON WORD COUNT ON DRUM F1P00120
WRS 194 F1P00130
CLA FXCNIX-3 F1P00140
ARS 17 F1P00150
STO WORKCL F1P00160
CPY WORKCL F1P00170
CPY WORKCL F1P00180
REM PROGRAM FOR SAVING COMPAIL TABLE F1P00190
LXD BBOX,2 F1P00200
TXH A1PTS,2,0 F1P00210
TSX DIAG,4 STOP FOR NO INSTRUCTIONS COMPILED F1P00220
A1PTS WRS 147 F1P00230
LXA L(0),1 SAVE F1P00240
AA3PTS CPY CIB,1 CIT F1P00250
TXI AA1PTS,1,-1 BUFFER F1P00260
AA1PTS TXI AA2PTS,2,1 F1P00270
AA2PTS TXH AA3PTS,2,0 F1P00280
WEF 147 F1P00290
REW 147 F1P00300
A5PTS RTT TURN OFF TAPE CHECK F1P00310
NOP INDICATOR AND LIGHTS F1P00320
LXA L(4),1 F1P00330
LXA L(0),4 F1P00340
A14PTS RDS 147 F1P00350
A6PTS CPY COMP,4 COPY A RECORD OF COMPILED F1P00360
TXI A6PTS,4,-1 INSTRUCTIONS INTO STORAGE F1P00370
TRA A10PTS EOF F1P00380
WRS 219 EOR F1P00390
RTT F1P00400
TRA A11PTS TAPE CHECK ON F1P00410
WRS 146 F1P00420
CLA CMPREC COUNT EACH F1P00430
ADD L(1) COMPAIL F1P00440
STO CMPREC RECORD F1P00450
LXA L(2),1 F1P00460
LXA L(0),2 TRANSFER RECORD F1P00470
A9PTS CPY COMP,2 FROM STORAGE F1P00480
TXI A7PTS,2,-1 TO TAPE 2 F1P00490
A7PTS TXI A8PTS,4,1 F1P00500
A8PTS TXH A9PTS,4,0 F1P00510
TRA A14PTS F1P00520
A11PTS BST 147,0,1 PREPARE TO READ RECORD AGAIN F1P00530
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 186/186 ------
TIX A14PTS-1,1,1 TEST FOR 2 TAPE CHECKS, F1P00540
TSX DIAG,4 STOP FOR 5TH READ CHECK F1P00550
A10PTS WEF 146 END OF COMPAIL ON TAPE 2 F1P00560
WRS 146 F1P00570
CPY CMPREC F1P00580
REM PROGRAM TO SAVE FORSUB TABLE F1P00590
LXD BK,1 F1P00600
TXL WEF,1,0 TEST FOR EMPTY TABLE F1P00610
LXA L(0),2 F1P00620
CPY FORSUB,2 F1P00630
TXI A15PTS,2,-1 F1P00640
A15PTS TXI A15PTS+1,1,1 F1P00650
TXH A15PTS-2,1,0 F1P00660
WEF WEF 146 F1P00670
REM PROGRAM FOR SAVING FLOCON TABLE F1P00680
FL00 LXD FLCNIX-3,4 (N) F1P00690
PXD 0,4 F1P00700
ARS 18 F1P00710
STO FLSIZE LOAD FLSIZE WITH N F1P00720
TXL FL09,4,0 IS TABLE EMPTY F1P00730
CAL MSK F1P00740
ANS FLCNIX-2 F1P00750
ANS FLCNIX-3 F1P00760
CLA FLCNIX-3 GET NUMBER OF WORDS IN FLOCON INCLUDING CK SUMS F1P00770
SUB FLCNIX-2 F1P00780
STA FL04 SAVE L F1P00790
FL01 LXA L(5),2 SET TO TRY FIVE TIMES IF CK SUM FAILS F1P00800
FL02 LXA FL04,4 (L) F1P00810
RDR 2 F1P00820
LDA FLCNIX-2 F1P00830
FL03 CPY OTA+450,4 COPY FLOCON FROM DRUM F1P00840
TIX FL03,4,1 F1P00850
FL04 PXD **,0 F1P00860
LXA FL04,4 COMPUTE CK SUM OF ENTRIES VERSUS CK SUM OF CK F1P00870
LXA L(50),1 SUMS. TABLE IS OF FORM A CK SUM FOR FIFTY WORDS F1P00880
FL05 ACL OTA+450,4 FOLLOWED BY THE FIFTY WORDS F1P00890
COM F1P00900
TNX ERROR,4,1 F1P00910
FL06 ACL OTA+450,4 F1P00920
TNX FL07,4,1 FINAL ENRTY , GET OUT OF CK SUM LOOP F1P00930
TIX FL06,1,1 F1P00940
COM F1P00950
TXI FL05,1,49 F1P00960
FL07 COM F1P00970
TZE FL08 TEST CK SUM F1P00980
TIX FL02,2,1 CK SUM FAILED, TRY AGAIN F1P00990
TSX DIAG,4 CK SUM FAILED FIVE TIMES F1P01000
FL08 LXA FL04,4 (L) F1P01010
FL09 WTB 2 F1P01020
CPY FLSIZE F1P01030
TXL PROFOR,4,0 IS FLOCON EMPTY F1P01040
LXA L(50),1 F1P01050
FL10 TNX ERROR,4,1 F1P01060
FL11 CPY OTA+450,4 F1P01070
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 187/187 ------
TNX PROFOR,4,1 FINISHED, GET OUT OF LOOP F1P01080
TIX FL11,1,1 F1P01090
TXI FL10,1,49 F1P01100
ERROR TSX DIAG,4 INDEX RAN OUT AT CK SUM F1P01110
REM ROUTINE TO PROCESS FORMAT TABLE F1P01120
PROFOR TSX TAP00,1 F1P01130
HTR 10 F1P01140
OTA F1P01150
TSX WAT00,1 F1P01160
HTR 10 F1P01170
OTA F1P01180
REM ROUTINE TO CONVERT DIM TABLES TO SIZ TABLE. F1P01190
ADD00 LXD DIM1IX-3,4 ENTRY COUNT F1P01200
TXL ADD07,4,0 TABLE EMPTY F1P01210
ADD01 LXA L(5),2 F1P01220
ADD02 RDR 3 F1P01230
LXA L(0),1 F1P01240
LDA ORGDM1 F1P01250
PXD 0,0 F1P01260
ADD03 CPY OTA,1 COPY NAME F1P01270
CPY OTA+1,1 COPY N1 F1P01280
TXI ADD04,1,-2 F1P01290
ADD04 CAD GARBGE COPY AND SUM CK SUMS F1P01300
TIX ADD03,4,1 F1P01310
COM F1P01320
LXD DIM1IX-3,4 F1P01330
LXA L(0),1 F1P01340
ADD05 ACL OTA,1 SUM ENTRIES F1P01350
ACL OTA+1,1 F1P01360
TXI ADD06,1,-2 F1P01370
ADD06 TIX ADD05,4,1 F1P01380
COM F1P01390
TZE ADD08 F1P01400
LXD DIM1IX-3,4 CHECK SUM ERROR, TRY AGAIN F1P01410
TIX ADD02,2,1 F1P01420
TSX DIAG,4 REPEATED CK SUM ERRORS IN READING DRUM F1P01430
ADD07 LXA L(0),1 F1P01440
ADD08 SXD NEWBAS,1 F1P01450
REM NOW READ DIM2 TABLE F1P01460
LXD DIM2IX-3,4 F1P01470
TXL ADD18,4,0 TABLE EMPTY F1P01480
ADD09 LXA L(5),2 F1P01490
ADD10 RDR 3 F1P01500
LXD NEWBAS,1 F1P01510
LDA ORGDM2 F1P01520
PXD 0,0 F1P01530
ADD11 CPY OTA,1 COPY NAME F1P01540
CPY OTA+1,1 COPY N1 N2 F1P01550
TXI ADD12,1,-2 F1P01560
ADD12 CAD GARBGE COPY AND SUM CK SUMS F1P01570
TIX ADD11,4,1 F1P01580
COM F1P01590
LXD DIM2IX-3,4 F1P01600
LXD NEWBAS,1 F1P01610
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 188/188 ------
ADD13 ACL OTA,1 F1P01620
ACL OTA+1,1 F1P01630
TXI ADD14,1,-2 F1P01640
ADD14 TIX ADD13,4,1 F1P01650
COM F1P01660
TZE ADD15 F1P01670
LXD DIM2IX-3,4 CK SUM ERROR TRY AGAIN F1P01680
TIX ADD10,2,1 F1P01690
TSX DIAG,4 REPEATED CK SUM ERRORS IN READING DRUM F1P01700
ADD15 LXD DIM2IX-3,4 F1P01710
LXD NEWBAS,1 F1P01720
STZ WORKCL F1P01730
ADD16 CLA OTA+1,1 F1P01740
STA WORKCL F1P01750
LRS 53 F1P01760
MPY WORKCL N1*N2 F1P01770
STQ OTA+1,1 F1P01780
TXI ADD17,1,-2 F1P01790
ADD17 TIX ADD16,4,1 F1P01600
SXD NEWBAS,1 UPDATE NEWBAS FOR DIM3 ROUTINE F1P01810
REM NOW READ DIM3 TABLE. F1P01820
ADD18 LXD DIM3IX-3,4 F1P01830
TXL ADD28,4,0 DIM3 TABLE EMPTY F1P01840
ADD19 LXA L(5),2 F1P01850
ADD20 RDR 3 F1P01860
LXD NEWBAS,1 F1P01870
LDA ORGDM3 F1P01680
PXD 0,0 F1P01890
ADD21 CPY OTA,1 F1P01900
CPY OTA+1,1 F1P01910
CPY BUFFER,4 F1P01920
TXI ADD22,1,-2 F1P01930
ADD22 CAD GARBGE F1P01940
TIX ADD21,4,1 F1P01950
COM F1P01960
LXD DIM3IX-3,4 F1P01970
LXD NEWBAS,1 F1P01980
ADD23 ACL OTA,1 F1P01990
ACL OTA+1,1 F1P02000
ACL BUFFER,4 F1P02010
TXI ADD24,1,-2 F1P02020
ADD24 TIX ADD23,4,1 F1P02030
COM F1P02040
TZE ADD25 F1P02050
LXD DIM3IX-3,4 F1P02060
TIX ADD20,2,1 CK SUM FAILED TRY AGAIN F1P02070
TSX DIAG,4 REPEATED CK SUM ERRORS IN READING DRUM F1P02080
ADD25 LXD DIM3IX-3,4 F1P02090
LXD NEWBAS,1 F1P02100
ADD26 CLA OTA+1,1 F1P02110
STZ WORKCL F1P02120
STA WORKCL F1P02130
LRS 53 F1P02140
MPY WORKCL N1*N2 F1P02150
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 189/189 ------
MPY BUFFER,4 N3*(N1*N2) F1P02160
STQ OTA+1,1 F1P02170
TXI ADD27,1,-2 F1P02160
ADD27 TIX ADD26,4,1 F1P02190
NOP NOT USED. F1P02200
NOP NOT USED. F1P02210
REM NOW WRITE SIZ TABLE ON TAPE 2. F1P02220
ADD28 PXD 0,1 F1P02230
COM F1P02240
ADD DECR1 F1P02250
PDX 0,4 F1P02260
PXD 0,4 F1P02270
ARS 18 F1P02280
STO WORKCL F1P02290
ADD L(1) F1P02300
PAX 0,1 F1P02310
LXA L(0),2 F1P02320
PXD 0,0 F1P02330
ADD33 ACL OTA,2 COMPUTE CK SUM FOR SIZ TABLE F1P02340
TXI ADD32,2,-1 F1P02350
ADD32 TIX ADD33,4,1 F1P02360
SLW OTA,2 F1P02370
CLA DMASK F1P02380
ANS EIFNO F1P02390
WTB 2 F1P02400
CPY EIFNO F1P02410
CPY WORKCL F1P02420
TXL ADD31,1,1 F1P02430
LXA L(0),2 F1P02440
ADD29 CPY OTA,2 F1P02450
TXI ADD30,2,-1 F1P02460
ADD30 TIX ADD29,1,1 F1P02470
ADD31 WEF 2 F1P02480
WTB 2 WRITE SENSE SWITCH SETTINGS AS RE- F1P02490
LXA L(5),1 CORD ONE, FILE FIVE, TAPE TWO F1P02500
X0010 CPY ENDI1+5,1 F1P02510
TIX X0010,1,1 F1P02520
TSX TAP00,1 ASSEMBLE AND WRITE SUBDEF TABLE F1P02530
11 F1P02540
OTA F1P02550
TSX WAT00,1 F1P02560
11 F1P02570
OTA F1P02580
TSX TAP00,1 ASSEMBLE AND WRITE COMMON TABLE F1P02590
12 F1P02600
OTA F1P02610
TSX WAT00,1 F1P02620
12 F1P02630
OTA F1P02640
TSX TAP00,1 ASSEMBLE AND WRITE TABLE OF HOLLERITH ARGS F1P02650
13 F1P02660
OTA F1P02670
TSX WAT00,1 F1P02680
13 F1P02690
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 190/190 ------
OTA F1P02700
TSX TAP00,1 ASSEMBLE TEIFNO FROM TAPE 4 F1P02710
HTR 0 F1P02720
HTR OTA F1P02730
STZ PAT15 INSURE DECREMENT IS CLEAR F1P02740
LXD OTA-1,4 LENGTH OF TEIFNO INTO I.R.4 F1P02750
TXL WRITE,4,1 IS TEIFNO EMPTY OR IS THERE A SINGLE ENTRY F1P02760
LXD PAT13,1 INITIALIZE I.R. TO STEP THROUGH TABLE F1P02770
SXD PAT14,4 SAVE WORD COUNT F1P02780
ISPLUS LXD PAT14,4 REINTIALIZE FOR FURTHER SEARCHING F1P02790
NEXT CLA OTA,1 PICK UP NEXT ENTRY IN TEIFNO F1P02800
TPL MASK HAS THIS BEEN PROCESSED F1P02810
SLW OTA,1 F1P02820
TXI ISTHRU,1,-1 NO, SET I.R. TO LOOK AT NEXT ENTRY F1P02830
ISTHRU TIX NEXT,4,1 HAVE ALL ENTRIES BEEN EXAMINED F1P02840
TRA WRITE YES, FINISHED F1P02850
MASK STA PAT15 STORE COMPERAND F1P02860
TXI RECOMP,1,-1 SET I.R.S TO START COMPARISON F1P02870
RECOMP PXD 0,1 F1P02880
PDX 0,2 F1P02890
TNX WRITE,4,1 HAVE ALL ENTRIES BEEN EXAMINED F1P02900
SXD PAT14,4 SAVE NUMBER OF ENTRIES YET TO BE TREATED F1P02910
PAT16 CLA OTA,2 PICK UP ENTRY TO BE COMPARED F1P02920
TMI NODUP NO SEARCH NECESSARY IF NEGATIVE F1P02930
ANA PAT11 ISOLATE EXTERNAL FORMULA NUMBER F1P02940
CAS PAT15 COMPARE TO REMAINING ENTRIES F1P02950
TRA NODUP NO DUPLICATE F1P02960
TRA PAT9 DUPLICATE F1P02970
NODUP TXI PAT8,2,-1 NO DUPLICATE, SET I.R. TO OBTAIN NEXT ENTRYF1P02980
REM FOR COMPARISON F1P02990
PAT8 TIX PAT16,4,1 HAVE ALL ENTRIES BEEN COMPARED F1P03000
TRA ISPLUS YES F1P03010
PAT9 CLA OTA,2 FLAG DUPLICATE ENTRY NEGATIVE F1P03020
SSM F1P03030
STO OTA,2 F1P03040
CLS OTA-1,1 F1P03050
STO OTA-1,1 F1P03060
TRA ISPLUS F1P03070
WRITE TSX WAT00,1 WRITE TEIFNO ON TAPE F1P03080
HTR 0 F1P03090
OTA F1P03100
TSX TAP00,1 ASSEMBLE TIFGO F1P03110
HTR 2 F1P03120
L(2TA) HTR 2TA F1P03130
REM START PROGRAM FOR MODIFICATION OF TIFGO WITH TEIFNO F1P03140
MFGTP CLA 2TA-1 GET NUMBER OF WORDS IN 2TA. F1P03150
TZE WFG00 EXIT FOR NO ENTRIES IN TABLE, F1P03160
PDX 0,2 SET INDEX B TO NUMBER OF WORDS, F1P03170
ARS 18 COMPUTE F1P03180
ADD L(2TA) 2TA F1P03190
STA MFG00 PLUS F1P03200
STA MFG03 NUMBER F1P03210
STA MFG05 OF F1P03220
STA MFG08 WORDS F1P03230
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 191/191 ------
STA MFG09 IN F1P03240
STA MFG12 2TA F1P03250
STA MFG18 AND F1P03260
STA MFG20 INITIALIZE ADDRESSES F1P03270
CLA OTA-1 GET NUM WORDS IN OTA F1P03280
TNZ MFGOK TABLE EXISTS F1P03290
TRA TEIFER STOP FOR NO TABLE IN OTA F1P03300
MFGOK ARS 18 NUMBER WORDS PUT IN AC ADDRESS F1P03310
ADD L(OTA) ADD OTA ORIGIN F1P03320
STA MFG01 INITIALIZE ADDRESSES WITH F1P03330
STA MFG02 OTA + NUM WORDS F1P03340
STA MFG06 F1P03350
STA MFG07 F1P03360
STA MFG10 F1P03370
STA MFG11 F1P03380
STA MFG17 F1P03390
STA MFG19 F1P03400
MFG00 CLA 0,2 ADDR IS 2TA + NUM WORDS IN 2TA. (1) F1P03410
TPL MFG14 SIGN IS PLUS. F1P03420
STA E3 SAVE A1. F1P03430
LXD OTA-1,4 SET INDEX C TO NUM WORDS IN OTA.(2) F1P03440
MFG01 CLA 0,4 AL PRIME AND AL GO TO AC. F1P03450
ANA MSK ERASE AL PRIME IN AC. F1P03460
SUB E3 COMPARE TEIFNO ARGUMENT WITH A1. F1P03470
TZE MFG02 AL EQUALS ARGUMENT. F1P03480
TIX MFG01,4,1 COMP AL VS NEXT TEIFNO ENTRY. (3A1)F1P03490
CLA PAT13 F1P03500
TRA MFG03 F1P03510
MFG02 CLA 0,4 A1 PRIME AND A1L GO TO AC. F1P03520
ARS 18 A1 PRIME GOES TO ADDRESS OF AC F1P03530
MFG03 STA 0,2 (I) A1 PRIME REPLACES A1 F1P03540
MFG04 TXI MFG05,2,-1 TAKE WORD 2 OF TIFGO ENTRY F1P03550
MFG05 CLA 0,2 (1). AC DECK IS A2, ADDR IS A3 F1P03560
STA E3 SAVE A3 F1P03570
LXD OTA-1,4 (2) F1P03580
MFG06 CLA 0,4 A3 PRIME AND A3 GO TO AC F1P03590
ANA MSK ERASE A3 PRIME IN AC F1P03600
SUB E3 COMPARE TEIFNO ARGUMENT WITH A3 F1P03610
TZE MFG07 A3 EQUALS ARGUMENT F1P03620
TIX MFG06,4,1 (3A3) F1P03630
CLA PAT13 F1P03640
TRA MFG08 F1P03650
MFG07 CLA 0,4 A3 PRIME AND A3 GO TO AC F1P03660
ARS 18 A3 PRIME GOES TO ADDR OF AC F1P03670
MFG08 STA 0,2 (1). A3 PRIME REPLACES A3 F1P03680
MFG09 CLA 0,2 (1). A2 AND A3 PRIME GO TO AC F1P03690
ARS 18 A2 GOES TO ADDR OF AC F1P03700
STA E3 SAVE A2 F1P03710
LXD OTA-1,4 (2) F1P03720
MFG10 CLA 0,4 A2 PRIME AND A2 GO TO AC F1P03730
ANA MSK ERASE A2 PRIME IN AC F1P03740
SUB E3 COMPARE TEIFNO ARGUMENT WITH A2 F1P03750
TZE MFG11 A2 EQUALS ARGUMENT F1P03760
TIX MFG10,4,1 (3A2) F1P03770
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 192/192 ------
CLA PAT13 F1P03780
TRA MFG12 F1P03790
MFG11 CLA 0,4 A2 PRIME AND A2 GO TO AC F1P03800
MFG12 STD 0,2 (1) A2 PRIME REPLACES A2 F1P03810
TIX MFG00,2,1 TAKE FIRST WORD OF NEXT 2TA ENTRY F1P03820
MFG13 TIX MFG13-1,2,1 TAKE SECOND WORD OF 2TA ENTRY F1P03830
TRA WFG00 EXIT TO TAPE WRITING PROGRAM F1P03840
MFG14 PAX 0,4 INTEGER N GOES TO INDEX C F1P03850
TRA MFG14+9,4 F1P03860
TRA MFG13 N EQUALS 7 NO MODIFICATION F1P03670
TRA MFG15 N EQUALS 6 F1P03880
TRA MFG04 N EQUALS 5 F1P03890
TRA MFG04 N EQUALS 4 F1P03900
TRA MFG04 N EQUALS 3 F1P03910
TRA MFG13 N EQUALS 2 NO MODIFICATION F1P03920
TRA MFG13 N EQUALS 1 NO MODIFICATION F1P03930
TRA MFG15 N EQUALS 0 F1P03940
MFG15 TXI MFG16,2,-1 TAKE WORD 2 OF 2TA ENTRY F1P03950
MFG16 LXD OTA-1,4 (2) F1P03960
MFG17 CLA 0,4 K PRIME AND K GO TO AC F1P03970
ANA MSK ERASE K PRIME F1P03980
MFG18 SUB 0,2 (1). COMPARE K WITH TEIFNO ARGUMENTF1P03990
TZE MFG19 K EQUALS ARGUMENT F1P04000
TIX MFG17,4,1 (3K) F1P04010
CLA PAT13 F1P04020
TRA MFG20 F1P04030
MFG19 CLA 0,4 K PRIME AND K GO TO AC F1P04040
ARS 18 K PRIME GOES TO ADDRESS OF AC F1P04050
MFG20 STA 0,2 (1). K PRIME REPLACES K F1P04060
TIX MFG00,2,1 TAKE FIRST WORD OF NEXT 2TA ENTRY F1P04070
WFG00 TSX WAT00,1 WRITE 2TA ON TAPE F1P04080
2 F1P04090
HTR 2TA F1P04100
TSX TAP00,1 ASSEMBLE TRAD F1P04110
HTR 3 F1P04120
L(3TA) HTR 3TA F1P04130
REM PROGRAM FOR MODIFICATION OF TRAD WITH TEIFNO F1P04140
MTRTP CLA 3TA-1 GET NUM OF WORDS IN 3TA F1P04150
TZE WTR00 NO ENTRIES IN TABLE F1P04160
PDX 0,2 NUMBER OF WORDS PUT IN INDEX B F1P04170
ARS 18 RESET ADDRESSES F1P04180
ADD L(3TA) F1P0419O
STA MTR02 F1P04200
STA MTR04 F1P04210
CLA OTA-1 GET NUMBER WORDS IN OTA. F1P04220
TNZ MTROK TABLE EXISTS F1P04230
TRA TEIFER STOP FOR NO TABLE IN OTA F1P04240
MTROK ARS 18 PUT NUMBER WORDS IN AC ADDRESS F1P04250
ADD L(OTA) ADD OTA ORIGIN F1P04260
STA MTR01 INITIALIZE ADDRESS F1P04270
MTR00 LXD OTA-1,4 SET INDEX C TO NUM WORDS IN OTA F1P04280
MTR01 CLA 0,4 A SUB I PRIME AND A SUB I GO TO AC F1P04290
STD E3 SAVE A SUB I PRIME F1P04300
ANA MSK ERASE SUB I PRIME F1P04310
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 193/193 ------
MTR02 SUB 0,2 ADDR IS 3TA + NUM WORDS IN 3TA (1) F1P04320
TZE MTR03 A SUB I EQUALS ARGUMENT F1P04330
TIX MTR01,4,1 A SUB I NOT EQUAL TO ARGUMENT F1P04340
CLA PAT13 F1P04350
TRA MTR04 F1P04360
MTR03 CLA E3 A SUB I PRIME GOES TO AC DECR. F1P04370
ARS 18 A SUB I PRIME GOES TO AC ADDR. F1P04380
MTR04 STA 0,2 (1). A SUB I PRIME REPLACES A SUB IF1P04390
TIX MTR00,2,1 TAKE NEXT WORD OF 3TA F1P04400
WTR00 TSX WAT00,1 ALL WORDS OF 3TA EXAMINED SO F1P04410
3 WRITE 3TA ON TAPE F1P04420
3TA F1P04430
AD000 TSX TAP00,1 ASSEMBLE TDO F1P04440
1 F1P04450
OATDO 1TA ORIGIN OF ASSEMBLED TDO F1P04460
REM PROGRAM FOR MODIFICATION OF TDO WITH TEIFNO F1P04470
MDOTP CLA 1TA-1 GET NUMBER OF WORDS IN ITA F1P04480
TZE WDO00 EXIT FOR NO WORDS IN TABLE F1P04490
PDX 0,2 NUMBER OF WORDS IN ITA PUT IN IRB F1P04500
ARS 18 NUM WORDS PUT IN AC ADDR F1P04510
ADD OATDO ADD ORIGIN OF ASSEMBLED TDO F1P04520
STA MDO00 INITIALIZE ADDRESSES F1P84530
STA MDO06 F1P04540
STA MDO30 F1P04550
CLA OTA-1 GET NUMBER WORDS IN OTA F1P04560
MDOOK ARS 18 PUT NUMBER WORDS IN AC ADDRESS F1P04570
ADD L(OTA) ADD OTA ORIGIN AND F1P04580
STA MDO02 INITIALIZE ADDRESSES F1P04590
STA MDO03 F1P04600
STA MDO04 F1P04610
STA MDO041 F1P04620
MDO00 CLA 0,2 ADDR IS ITA + NUMBER WORDS (1) F1P04630
TPL MDO01 SIGN OF WORD IS PLUS F1P04640
SSP CHANGE SIGN OF WORD IN TABLE F1P04650
MDO30 STO 0,2 F1P04660
TRA MDO07 F1P04670
MDO01 ANA MSK ERASE DECR IN AC F1P04680
STA E1 SAVE BETA F1P04690
LXD OTA-1,4 SET INDEX C TO NUM WORDS IN OTA F1P04700
TXH MDO02,4,0 TEST FOR TEIFNO F1P04710
TRA TEIFER STOP FOR NO TEIFNO F1P04720
MDO02 CLA 0,4 BETA PRIME AND BETA GO TO AC F1P04730
ANA MSK ERASE BETA PRIME F1P04740
SUB E1 BETA COMPARED WITH TABLE ARGUMENT F1P04750
TZE MDO03 BETA EQUALS ARGUMENT F1P04760
TIX MDO02,4,1 BETA NOT EQUAL TO ARGUMENT F1P04770
CLA PAT13 F1P04780
TRA MDO06 F1P04790
MDO03 CLA 0,4 BETA PRIME AND BETA GO TO AC F1P04800
STD E2 SAVE DECR OF FIRST POSSIBILITY F1P04810
TNX MDO08,4,1 SEE IF THERE ARE 2 ENTRIES FOR F1P04820
MDO04 CLA 0,4 ONE ARGUMENT F1P04830
ANA MSK ERASE DECR IN AC F1P04840
SUB E1 F1P04650
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 194/194 ------
TZE MDO041 THERE ARE 2 ENTRIES F1P04860
MDO08 CLA E2 THERE IS ONLY ONE ENTRY F1P04870
TRA MDO05 FOR THIS ARGUMENT F1P04860
MDO041 CLA 0,4 F1P04890
MDO05 ARS 18 F1P04900
MDO06 STA 0,2 (I)* BETA PRIME REPLACES BETA F1P04910
MDO07 TIX MDO00,2,5 TAKE NEXT ENTRY IN ITA F1P04920
WDO00 TSX WAT00,1 WRITE TDO ON TAPE F1P04930
HTR 1 F1P04940
T0T1 HTR 1TA F1P04950
RTB 1 F1P04960
TRA 4 GO TO 1-CS FOR PART B OF ONE PRIME F1P04970
DMASK 0,0,32767 F1P04980
PAT11 OCT 77777 F1P04990
PAT13 HTR 0 F1P05000
PAT14 HTR 0 F1P05010
PAT15 HTR 0 F1P05020
GARBGE BSS 1 F1P05030
WORKCL BSS 1 F1P05040
NEWBAS BSS 1 F1P05050
BUFFER BES 90 F1P05060
E1PTS BSS 1 F1P05070
FLSIZE BSS 1 F1P05080
CMPREC BSS 1 F1P05090
END1PA ORG 1650 F1P05100
1TAM1 BSS 1 NO OF WORDS IN BLOCK F1P05110
1TA BSS 750 BLOCK FOR TABLE ASSEMBLING F1P05120
REM F1P05130
REM F1P05140
REM 704 FORTRAN MASTER RECORD CARD / 1 PRIME PART B = F0240000. F1P05150
ORG 0 F1P05160
PZE ORG1PB,,ORG1PB F1P05170
PZE END1PB F1P05180
REM F1P05190
REM THIS IS PART B OF 2 PARTS OF SECTION ONE PRIME F1P05200
REM F1P05210
ORG1PB ORG 327 F1P05220
NOP TO PERMIT A STOP FOR TESTING USE. F1P05230
TSX TAP00,1 ASSEMBLE FORVAL F1P05240
TNT6 HTR 6 F1P05250
TOT6 HTR 6TA F1P05260
LXD 6TA-1,4 TEST FOR ENTRIES IN FORVAL, IF NONE WRITE F1P05270
TXL CLMD09,4,0 IDENTIFICATION WORD AND ZERO WORD. F1P05280
REM F1P05290
TSX TAP00,1 ASSEMBLE TABLE OF FIRST, LAST FORMULA F1P05300
16 NUMBERS OF CALL STATEMENTS. F1P05310
L16TA 16TA F1P05320
REM F1P05330
LXD 16TA-1,2 TEST FOR ANY ENTRIES IN CALL NUMBER TABLE, F1P05340
TXL CLMD09,2,0 IF NONE WRITE OUT FORVAL TABLE. F1P05350
REM F1P05360
REM THERE ARE ENTRIES IN BOTH FORVAL AND CALL NUMBER TABLES. F1P05370
REM THEREFORE THERE MAY BE SOME NUMBER IN FORVAL WHICH MUST BE F1P05380
REM REPLACED WITH THE LAST NUMBER RELATED TO A CALL STATEMENT. F1P05390
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 195/195 ------
REM THE PROGRAM TO SEARCH AND REPLACE IS BASED UPON THE TWO F1P05400
REM TABLES BEING ORDERED BY MAGNITUDE OF INTERNAL FORMULA F1P05410
REM NUMBERS. THIS PERMITS A SINGLE PASS OVER BOTH, F1P05420
REM F1P05430
STZ WORKCL F1P05440
LXA L(0),1 PREPARE FOR FORWARD SEARCH. F1P05450
LXD 6TA-1,4 NO OF ENTRIES IN FORVAL. F1P05460
PXD ,2 F1P05470
ARS 18 F1P05480
ADD L16TA F1P05490
STA *+1 F1P05500
REM F1P05510
CLMD01 CLA ..,2 GET NEXT ENTRY IN CALL TABLE. F1P05520
STD WORKCL DIVIDE ENTRY INTO FIRST IN AC, LAST IN CS. F1P05530
ANA MSK F1P05540
ALS 18 F1P05550
CLMD02 CAS 6TA,1 COMPARE CALL FIRST IN AC TO NEXT FORVAL. F1P05560
TXI CLMD04,1,-1 CALL GREATER THAN FORVAL F1P05570
TRA CLMD03 CALL EQUAL FORVAL. F1P05580
TIX CLMD01,2,1 GO FOR NEXT CALL ENTRY IF ANY. OTHERWISE F1P05590
TRA CLMD09 GO WRITE FORVAL TABLE. F1P05600
REM F1P05610
CLMD03 CLA WORKCL REPLACE FORMULA NUMBER IN FORVAL WHICH IS F1P05620
STD 6TA,1 FIRST RELATED TO CALL WITH LAST. F1P05630
TXI *+1,1,-1 F1P05640
CLMD04 TIX CLMD02,4,1 GO ON WITH SEARCH IF THERE ARE MORE FORVALSF1P05650
REM IF NOT GO WRITE FORVAL TABLE. F1P05660
REM F1P05670
CLMD09 TSX WAT00,1 F1P05680
HTR 6 FORVAL F1P05690
HTR 6TA ON TAPE F1P05700
CLA 6TA-1 GET NUMBER OF WORDS IN FORVAL F1P05710
TNZ WFD00 TABLE EXISTS F1P05720
TRA A4VAR EXIT 10 ASSEMBLE NEXT TABLE F1P05730
WFD00 WRS 194 PREPARE TO WRITE FORVAL ON DRUM F1P05740
WFD01 PDX 0,1 SET INDEX A TO NUM OF WORDS F1P05750
LXA WFD01,2 SET INDEX B TO ZERO F1P05760
ARS 18 PUT NUM OF WORDS IN AC F1P05770
ADD TOT6 F1P05780
STA WFD04 INITIALIZE F1P05790
STA WFD07 F1P05800
SUB L(1) ADDRESSES F1P05810
STA WFD03 F1P05820
STA WFD06 F1P05830
TXI WFD02,1,-1 SUBTRACT ONE FROM INDEX A F1P05840
WFD02 CLM COMPUTE CHECK SUM F1P05850
WFD03 ACL 0,1 FOR EACH FORVAL F1P05860
WFD04 ACL 0,1 ENTRY AND SAVE IN F1P05870
SLW FRCHS,2 SEPARATE TABLE F1P05880
TXI WFD05,2,-1 F1P05890
WFD05 TIX WFD02,1,2 TEST END OF FORVAL ENTRIES F1P05900
LXA WFD01,2 SET INDEX B TO ZERO F1P05910
LXD 6TA-1,1 F1P05920
LDA DRL02 F1P05930
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 196/196 ------
TXI WFD06,1,-1 F1P05940
WFD06 CPY 0,1 WRITE FORVAL F1P05950
WFD07 CPY 0,1 ENTRY F1P05960
TNX WFD08,1,2 TEST END OF FORVAL ENTRIES F1P05970
CPY FRCHS,2 WRITE CHECK SUM F1P05980
TXI WFD06,2,-1 FOR ABOVE ENTRY F1P05990
WFD08 CPY FRCHS,2 WRITE CHECK SUM FOR LAST ENTRY F1P06000
CPY FRCON WRITE END OF TABLE SIGNAL F1P06010
A4VAR TSX TAP00,1 ASSEMBLE FORVAR. F1P06020
TNT5 HTR 5 F1P06030
HTR 5TA F1P06040
TSX WAT00,1 WRITE FORVAR ON TAPE F1P06050
HTR 5 F1P06060
HTR 5TA F1P06070
TSX TAP00,1 ASSEMBLE FORTAG F1P06080
HTR 4 F1P06090
HTR 4TA F1P06100
TSX WAT00,1 WRITE FORTAG ON TAPE F1P06110
HTR 4 F1P06120
HTR 4TA F1P06130
REM PROGRAM FOR PROCESSING FREQUENCY TABLE. FRET F1P06140
TSX TAP00,1 ASSEMBLE FRET. F1P06150
HTR 7 F1P06160
TOT7 HTR 7TA ORIGIN OF ASSEMBLED FRET, F1P06170
MFRTP CLA 7TA-1 GET NUM OF WORDS IN TABLE F1P06180
TZE WFR00 EXIT FOR EMPTY TABLE F1P06190
PDX 0,2 SET INDEX B TO NUM WORDS IN TABLE F1P06200
ARS 18 PUT NUMBER IN AC ADDRESS AND F1P06210
ADD TOT7 INITIALIZE ADDRESSES F1P06220
STA MFR00 F1P06230
STA MFR03 F1P06240
CLA OTA-1 GET NUMBER OF WORDS IN OTA F1P06250
TNZ MFROK TABLE EXISTS F1P06260
TRA TEIFER STOP FOR NO TABLE IN OTA F1P06270
MFROK ARS 18 PUT NUMBER WORDS IN AC ADDRESS F1P06280
ADD L(OTA) ADD OTA ORIGIN AND F1P06290
STA MFR01 INITIALIZE ADDRESSES F1P06300
STA MFR02 F1P06344
MFR00 CLA 0,2 ADDR IS 7TA + NUMBER OF WORDS F1P06320
TPL MFR04 DO NOT MODIFY THIS WORD F1P06330
STA E10 SAVE ABSOLUTE PART OF WORD F1P06340
LXD OTA-1,1 SET INDEX TO NUM WORDS IN OTA F1P06350
MFR01 CLA 0,1 TEIFNO ARGUMENT IS IN AC. F1P06360
ANA MSK COMPARE WITH 7TA WORD F1P06370
SUB E10 F1P06380
TZE MFR02 MODIFY 7TA WORD F1P06390
TIX MFR01,1,1 GO TO NEXT TEIFNO WORD F1P06400
CLA L(0) NO ENTRY FOUND IN TEIFNO. IGNORE. F1P06410
TRA MFR03 F1P06420
MFR02 CLA OTA,1 TEIFNO WORD GOES TO AC F1P06430
ARS 18 INTERNAL FORMULA NUM IN AC ADDR, F1P06440
MFR03 STA 0,2 INTERNAL FORMULA NUM GOES TO 7TA F1P06450
MFR04 TIX MFR00,2,1 EXAMINE NEXT WORD OF 7TA F1P06460
REM PROGRAM FOR SORTING FRET F1P06470
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 197/197 ------
SFRTP CLA 7TA-1 GET NUMBER OF WORDS IN FRET F1P06480
ARS 18 NUMBER WORDS IN TABLE GO TO AC ADDRF1P06490
ADD TOT7 COMPUTE NUMBER OF WORDS IN TABLE F1P06500
STA SFR01 PLUS ORIGIN OF TABLE AND INITIALIZEF1P06510
STA SFR03 ADDRESSES F1P06520
STA SFR06 F1P06530
STA SFR07 F1P06540
STA SFR11 F1P06550
STA SFR13 F1P06560
STA SFR17 F1P06570
SFR00 CLM SET E12 TO ZERO TO INDICATE F1P06580
STO E12 TABLE IS IN ORDER. F1P06590
LXD 7TA-1,1 SET INDEX A TO NUM OF WORDS IN 7TA F1P06600
SFR01 CLA 0,1 A WORD OF 7TA GOES TO AC. F1P06610
TMI SFR02 COMPARE THIS WORD. IT IS ALPHA ONE F1P06620
TXI SFR01,1,-1 EXAMINE NEXT WORD OF 7TA F1P06630
SFR02 STA E11 SAVE ALPHA ONE FOR COMPARISON F1P06640
SXD A1BOX,1 SAVE INDEX FOR RETURN TO ALPHA ONE F1P06650
TNX SFR21,1,1 EXAMINE NEXT WORD OF 7TA F1P06660
SFR03 CLA 0,1 PUT NEXT WORD OF 7TA IN AC. F1P06670
TMI SFR05 COMPARE THIS WORD. IT IS ALPHA TWO F1P06680
TXL SFR21,1,1 EXIT FOR END OF TABLE F1P06690
TXI SFR03,1,-1 EXAMINE NEXT 7TA WORD F1P06700
SFR05 SSP COMPUTE ALPHA TWO F1P06710
SUB E11 MINUS ALPHA ONE F1P06720
TPL SFR01 ALPHA ONE IS SMALLER F1P06730
CLA L(1) C(E12) NOT ZERO INDICATES TABLE WASF1P06740
STO E12 NOT IN ORDER ON THIS PASS. F1P06750
LXA L(0),4 SET INDEX C TO ZERO TO INDEX OTA F1P06760
SFR06 CLA 0,1 ALPHA TWO GOES TO AC F1P06770
STO OTA,4 SAVE ALPHA TWO F1P06780
TXI SFR07,1,-1 GET NEXT WORD OF ALPHA TWO ENTRY F1P06790
SFR07 CLA 0,1 PUT THIS WORD IN AC F1P06800
TMI SFR10 ALL WORDS OF ALPHA TWO ENTRY SAVED F1P06810
TXI SFR09,4,-1 GO TO NEXT WORD OF OTA F1P06820
SFR09 STO OTA,4 SAVE WORDS OF ALPHA TWO ENTRY F1P06830
TXL SFR10,1,1 ALPHA TWO ENTRY IS END OF TABLE F1P06840
TXI SFR07,1,-1 EXAMINE NEXT WORD OF 7TA F1P06850
SFR10 LXD A1BOX,1 SET INDEX A TO GET ADDR OF ALPHA 1 F1P06860
SFR11 CLA 0,1 ALPHA ONE GOES TO AC F1P06870
TXI SFR12,4,-1 GO TO NEXT WORD OF OTA F1P06880
SFR12 STO OTA,4 SAVE ALPHA ONE F1P06890
SXD A2BOX,4 COMPUTE INDEX FOR F1P06900
CLA A1BOX RETURNING TO ALPHA ONE F1P06910
ADD A2BOX AFTER TRANSPOSING F1P06920
STD A2BOX ALPHA ONE AND ALPHA TWO ENTRIES F1P06930
TXI SFR13,1,-1 EXAMINE NEXT WORD OF 7TA F1P06940
SFR13 CLA 0,1 PUT NEXT WORD IN AC F1P06950
TMI SFR15 FINISHED SAVING ALPHA ONE ENTRY F1P06960
TXI SFR14,4,-1 GO TO NEXT WORD OF OTA F1P06970
SFR14 STO OTA,4 SAVE WORDS OF ALPHA ONE ENTRY F1P06980
TXI SFR13,1,-1 EXAMINE NEXT WORD OF 7TA F1P06990
SFR15 LXD A1BOX,1 SET INDEX A TO GET ADDR OF ALPHA 1 F1P07000
LXA L(0),2 SET INDEX B TO INDEX OTA F1P07010
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 198/198 ------
SFR16 CLA OTA,2 ALPHA ONE ENTRY AND ALPHA TWO ENTRYF1P07020
SFR17 STO 0,1 ARE INTERCHANGED F1P07030
TXI SFR18,2,-1 GO TO NEXT WORD OF OTA F1P07040
SFR18 TNX SFR00,1,1 END OF TABLE EXIT F1P07050
TXL SFR20,4,1 TEST IF OTA IS EMPTIED F1P07060
TXI SFR16,4,1 COUNT WORDS TAKEN FROM OTA F1P07070
SFR20 LXD A2BOX,1 GET OLD ALPHA ONE AS NEW ALPHA ONE F1P07080
TRA SFR01 START OVER WITH NEW ALPHA ONE F1P07090
SFR21 CLA E12 TEST IF TABLE IS IN ORDER F1P07100
TNZ SFR00 EXAMINE TABLE AGAIN F1P07110
REM PROGRAM TO REVERSE FREQUENCIES FOR GO TO VECTOR ENTRIES IN F1P07120
REM TIFGD F1P07130
RFT00 BST 146 MOVE TAPE F1P07140
BST 146 THRU TABLES F1P07150
BST 146 ALREADY WRITTEN F1P07160
BST 146 TO OBTAIN F1P07170
BST 146 TIFGO F1P07180
BST 146 F1P07190
RDS 146 SELECT TAPE FOR READING F1P07200
CLA L(4) PREPARE TO COUNT F1P07210
STO IT1 TWO TAPE TESTS F1P07220
CPY E1RF GET TABLE NUMBER F1P07230
CLA E1RF AND COMPARE WITH F1P07240
SUB TNT2 TABLE CALLED FOR F1P07250
TZE RFT01 TABLE NUMBERS AGREE F1P07260
TSX DIAG,4 STOP FOR TABLE NOT IN RIGHT RECORD F1P07270
RFT01 CPY OTA-1 GET NUMBER OF WORDS F1P07280
CLA OTA-1 IN TAPE RECORD F1P07290
TZE WFR01 EXIT FOR EMPTY TABLE ON TAPE F1P07300
STD RFT05 F1P07310
RTT TURN OFF TAPE F1P07320
NOP CHECK INDICATOR AND LIGHTS F1P07330
RFT02 LXA L(0),2 SET INDEX B TO ZERO F1P07340
RFT03 CPY OTA,2 F1P07350
TXI RFT03,2,-1 COPY LOOP F1P07360
NOP END OF FILE JUMP F1P07370
WRS 219 END OF RECORD. DELAY FOR TAPE TEST F1P07380
RTT TAPE TEST F1P07390
TRA RFT04 TAPE TEST ON F1P07400
TRA RFT07 TAPE TEST OFF F1P07410
RFT04 BST 148 REPEAT RECORD F1P07420
RDS 148 PREPARE TO READ RECORD F1P07430
RFT05 TXI RFT06,2,** COMPENSATE FOR REREADING RECORD F1P07440
RFT06 CLA IT1 COUNT F1P07450
SUB L(1) TWO F1P07460
STO IT1 TAPE TESTS F1P07470
CPY E1RF GET TABLE NUMBER F1P07480
CPY E1RF GET NUMBER OF WORDS IN TABLE F1P07490
TPL RFT02 GO TO READ TAPE F1P07500
TSX DIAG,4 STOP FOR SECOND TAPE TEST F1P07510
RFT07 CLA 7TA-1 COMPUTE TABLE F1P07520
ARS 18 ORIGIN PLUS F1P07530
ADD TOT7 NUMBER OF F1P07540
STA RFT09 WORDS IN F1P07540
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 199/199 ------
STA RFT13 FRET AND F1P07560
STA RFT18 INITIALIZE ADDRESSES F1P07570
CLA OTA-1 GET NUMBER OF WORDS IN TI FGO F1P07580
ARS 18 PUT IN AC AND F1P07590
SUB L(1) SUBTRACT ONE F1P07600
PAX 0,4 SET INDEX C TO THIS NUMBER F1P07610
ADD TOTO ADD ORIGIN OF TIFGO ADD F1P07620
STA RFT08 INITIALIZE ADDRESS F1P07630
CLM F1P07640
SLW E1RFT F1P07650
RFT08 CLA 0,4 GET FIRST WORD OF TIFGO ENTRY F1P07660
STD E1RFT SAVE FORMULA NUMBER F1P07670
TMI RFT09-1 ENTRY IS AN IF(E) F1P07680
ANA MSK ERASE DECREMENT OF AC F1P07690
SUB L(2) TEST FOR GO TO VECTOR ENTRY F1P07700
TNZ RFT20 EXIT FOR ENTRY NOT A GO TO VECTOR F1P07710
LXD 7TA-1,1 SET INDEX A TO NUM OF WORDS IN FRETF1P07720
RFT09 CLA 0,1 GET WORD OF FRET ENTRY F1P07730
TPL RFT10 TEST FOR FIRST WORD OF ENTRY F1P07740
SSP PUT FORMULA NUMBER F1P07750
ALS 18 IN DECREMENT OF AC F1P07760
SUB E1RFT COMPARE FORMULA NUMBERS F1P07770
TZE RFT11 FORMULA NUMBERS MATCH F1P07780
RFT10 TIX RFT09,1,1 TEST END OF FRET F1P07790
TRA RFT20 EXIT FOR END OF FRET F1P07800
RFT11 TNX RFT20,1,1 PREPARE FOR SECOND WORD OF ENTRY F1P07810
RFT12 SXD E2RFT,1 AND SAVE INDEX A FOR RETURN F1P07820
LXA L(0),2 SET INDEX B TO ZERO F1P07830
RFT13 CLA 0,1 GET FREQUENCY PART OF ENTRY F1P07840
TMI RFT15 TEST END OF ENTRY F1P07850
STO FRTS,2 SAVE FREQUENCY F1P07860
TXI RFT14,2,-1 TAKE NEXT FRTS WORD F1P07870
RFT14 TIX RFT13,1,1 TAKE NEXT FRET WORD F1P07880
RFT15 TXL RFT20,2,0 EXIT FOR NO FREQUENCY IN ENTRY F1P07890
LXD E2RFT,1 SET INDEX A TO GET 2ND ENTRY WORD F1P07900
RFT16 TXI RFT17,2,1 GET FREQUENCIES F1P07910
RFT17 CLA FRTS,2 IN REVERSE ORDER F1P07920
RFT18 STO 0,1 AND REPLACE IN FRET ENTRY F1P07930
TXI RFT19,1,-1 TAKE NEXT WORD OF FRET ENTRY F1P07940
RFT19 TXH RFT16,2,0 TEST END OF ENTRY F1P07950
RFT20 TIX RFT08,4,2 TEST END OF TIFGO F1P07960
WFR01 RDS 146 POSITION F1P07970
RDS 146 TAPE F1P07980
RDS 146 FOR F1P07990
RDS 146 WRITING F1P08000
RDS 146 FRET F1P08010
WFR00 TSX WAT00,1 WRITE F1P08020
HTR 7 FRET F1P08030
HTR 7TA ON TAPE F1P08040
TSX TAP00,1 ASSEMBLE EQUIT. F1P08050
8 F1P08060
EQ F1P08070
REM PROGRAM FOR CLASSES OF EQUIVALENCE F1P08080
REM INITIALIZATION OF ADDRESSES AND STORAGE F1P08090
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 200/200 ------
CLEQ CLA EQM1 COMPUTE EO ORIGIN PLUS F1P08100
ARS 18 NUMBER OF WORDS IN TABLE F1P08110
ADD L(EQ) F1P08120
STA B7CLQ F1P08130
STA B8CLQ F1P08140
STA B9CLQ F1P08150
STA B2CLQ F1P08160
STA B11CLQ F1P08170
STA C2CLQ F1P08180
STA C3CLQ F1P08190
STA A10CLQ F1P08200
STA A11CLQ F1P08210
STA A12CLQ F1P08220
STA A13CLQ F1P08230
STA A17CLQ F1P08240
STA C10CLQ F1P08250
OADDR CLM F1P08260
SLW MEEQM1 F1P08270
SLW BOX1 F1P08280
SLW E1CLEQ F1P08290
SLW E2CLEQ F1P08300
SLW E3CLEQ F1P08310
SLW E4CLEQ F1P08320
SLW E5CLEQ F1P08330
LXA OADDR,2 F1P08340
LXD EQM1,4 F1P08350
G2CLQ SLW MEEQ,2 F1P08360
TXI G1CLQ,2,-1 F1P08370
G1CLQ TIX G2CLQ,4,1 F1P08380
CLA DECR1 F1P08390
STO BOX2 F1P08400
REM INITIALIZATION OF AN EQUIVALENCE CLASS F1P08410
BOCLQ LXD EQM1,1 SET INDEX A TO MUM OF WORDS IN EQ F1P08420
TXL OUT,1,0 EXIT FOR EMPTY EQ TABLE F1P08430
LXD BOX2,2 PREPARE TO ENTER F1P06440
TXI B7CLQ,2,-1 A WORD IN MEEQ F1P08450
B7CLQ CLA 0,1 OBTAIN EQ WORD F1P06460
TZE B5CLQ EXIT FOR DELETED EQ SET F1P08470
STO MEEQ,2 SAVE EQ SET IN TABLE MEEQ F1P08480
CLM INDICATE F1P08490
B8CLQ SLW 0,1 DELETED F1P08500
TXI B1CLQ,2,-1 EQ SET F1P08510
B1CLQ TNX 0,1,1 EXIT FOR END OF EQ TABLE F1P08520
B2CLQ CLA 0,1 OBTAIN EQ SUBSCRIPT F1P08530
TMI B4CLQ EXIT FOR END OF EQ SET F1P08540
STO MEEQ,2 SAVE REST OF EQ SET F1P08550
TXI B9CLQ,1,-1 F1P08560
B9CLQ CLA 0,1 OBTAIN EQ SYMBOL F1P08570
TXI B10CLQ,2,-1 F1P08580
B10CLQ STO MEEQ,2 F1P08590
TXI B3CLQ,2,-1 IN TABLE MEEQ F1P08600
B3CLQ TIX B2CLQ,1,1 F1P08610
TRA ** EXIT FOR END OF EQ TABLE F1P08620
B4CLQ SSP SAVE LAST F1P08630
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 201/201 ------
STO MEEQ,2 SUBSCRIPT OF EQ SET F1P08640
SXD BOX2,2 AND ITS MEEQ INDEX F1P08650
TRA C0CLQ GO TO COMPARISON ROUTINE F1P08660
B5CLQ TXI B11CLQ,1,-1 F1P08670
B11CLQ CLA 0,1 LOOP TO F1P08680
TPL B6CLQ GO THROUGH F1P08690
TIX B7CLQ,1,1 DELETED SET F1P08700
B6CLQ TIX B11CLQ,1,2 F1P08710
TRA END EXIT FOR COMPLETELY DELETED EO TABLF1P08720
REM COMPARISON OF MEEQ SYMBOLS WITH EQ SYMBOLS F1P08730
C0CLQ LXD BOX2,2 INITIALIZE TEST F1P06740
SXD C5CLQ,2 FOR END OF MEEO TABLE F1P08750
LXD BOX1,2 SET INDEX B TO GET 1ST SYMB OF MEEQF1P08760
C6CLQ LXD EQ-1,1 PREPARE TO SCAN EQ TABLE F1P08770
C7CLQ SXD E1CLEQ,1 SAVE INDEX OF 1ST WORD OF EQ SET F1P08760
C2CLQ CLA 0,1 OBTAIN EQ WORD F1P08790
TNZ C4CLQ SET NOT DELETED F1P08800
TXI C3CLQ,1,-1 F1P08810
C3CLQ CLA 0,1 LOOP TO GO THRU F1P08820
TMI C1CLQ DELETED SET F1P08830
TIX C3CLQ,1,2 F1P08840
C1CLQ TIX C7CLQ,1,1 EXAMINE NEXT EQ SET F1P08850
TRA C9CLQ EXIT FOR END OF EO TABLE F1P08860
C4CLQ STO E5CLEQ SAVE EQ SYMBOL F1P08870
TXI C10CLQ,1,-1 F1P08880
C10CLQ CLA 0,1 GET EQ SUBSCRIPT F1P08890
TPL C8CLQ NOT END OF EQ SET F1P08900
CLA E5CLEQ GET LAST SYMBOL OF EQ SET F1P08910
SUB MEEQ,2 COMPARE WITH MEEQ SYMBOL F1P08920
TZE A0CLQ MATCH F1P08930
TIX C7CLQ,1,1 NO MATCH F1P08940
TRA C9CLQ F1P08950
C8CLQ CLA E5CLEQ F1P08960
SUB MEEQ,2 F1P08970
TZE A0CLQ F1P08980
TIX C2CLQ,1,1 F1P08990
C9CLQ TXI C5CLQ,2,-2 GET NEXT MEEQ SYMBOL F1P09000
C5CLQ TXH C6CLQ,2,** TEST END OF TABLE MEEQ F1P09010
REM END OF TABLE MEEQ, NO MATCH IN TABLE EQ F1P09020
F2CLQ LXD BOX2,2 INDICATE F1P09030
CLA MEEQ,2 END OF SET F1P09040
SSM IN TABLE F1P09050
STO MEEQ,2 MEEQ F1P09060
TXI F1CLQ,2,-1 INITIALIZE INDEX OF F1P09070
F1CLQ SXD BOX1,2 NEXT SET IN TABLE MEEO AND F1P09080
TRA BOCLQ INITIALIZE THE SET F1P09090
REM MEEQ SYMBOL MATCHES EQ SYMBOL F1P09100
A0CLQ TXI A14CLQ,1,1 F1P09110
A14CLQ SXD A6CLQ,1 SAVE EO INDEX OF MATCHED SYMBOL F1P09120
TIX A1CLQ,1,1 F1P09130
A1CLQ TXI A2CLQ,2,-1 F1P09140
A2CLQ CLA MEEQ,2 F1P09150
STA E2CLEQ SAVE SUBSCRIPT OF MEEQ SYMBOL F1P09160
A10CLQ CLA 0,1 F1P09170
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 202/202 ------
STA E3CLEQ SAVE SUBSCRIPT OF EQ SYMBOL F1P09160
LXD BOX2,2 F1P09190
TXI A16CLQ,2,-1 F1P09200
A16CLQ SXD E1CLQ,2 F1P09210
TXI A15CLQ,2,1 F1P09220
A15CLQ TMI A9CLQ MATCHED SYMBOL IS END OF EQ SET F1P09230
A4CLQ TXI A3CLQ,2,-1 LOOP TO TRANSFER F1P09240
A3CLQ TNX 0,1,1 TO MEEO SYMBOLS OF F1P09250
A11CLQ CLA 0,1 EQ BELOW MATCHED SYMBOL F1P09260
STO MEEQ,2 F1P09270
TNX 0,1,1 F1P09280
TXI A17CLQ,2,-1 F1P09290
A17CLQ CLA 0,1 F1P09300
TMI A5CLQ F1P09310
STO MEEQ,2 F1P09320
TRA A4CLQ F1P09330
A5CLQ STA MEEQ,2 SAVE SBSCR OF LAST SYMBOL OF EQ SETF1P09340
A9CLQ LXD E1CLEQ,1 F1P09350
A6CLQ TXL A8CLQ,1,** EXIT FOR MATCHED SYMBOL REACHED F1P09360
A12CLQ CLA 0,1 LOOP TO TRANSFER F1P09370
TXI A7CLQ,2,-1 TO MEEO SYMBOLS OF F1P09380
A7CLQ STO MEEQ,2 EQ ABOVE MATCHED F1P09390
TXI A6CLQ,1,-1 SYMBOL F1P09400
A8CLQ SXD BOX2,2 F1P09410
SXD D2CLQ,2 F1P09420
SXD D4CLQ,2 F1P09430
LXD E1CLEQ,1 INDICATE F1P09440
CLM DELETED F1P09450
A13CLQ SLW 0,1 EQ SET F1P09460
REM NORMALIZATION OF MEEQ SUBSCRIPTS F1P09470
CLA E3CLEQ GET EQ SUBSCRIPT F1P09480
SUB E2CLEQ COMPARE WITH MEEQ SUBSCRIPT F1P09490
TZE C0CLQ SUBSCRIPTS MATCH F1P09500
STA E4CLEQ F1P09510
TPL E0CLQ F1P09520
REM EQ SUBSCRIPT LESS THAN MEEQ SUBSCRIPT F1P09530
LXD E1CLQ,2 F1P09540
TXI D4CLQ,2,-1 F1P09550
D4CLQ TXL D3CLQ,2,** F1P09560
D1CLQ CLA MEEQ,2 NORMALIZE SUBSCRIPTS F1P09570
ADD E4CLEQ OF NEW SYMBOLS F1P09580
STA MEEQ,2 IN MEEQ SET F1P09590
TXI D2CLQ,2,-2 F1P09600
D2CLQ TXH D1CLQ,2,** F1P09610
D3CLQ CLA MEEQ,2 NORMALIZE SUBSCRIPT F1P09620
ADD E4CLEQ OF LAST NEW SYMBOL F1P09630
STA MEEQ,2 ENTERED IN MEEQ SET F1P09640
TRA C0CLQ GO TO COMPARISON ROUTINE F1P09650
REM EQ SUBSCRIPT GREATER THAN MEEQ SUBSCRIPT F1P09660
E0CLQ LXD BOX1,2 F1P09670
TXI E2CLQ,2,-1 F1P09680
E2CLQ CLA MEEQ,2 NORMALIZE SUBSCRIPTS F1P09690
ADD E4CLEQ OF OLD SYMBOLS F1P09700
STA MEEQ,2 IN MEEQ SET F1P09710
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 203/203 ------
TXI E1CLQ,2,-2 F1P09720
E1CLQ TXH E2CLQ,2,** F1P09730
TRA C0CLQ GO TO COMPARISON ROUTINE F1P09740
END CLA BOX2 COMPUTE F1P09750
COM NUMBER F1P09760
ADD DECR2 OF WORDS F1P09770
PDX 0,2 IN TABLE F1P09780
PXD 0,2 MEEO AND F1P09790
STD MEEQM1 SAVE WITH TABLE F1P09800
REM REDUNDANCY AND INCONSISTENCY TEST OF EQUIVALENCE SENTENCES F1P09810
LXD BOX2,2 INITIALIZATION F1P09820
SXD M11CLQ,2 OF F1P09830
LXA OADDR,2 INDEXING F1P09840
SXD BOX1,2 F1P09850
M6CLQ LXD BOX1,2 OBTAIN F1P09860
CLA MEEQ,2 FIXED F1P09870
STO SMBL SYMBOL F1P09880
TXI M10CLQ,2,-1 AND F1P09890
M10CLQ CLA MEEQ,2 ITS F1P09900
STO SBSCR SUBSCRIPT F1P09910
TXI M1CLQ,2,-1 F1P09920
M1CLQ CLA MEEQ,2 GET CHANGING SYMBOL AND F1P09930
CAS SMBL COMPARE WITH FIXED SYMBOL F1P09940
TRA M2CLQ NO MATCH F1P09950
TRA K1CLQ MATCH F1P09960
M2CLQ TXI M3CLQ,2,-1 HAS END OF CHANGING SYMBOLS F1P09970
M3CLQ CLA MEEQ,2 BEEN REACHED, NO MATCH CASE F1P09980
TMI M4CLQ YES F1P09990
TXI M1CLQ,2,-1 NO F1P10000
M4CLQ SXD M7CLQ,2 F1P10010
M9CLQ LXD BOX1,2 PREPARE TO GET F1P10020
TXI M5CLQ,2,-2 NEXT FIXED F1P10030
M5CLQ SXD BOX1,2 SYMBOL F1P10040
TXI M7CLQ,2,-1 F1P10050
M7CLQ TXH M6CLQ,2,** TEST END OF MEEQ SET F1P10060
M11CLQ TXL CLQOUT,2,0 F1P10070
TXI M8CLQ,2,-1 F1P10080
M8CLQ SXD BOX1,2 F1P10090
TRA M6CLQ F1P10100
K1CLQ TXI K2CLQ,2,-1 GET SUBSCRIPT F1P10110
K2CLQ CLA MEEQ,2 OF CHANGING SYMBOL F1P10120
TMI K4CLQ END OF SET REACHED F1P10130
CAS SBSCR COMPARE SUBSCRIPTS OF MATCHED SYMBLF1P10140
TRA K3CLQ NO MATCH, INCONSISTENT CASE F1P10150
TXI M1CLQ,2,-1 MATCH, REDUNDANT CASE F1P10160
K3CLQ LXD NEWTBL,4 F1P10170
TXH ERSTOR,4,0 F1P10180
CLA FRCON F1P10190
STO MEEQ F1P10200
ERSTOR CLA SMBL F1P10210
STO MEEQ+1,4 F1P10220
TXI SAVIR4,4,-1 F1P10230
SAVIR4 SXD NEWTBL,4 F1P10240
TRA M9CLQ GET NEXT SYMBOL F1P10250
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 204/204 ------
NEWTBL HTR 0 F1P10260
K4CLQ SSP F1P10270
CAS SBSCR F1P10280
TRA K3CLQ F1P10290
TRA M9CLQ F1P10300
TRA K3CLQ F1P10310
CLQOUT LXD NEWTBL,4 F1P10320
TXL OUT,4,0 F1P10330
CLA FRCON F1P10340
STO MEEQ+1,4 F1P10350
OUT TSX WAT00,1 WRITE EQUIT ON TAPE. F1P10360
8 F1P10370
MEEQ F1P10380
TSX TAP00,1 ASSEMBLE TABLE CLOSUB F1P10390
9 F1P10400
TOT9 9TA ORIGIN OF TABLE 9 F1P10410
REM PROGRAM FOR REMOVING DUPLICATE ENTRIES FROM TABLE CLOSUB F1P10420
RDCTP CLA 9TA-1 GET NUMBER OF WORDS IN 9TA F1P10430
TZE REC07 EXIT FOR EMPTY TABLE F1P10440
PDX 0,4 SET INDEX C TO NUM OF WORDS IN 9TA F1P10450
ARS 18 COMPUTE TABLE ORIGIN PLUS F1P10460
ADD TOT9 NUMBER OF WORDS IN TABLE F1P10470
STA REC01 AND INITIALIZE ADDRESS F1P10480
LXD REC03,2 SET INDEX B TO COMP 1 AND F1P10490
SXD REC04,2 SAVE COMP 1 IN DECR OF REC04 F1P10500
REC00 LXA L(0),2 SET INDEX B TO ZERO F1P10510
REC01 CLA 0,4 GET 9TA WORD AND F1P10520
REC02 CAS 9TA,2 COMPARE WITH 9TA WORD F1P10530
TRA REC03 9TA WORDS NOT EQUAL F1P10540
TRA REC06 9TA WORDS ARE EQUAL F1P10550
REC03 TXI REC04,2,-1 TAKE NEXT 9TA WORD F1P10560
REC04 TXH REC02,2,** TEST FOR END OF NEW 9TA TABLE F1P10570
LXD REC04,1 ADD COMP 1 TO DECR OF F1P10580
TXI REC05,1,-1 REC04 TO ACCOUNT FOR F1P10590
REC05 SXD REC04,1 FOLLOWING ENTRY F1P10600
STO 9TA,2 ENTER UNEQUAL 9TA WORD IN TABLE F1P10610
REC06 TIX REC00,4,1 TEST END OF OLD 9TA TABLE F1P10620
LXD REC04,4 GET TWOS COMP OF NUMBER F1P10630
PXD 0,4 OF WORDS ENTERED IN 9TA F1P10640
COM COMPUTE TRUE FIGURE AND F1P10650
ADD L(1) STORE IN 9TA-1 F1P10660
PDX 0,4 F1P10670
SXD 9TA-1,4 F1P10680
REC07 TSX WAT00,1 WRITE MODIFIED F1P10690
HTR 9 TABLE CLOSUB F1P10700
HTR 9TA ON TAPE F1P10710
WEF 146 END OF TAPE TABLES FILE F1P10720
REW 3 F1P10730
CLA WAT99 CHANGE WAT SUB ROUTINE TO WRITE ON TAPE 3 F1P10740
STA WAT09 F1P10750
STA WAT05+2 F1P10760
STA WAT07-1 F1P10770
STA WAT08 F1P10780
CLA WAT05+4 NOP F1P10790
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 205/205 ------
STO WAT04-1 OVER COPY IDENTIFICATION F1P10800
STO WAT04 OVER COPY WORD COUNT F1P10810
STO WAT03-1 OVER STA FOR WORD COUNT F1P10820
CLA TP3TRA F1P10830
STO WAT04+2 F1P10840
TSX TAP00,1 ASSEMBLE NONEXC TABLE F1P10850
14 F1P10860
XTA F1P10870
TSX WAT00,1 WRITE NONEXC TABLE ON TAPE 3 F1P10880
14 F1P10890
XTA F1P10900
TSX TAP00,1 ASSEMBLE TSTOPS TABLE F1P10910
15 F1P10920
XTA F1P10930
TSX WAT00,1 WRITE TSTOPS TABLE AS SECOND RECORD TAPE 3 F1P10940
15 F1P10950
XTA F1P10960
CLA EIFNO F1P10970
ADD DECR1 SET EIFNO TO LAST ADD IN PROBLEM PLUS 1 F1P10980
STO EIFNO F1P10990
CAL DECR2 F1P11000
COM F1P11010
ANS 16 F1P11020
CLA ENDI4 F1P11030
CAS L(1) F1P11040
TRA *+4 F1P11050
CLA DECR2 F1P11060
ORS 16 F1P11070
TRA SPACE F1P11080
PXD ,0 F1P11090
SWT 4 F1P11100
TRA SPACE F1P11110
CLA DECR2 F1P11120
ORS 16 F1P11130
SPACE RTB 1 F1P11140
TRA 4 F1P11150
WAT99 147 ADD OF TAPE 3 IN BINARY MODE F1P11160
REM WORKING STORAGE FOR PROGRAM CLEQ F1P11170
L(EQ) EQ F1P11180
BOX1 F1P11190
BOX2 F1P11200
E1CLEQ F1P11210
E2CLEQ F1P11220
E3CLEQ F1P11230
E4CLEQ F1P11240
E5CLEQ F1P11250
REM WORKING STORAGE FOR PROGRAM AMW F1P11260
E10 F1P11270
E11 AMW2105 F1P11280
A1BOX AMW 2106 F1P11290
A2BOX AMW 2305 F1P11300
IT1 AMW 2510 F1P11310
E1RFT F1P11320
E2RFT F1P11330
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 206/206 ------
END1PB ORG 907 F1P11340
XTAM1 BSS 1 F1P11350
XTA BSS 1500 THIS IS TABLE ASSEMBLY BUFFER OF PART 2 F1P11360
REM F1P11370
REM F1P11380
REM 704 FORTRAN MASTER RECORD CARD / 1 PRIME COMMON = F0210000. F1P11390
ORG 0 F1P11400
PZE ORG1PC,,1TOCS F1P11410
PZE END1PC F1P11420
REM F1P11430
REM COMMON TO SECTION ONE PRIME F1P11440
REM F1P11450
ORG1PC ORG 2408 F1P11460
OTAM1 BSS 1 LOCATION OF NUM OF WORDS IN TEIFNO F1P11470
OTA BSS 1500 BLOCK FOR ASSEMBLED TEIFNO F1P11480
REM TABLE ASSEMBLY PROGRAM F1P11490
TAP00 REW 4 F1P11500
STQ E2A F1P11510
SXD E3A,2 F1P11520
SXD E4A,4 F1P11530
CLA 1,1 GET TABLE NUMBER F1P11540
STA TAP00+6 F1P11550
PAX ,2 F1P11560
ALS 1 F1P11570
ADD 1,1 FORM 3I F1P11580
ADD OAD F1P11590
STA TAP06 F1P11600
STA TAP20 F1P11610
ADD L(2) FORM INTET + 3I +2 F1P11620
STA TAP01 F1P11630
STA TAP05 F1P11640
CLA MWN+10,2 F1P11650
PAX ,2 TABLE MAXIMUM F1P11660
SXD TAP081,2 F1P11670
SXD OVTEST,2 F1P11680
LXA L(0),2 F1P11690
TAP01 LXA **,4 NO OF BLOCKS OF THIS TABLE ON TAPE 4 F1P11700
CLA 2,1 F1P11710
STA TAP03 F1P11720
STA TAP08 F1P11730
SUB L(1) F1P11740
STA TAP11 F1P11750
STA TAP12 F1P11760
TXL TAP05,4,0 TEST FOR NO TAPE RECORDS F1P11770
TAP20 CLA ** F1P11780
STD TAP14+1 F1P11790
RTT TURN OFF INDICATOR F1P11600
TXH 0,0,0 F1P11810
TAP02 IOD F1P11820
RTT TEST INDICATOR F1P11830
TXI TAP14,4,1 ON F1P11840
CLA L(4) OFF F1P11850
STO E5A F1P11860
READ4 RTB 4 F1P11870
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 207/207 ------
CPY E1A COPY IDENTIFICATION F1P11880
TRA TAP025 F1P11890
TSX DIAG,4 EOF MACHINE ERROR F1P11900
TAP025 CLA E1A F1P11910
SUB 1,1 TEST FOR RECORD OF TABLE BEING ASSEMBLED F1P11920
TNZ READ4 F1P11930
TAP03 CPY **,2 F1P11940
TXI OVTEST,2,-1 F1P11950
TSX DIAG,4 EOF MACHINE ERROR F1P11960
TIX TAP02,4,1 F1P11970
TAP04 IOD F1P11980
RTT F1P11990
TRA TAP14 F1P12000
TAP05 CLA ** F1P12010
ARS 18 F1P12020
TZE TAP11 F1P12030
PAX ,4 F1P12040
TAP06 ADD ** F1P12050
STA TAP07 F1P12060
TAP07 CLA **,4 F1P12070
TAP08 STO **,2 F1P12080
TXI TAP081,2,-1 F1P12090
TAP081 TXL OVFLOW,2,** F1P12100
TAP09 TIX TAP07,4,1 F1P12110
TAP11 STZ ** F1P12120
PXD ,2 F1P12130
TZE TAP13 F1P12140
ARS 18 F1P12150
COM F1P12160
ADD L(1) F1P12170
PAX ,2 F1P12180
TAP12 SXD **,2 F1P12190
TAP13 LDQ E2A F1P12200
LXD E3A,2 F1P12210
LXD E4A,4 F1P12220
TRA 3,1 RETURN TO CALLER F1P12230
OVTEST TXH TAP03,2,** F1P12240
OVFLOW TSX DIAG,4 BUFFER AREA EXCEEDED F1P12250
TAP14 BST 4 F1P12260
TXI TAP14+2,2,** F1P12270
CLA E5A F1P12280
SUB L(1) F1P12290
STO E5A F1P12300
TNZ READ4 F1P12310
TSX DIAG,4 THREE FAILURES IN READING A RECORD FROM T4 F1P12320
OAD INTET F1P12330
BSS 3 F1P12340
REM MAXIMUM NUMBER OF WORDS ALLOWED IN VARIOUS TABLES F1P12350
-100 FMTEFN, TABLE 17 F1P12360
-100 CALLFN, TABLE 16 F1P12370
-300 TSTOPS, TABLE 15 F1P12380
-750 NONEXC, TABLE 14 F1P12390
-900 HOLARG, TABLE 13 F1P12400
-600 COMMON, TABLE 12 F1P12410
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 208/208 ------
-900 SUBDEF, TABLE 11 F1P12420
MWN -1430 FORMAT, TABLE 10 F1P12430
-1500 CLOSUB, TABLE 9 F1P12440
-1500 EQUIT, TABLE 8 F1P12450
-750 FRET, TABLE 7 F1P12460
-1000 FORVAL, TABLE 6 F1P12470
-1500 FORVAR, TABLE 5 F1P12480
-1500 FORTAG, TABLE 4 F1P12490
-250 TRAD, TABLE 3 F1P12500
-600 TIFGO TABLE 2 F1P12510
-750 TDO, TABLE 1 F1P12520
-750 TEIFNO, TABLE 0 F1P12530
REM F1P12540
REM PROGRAM FOR WRITING AN ASSEMBLED TABLE ON TAPE F1P12550
WAT00 SXD E1W,2 START PROGRAM WAT F1P12560
CLA L(4) PREPARE TO COUNT F1P12570
STO E2W TWO TAPE TESTS F1P12580
WAT09 WRS 146 PREPARE TO WRITE ON TAPE 2 F1P12590
CLA 2,1 COMPUTE LOCATION OF NUMBER OF WORDSF1P12600
SUB L(1) IN TABLE AND INITIALIZE ADDRESSES F1P12610
STA WAT03 F1P12620
STA WAT04 F1P12630
WAT03 CLA ** ADDRESS IS NTA-1 F1P12640
ARS 18 NUMBER OF WORDS IN TABLE PUT IN F1P12650
PAX 0,2 INDEX B F1P12660
ADD 2,1 RESET ADDRESS F1P12670
STA WAT05 F1P12680
CPY 1,1 IDENTIFY TABLE ON TAPE F1P12690
WAT04 CPY ** NUM OF WORDS IN TABLE PUT ON TAPE F1P12700
SUB 2,1 F1P12710
TZE WAT06 NO ENTRIES IN TABLE F1P12720
WAT05 CPY 0,2 ADDR IS NTA + NUM WORDS IN NTA F1P12730
TIX WAT05,2,1 COPY LOOP F1P12740
BST 146 F1P12750
RTT F1P12760
NOP F1P12770
RDS 146 F1P12780
WAT07 CPY E2A F1P12790
TRA WAT07 F1P12800
NOP E O R F1P12810
WRS 219 E O F F1P12820
RTT F1P12830
TRA WAT10 TAPE CHECK ON F1P12840
TRA WAT06 TAPE CHECK OFF F1P12850
WAT10 CLA E2W F1P12860
SUB L(1) F1P12870
STO E2W F1P12880
TPL WAT08 F1P12890
TSX DIAG,4 STOP FOR THIRD TAPE CHECK F1P12900
WAT08 BST 146 F1P12910
TRA WAT09 F1P12920
CPY L(0) F1P12930
WAT06 LXD E1W,2 RESTORE INDEX B F1P12940
TRA 3,1 RETURN TO MAIN PROGRAM F1P12950
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 209/209 ------
REM F1P12960
E1W F1P12970
E2W F1P12980
L(0) 0 F1P12990
L(1) 1 F1P13000
L(2) 2 F1P13010
L(3) 3 F1P13020
L(4) 4 F1P13030
L(5) 5 F1P13040
L(8) 8 F1P13050
L(50) 50 F1P13060
DECR1 0,0,1 F1P13070
DECR2 0,0,2 F1P13080
MSK OCT 77777 AMWO5O3 F1P13090
FRCON OCT 377777777777 35 ONES. AMW 1318 F1P13100
DRL02 202 LOCATION OF FIRST WORD ON DRUM F1P13110
TNT2 2 F1P13120
E3 NON ERASABLE 0416 TO 0908 F1P13130
E4 F1P13140
L(0TA) OTA F1P13150
TEIFER TSX DIAG,4 F1P13160
TP3TRA TZE WAT06-1 F1P13170
E1A BSS 1 F1P13180
E2A BSS 1 F1P13190
E3A BSS 1 F1P13200
E4A BSS 1 F1P13210
E5A BSS 1 F1P13220
E1 SYN E4 F1P13230
E2 SYN E3 F1P13240
TAPOO SYN TAP00 F1P13250
WATOO SYN WAT00 F1P13260
L(OTA) SYN L(0TA) F1P13270
DIAG SYN 4 F1P13280
COMP SYN 1TA F1P13290
2TA SYN 1TA F1P13300
3TA SYN 1TA F1P13310
TOTO SYN L(OTA) F1P13320
EQM1 SYN OTA-1 F1P13330
EQ SYN OTA F1P13340
4TA SYN XTA F1P13350
5TA SYN XTA F1P13360
6TA SYN XTA F1P13370
7TA SYN XTA F1P13380
9TA SYN XTA F1P13390
MEEQM1 SYN XTA-1 F1P13400
MEEQ SYN XTA F1P13410
FRTS SYN XTA+750 F1P13420
FRCHS SYN XTA+1000 F1P13430
E12 SYN E3 F1P13440
E1RF SYN E4 F1P13450
SMBL SYN E1CLEQ F1P13460
SBSCR SYN E2CLEQ F1P13470
16TA SYN 6TA+1000 F1P13480
1TOCS SYN 4 F1P13490
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 210/210 ------
REM F1P13500
REM THE FOLLOWING SYN CARDS ARE FOR PARAMETERS IN THE CARRY OVER F1P13510
REM FROM SECTION ONE TO SECTION ONE PRIME. F1P13520
EIFNO SYN 24 F1P13530
ENDI1 SYN 25 F1P13540
ENDI4 SYN 28 F1P13550
INTET SYN 210 F1P13560
FXCNIX SYN 271 F1P13570
FLCNIX SYN 276 F1P13580
ORGDM1 SYN 299 F1P13590
DIM1IX SYN 301 F1P13600
ORGDM2 SYN 304 F1P13610
DIM2IX SYN 306 F1P13620
ORGDM3 SYN 309 F1P13630
DIM3IX SYN 311 F1P13640
BK SYN 312 F1P13650
FORSUB SYN 313 F1P13660
BBOX SYN 415 F1P13670
CIB SYN 416 F1P13680
END1PC BSS 0 F1P13690
END F1P13700
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 211/211 ------
ORG 25
ERLIST SYN 32767
TABLE SYN ERLIST-100
TRADT SYN ERLIST-1250
BETA SYN ERLIST-1251
TIFGOT SYN ERLIST-1252
ALPHA SYN ERLIST-1252
NONEXT SYN ERLIST-1852
REW 2
REW 3
LXA IR2,4
RDFILE RTD 2 WILL READ ANY KIND OF END FILE MARK
CPY 0
TRA RDFILE
TIX RDFILE,4,1 SPACE OVER 2 FILES AND OVER 1ST RECORD OF
RTB 2 3RD FILE
NOP
LXA IR4,1
CP CPY TABLE+1,1
TXI CP,1,1
TRA831 START AGAIN, CANNOT GET END FILE
TIX FORSUB,1,1 DROP COUNT OF 2ND FILE
OVER RTB 2 SPACE OVER END FILE AFTER FORSUB
RTB 2 SPACE OVER FLOCON
RTB 2 SPACE OVER FORMAT
RDREC LXA IR4,1
RTB 2
CPY IDENT
CPY WDCONT
COPY CPY TABLE,1 ALTERNATE FOR READING TRAD CPY TRAD,2
CPTXI TXI COPY,1,1 TIX COPYAA,1,1
COPYAA TXI COPY,4,-1
PXD 0,1
RDA TRA PTCH NOP GOES HERE AFTER SIZ TABLES ARE READ
SUBWDS SUB WDCONT
RDAAB TZE SIZ TZE IDNTFY REPLACES THIS AFTER SIZ TABLES READ
LXD BST,4
TXL TRY,4,14
LDQ IDENT
BADWC TSX ERROR,4
TRA DIAGND
TRY TXI RDSXD,4,1
RDSXD SXD BST,4
BST 2
TRA RDREC
IDNTFY STZ BST FORMAT SIZE AND ALL TAPE TABLES HAVE
LXA TAPTAB,2 IDENTIFICATION WORD AS FIRST WORD OF
CLA IDENT TAPE RECORD, NOT INCLUDED IN WORD
CAS CAS TAPTAB,2 COUNT
TRA NEXT
TRA HAVE
NEXT TIX CAS,2,2
LXD BSTA,4 BACK SPACE RECORD AND TRY AGAIN 15 TIMES
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 212/212 ------
TXL TRYA,4,14 IF NECESSARY
LDQ IDENT
NOIDEN TSX ERROR,4
TRA DIAGND
TRYA TXI IDNSXD,4,1
IDNSXD SXD BSTA,4
BST 2
TRA RDREC
HAVE STZ BSTA
CLA TAPTAB+1,2
STA TRA
TRA TRA 0
NOTIFG RTB 2 IF NO TIFGO ENTRY, IGNORE TRAD ENTRY
TRA RDREC
FORSUB TIX SAVEA,1,2
LXA IR4,1
SAVEA SXD TXLA,1
LXA IR4,1
LDQA LDQ TABLE,1
TSXA TSX CHECKA,4
TXI TXLA,1,2
TXLA TXL LDQA,1,0
TRA OVER
SIZ TXL SETRD,1,0 IF NO ENTRIES, GET NEXT TAPE RECORDS
TIX SAVEB,1,2 REDUCE WORD COUNT FOR END OF ENTRIES TEST
LXA IR4,1 IF TOO SMALL, SET TO ZERO
SAVEB SXD TXLB,1
LXA IR4,1 START AT FIRST ENTRY, THAT IS IR IS ZERO
LDQB LDQ TABLE,1
TSXB TSX CHECKA,4
TXI TXLB,1,2 GET NEXT 2 WORD ENTRY
TXLB TXL LDQB,1,0
SETRD RTB 2 SPACE OVER GAP AT END OF 4TH FILE
RTB 2 SPACE OVER 5 WORD END RECORD
CLA AFTRSZ
STA RDAAB
CLA NOP
STO RDA RESET TEST AT END OF READ LOOP
TRA RDREC
SUBARG TXL RDREC,1,0 INITIALIZATION OF END ENTRIES TEST
TIX SAVEC,1,1
LXA IR4,1
SAVEC SXD TXLC,1
LXA IR4,1
LDQC LDQ TABLE,1
TSXC TSX CHECKA,4
TXI TXLC,1,1 1 WORD ENTRIES
TXLC TXL LDQC,1,0
TRA RDREC
UPPER TXL UPPRTB,1,0 INITIALIZE END OF ENTRIES TEST
TIX SAVED,1,1
LXA IR4,1
SAVED SXD TXLD,1
LXA IR4,1
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 213/213 ------
LDQD LDQ TABLE,1
TSXD TSX CHECKA,4
TXI TXLD,1,1 1 WORD ENTRIES
TXLD TXL LDQD,1,0
UPPRTB RTB 2 NO SCAN OF HOLARG RECORD
TRA RDREC
TEIFNO TXL RDREC,1,0 INITIALIZE END OF ENTRIES TEST
TIX SAVEE,1,1
LXA IR4,1
SAVEE SXD TXLE,1
LXA IR4,1
CLAE CLA TABLE,1 MINUS ENTRY MEANS BETA IS
TPL TSTE DUPLICATED IN SOURCE PROGRAM
LDQ TABLE,1
TSXE TSX ERROR,4
TSTE TXI TXLE,1,1
TXLE TXL CLAE,1,0
CLA ADTIFG
STA COPY
TRA RDREC
TIFGO TXL PATIF,1,0 IF NO ENTRIES, IGNORE TRAD IDENTIFICATION
TIX SAVEF,1,2
LXA IR4,1
SAVEF SXD TXLF,1
CLA ADTRAD SET READ LOOP TO READ TRAD
STO COPY UPWARDS IN MEMORY. BUT
CLA CPTRAD KEEP TRACK OF WORD COUNT
STA CPTXI AS USUAL
LXA IR4,4
TRA RDREC
TRAD CLA ADTABL RESTORE COPY LOOP
STO COPY
CLA COPYAA
STA CPTXI
TXI SXDG,4,-1
SXDG SXD BETANB,4 SAVE NUMBER OF ENTRIES IN BETA TABLE
CLA 24 ADD ONE TO LAST TEIFNO
NOP GET LAST TEIFNO
ARS 18
STZ BETA
STA BETA
RTB 3
LXA IR4,2 READ IN TABLE OF NON EXECUTABLE
CPNON CPY 0 STATEMENTS AND SAVE
LXD 0,4 DECREMENT OF TABLE IN
TRA PXDH ADDRESS OF MEMORY
TRA SAVXNB
PXDH PXD 0,4
ARS 18
STO NONEXT,2
TXI CPNON,2,1
SAVXNB TIX SAVEH,2,1 SET END OF ENTRIES TEST
LXA IR4,2
SAVEH SXD TXLH,2 SET END OF ENTRIES TEST
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 214/214 ------
LXA IR4,1
CLAF CLA TIFGOT,1 SAVE ALPHA IN CASE OF ERROR, AND
ARS 18 ALSO TO PUT IN ALPHA TABLE AT
STA ALFA END OF PROCESSING EACH KIND OF TIFGO
CLA TIFGOT,1 DETERMINE KIND OF ENTRY
TMI TIFMI
PAX 0,2
TXL TIFZRO,2,0
TXL TIFGO1,2,1
TXL TIFGO2,2,2
TXL TIFGO3,2,3
TXL TIFGO4,2,4
TXL TIFGO5,2,5
TXL TIFGO6,2,6
LDQ TIFGOT,1 NOT IDENTIFYABLE, SAVE IN ERROR
WHATIF TSX ERROR,4 TABLE, BUT PUT ALPHA IN TABLE ANYWAY
NXTIFG LXD ALFANB,4 STORE ALPHA IN TABLE
CLA ALFA
STO ALPHA,4
TXI FSAVE,4,1
FSAVE SXD ALFANB,4
RETIF6 TXI TXLF,1,2 TYPE 6 TIFGO ENTRIES DO NOT GO IN
TXLF TXL CLAF,1,0 ALPHA TABLE
TRA STOPS WHEN TIFGO FINISHED, READ IN STOPS
TIFMI ANA ADDMSK
TNZ SAVEB1 IF BETA IS ZERO, THERE WAS NO ENTRY
MINB1 TSX NOBETA,4 CORRESPONDING TO IT IN COL 1 TO 5 OF
TRA NOWB2 SOURCE PROGRAM, SKIP REST OF PROCESSING
SAVEB1 TSX ISNONX,4 IF BETA IS NOT EXECUTABLE, DO NOT PUT IN
TMI NOWB2 BETA TABLE
TSX MORBTS,4
NOWB2 CLA TIFGOT-1,1
ARS 18
ANA ADDMSK
TNZ SAVEB2
MINB2 TSX NOBETA,4
TRA NOWB3
SAVEB2 TSX ISNONX,4
TMI NOWB3
TSX MORBTS,4
NOWB3 CLA TIFGOT-1,1
ANA ADDMSK
TNZ SAVEB3
MINB3 TSX NOBETA,4
TRA ALFAD1
SAVEB3 TSX ISNONX,4
TMI ALFAD1
TSX MORBTS,4
ALFAD1 CLA DECTRE
STD ALFA
TRA NXTIFG
TIFZRO CLA TIFGOT-1,1
ANA ADDMSK
TNZ TIFOB
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 215/215 ------
TSXTFO TSX NOBETA,4
TRA NEXTI KEEP TRACK OF NUMBER OF BETAS
TIFOB TSX ISNONX,4
TMI NEXTI
TSX MORBTS,4
NEXTI CLA TIFGOT-1,1 DO NOT PUT IN ALPHA TABLE IF
PDX 0,4 ENTRY BY IRV FOR SAP INSTRUCTIONS
TXH RETIF6,4,0
CLA DECONE
STD ALFA
TRA NXTIFG
TIFGO1 STZ TRADNB
CLAJ CLA TIFGOT-1,1 PREPARE TO READ RELATED TRAD ENTRIES
PDX 0,2
ALS 18
STD TXHJ
MORTR CLA TRADT+250,2
TNZ TRADX1
BTIFG1 TSX NOBETA,4
TRA ADDJ
TRADX1 TSX ISNONX,4 IF TRAD IS NON EXECUTABLE, MAKE ENTRY
TPL ADDJ FAIL ANY ALPHA PLUS 1 SEARCH LATER ON
CLA DECONE BY PUTING NUMBER IN DECFIELD
STD TRADT+250,2 BUT KEEP TRACK OF NUMBER OF BRANCHES GIVEN
ADDJ CLA TRADNB
ADD DECONE
STO TRADNB
TXI TXHJ,2,-1
TXHJ TXH MORTR,2,0
CLA TRADNB
STD ALFA
TRA NXTIFG
TIFGO2 STZ TRADNB
CLAK CLA TIFGOT-1,1
PDX 0,2
ALS 18
STD TXHK
MORTRD CLA TRADT+250,2
TNZ TRADX2
BTIFG2 TSX NOBETA,4
TRA ADDK
TRADX2 TSX ISNONX,4
TPL ADDK
CLA DECONE
STD TRADT+250,2
ADDK CLA TRADNB
ADD DECONE
STO TRADNB
TXI TXHK,2,-1
TXHK TXH MORTRD,2,0
CLA TRADNB
STD ALFA
TRA NXTIFG
TIFGO3 CLA TIFGOT-1,1
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 216/216 ------
ARS 18
ANA ADDMSK
TNZ TIF3B1
B1TIF3 TSX NOBETA,4
TRA NEXTL
TIF3B1 TSX ISNONX,4
TMI NEXTL
TSX MORBTS,4
NEXTL CLA TIFGOT-1*,1
ANA ADDMSK
TNZ TIF3B2
B2TIF3 TSX NOBETA,4
TRA ADDL
TIF3B2 TSX ISNONX,4
TMI ADDL
TSX MORBTS,4
ADDL CLA DECTWO
STD ALFA
TRA NXTIFG
TIFGO4 CLA TIFGOT-1,1
ARS 18
ANA ADDMSK
TNZ TIF4B1
B1TIF4 TSX NOBETA,4
TRA NEXTM
TIF4B1 TSX ISNONX,4
TMI NEXTM
TSX MORBTS,4
NEXTM CLA TIFGOT-1,1
ANA ADDMSK
TNZ TIF4B2
B2TIF4 TSX NOBETA,4
TRA ADDM
TIF4B2 TSX ISNONX,4
TMI ADDM
TSX MORBTS,4
ADDM CLA DECTWO
STD ALFA
TRA NXTIFG
TIFGO5 CLA TIFGOT-1,1
ARS 18
ANA ADDMSK
TNZ TIF5B1
B1TIF5 TSX NOBETA,4
TRA NEXTN
TIF5B1 TSX ISNONX,4
TMI NEXTN
TSX MORBTS,4
NEXTN CLA TIFGOT-1,1
ANA ADDMSK
TNZ TIF5B2
B2TIF5 TSX NOBETA,4
TRA ADDN
TIF5B2 TSX ISNONX,4
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 217/217 ------
TMI ADDN
TSX MORBTS,4
ADDN CLA DECTWO
STD ALFA
TRA NXTIFG
TIFGO6 CLA TIFGOT-1,1
ANA ADDMSK
TNZ RETIF6
TIF6B TSX NOBETA,4
TRA RETIF6
STOPS RTB 3
LXD ALFANB,1 LOAD NUMBER ALREADY IN ALPHA TABLE
CPSTOP CPY 0 READ TABLE OF STOPS INTO REST OF
LXD 0,4 ALPHA TABLE, PUT DECREMENT OF
TRA PDXP TAPE TABLE INTO ADDRESS OF MEMORY
TRA TIXP
PDXP PXD 0,4
ARS 18
STO ALPHA,1
TXI CPSTOP,1,1
TIXP TIX NEXTP,1,1
LXA IR4,1
NEXTP SXD ENDALF,1
SXD ALFANB,1
SXD FRETST,1
CLA CHNONX RESET ISNONX ROUTINE SO IT IS
STA YESNOX MERELY INFORMATIVE AND DOES NOT
LXA IR4,1 MAKE ENTRIES IN ERROR TABLE
CLAQ CLA ALPHA,1
QADD TRA PAQADD
ADDQ STZ ALFA
STA ALFA
LXA IR4,2
NXTBTA CLA BETA,2
CAS ALFA
TRA NEXTQ
TRA NXTALF
NEXTQ TXI BETANB,2,-1
BETANB TXH NXTBTA,2,0
CLA ALFA
TSX ISNONX,4 IF ALPHA PLUS 1 IN NONX, THEN LOOK IN BETA
TMI ALAND1 TABLE FOR ALPHA +2 ETC
NOTRA TSX NOBETA,4 NOT EITHER TABLE, PART OF PROG NOT ENTERED
NXTALF TXI ENDALF,1,1
ENDALF TXL CLAQ,1,0
TRA RDREC
ALAND1 CLA ALFA
TRA QADD
TDO TXL SPACES,1,0
TIX SAVES,1,5 INITIALIZE END OF ENTRIES TEST
LXA IR4,1
SAVES SXD TXLS,1
LXA IR4,1
CLADO CLA TABLE,1
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 218/218 ------
ANA TAGMSK SAVE TAG FIELD FOR PROCESSING N1,N2,N3
ALS 18
STP DOTAG
CLA TABLE,1 SAVE ALPHA IN CASE OF ERROR
ARS 18
STA ALFA
CLA TABLE,1
ANA ADDMSK
TNZ BINTIF
DONOBT TSX NOBETA,4
TRA DOALF
BINTIF LXA IR4,2 IS BETA IN DO TABLE A CONDITIONAL
STO DOBETA TRANSFER, THAT IS, IS IT IN ALPHA TABLE
SCLA CLA ALPHA,2
ANA ADDMSK MASK OUT NUMBER OF BRANCHES
CAS DOBETA
TRA TIXS
TRA CONBET THIS IS AN ERROR
TIXS TXI ALFANB,2,1
ALFANB TXL SCLA,2,0
CLA DOBETA
TSX ISNONX,4
TPL DOALF IF BETA IN TO IS NON EXECUTABLE THIS
DOBTNX TSX NOBETA,4
TSX ADOB,4
DOALF CLA ALFA
ANA ADDMSK CLEAR ANY HASH LEFT FROM ERROR RECODING
ADD ADDONE
TSX ISNONX,4 IF ALPHA PLUS 1 IS NON EXECUTABLE
TPL DOSYMB THIS IS ERROR
DOALNX TSX NOBETA,4
TSX ADOB,4
DOSYMB LDQ TABLE-1,1 DOES SYMBOL CONTAIN ANY ILLEGAL
PUNSYM TSX CHECKA,4 PUNCTUATION
TPL IJKSYM
TSX ADOB,4
IJKSYM TSX CHECKB,4 DOES SYMBOL BEGIN WITH IJKLM OR N
TPL NL
TSX ADOB,4
NL CAL DOTAG
PBT
TRA N2+1 NO
LDQ TABLE-2,1 YES
PUNN1 TSX CHECKA,4
TPL IJKN1
TSX ADOB,4
IJKN1 TSX CHECKB,4
TPL N2
TSX ADOB,4
N2 CAL DOTAG
ALS 1
PBT
TRA N3
LDQ TABLE-3,1
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 219/219 ------
PUNN2 TSX CHECKA,4
TPL IJKN2
TSX ADOB,4
IJKN2 TSX CHECKB,4
TPL N3
TSX ADOB,4
N3 CAL DOTAG
ALS 2
PBT
TRA NXTDO
LDQ TABLE-4,1
PUNN3 TSX CHECKA,4
TPL IJKN3
TSX ADOB,4
IJKN3 TSX CHECKB,4
TPL NXTDO
TSX ADOB,4
NXTDO TXI TXLS,1,5
TXLS TXL CLADO,1,0
SPACES RTB 2 SPACE OVER FORVAL
RTB 2 SPACE OVER FORVAR
RTB 2 SPACE OVER FORTAG
TRA RDREC
CONBET TSX NOBETA,4
TSX ADOB,4
TRA DOALF AND TEST ALPHA
FRET TXL RDREC,1,2 GO THRO THIS TABLE FROM LAST TO FIRST
NEXTT LXA IR4,2
CLAT CLA TABLE+1,1
TMI NEWFRT
TXI TNEXT,2,1
TNEXT TIX CLAT,1,1 WILL NOT FAIL BEFORE THE TMI
NEWFRT SXD FRETNB,2 SAVE NUMBER OF FREQUENCIES
ANA ADDMSK
STO ALFA FREQUENCY OF BETA IS IGNORED BY
TNZ BRANCH FORTRAN IF NO CORRESPONDING BETA IN
TRA NXTFRT COLUMN 1 TO 5 OF SOURCE PROGRAM
BRANCH LXA IR4,4
TCLAT CLA ALPHA,4
ANA ADDMSK
CAS ALFA
TRA TIXT
TRA HAVALF
TIXT TXI FRETST,4,1
FRETST TXL TCLAT,4,0 SET AT END OF READING IN STOP TABLE
TRA NXTFRT
HAVALF CLA ALPHA,4 THE ONLY TIME A FREQUENCY STATEMENT CAN
ANA DECMSK LOUSE UP THE OBJECT PROGRAM IS WHEN
SUB FRETNB THERE ARE MORE FREQUENCIES GIVEN THAN
TPL NXTFRT BRANCHES.
FRETIF TSX NOBETA,4
NXTFRT TIX NEXTT,1,1
TRA RDREC
EQUIV CLA TABLE FIRST WORD IN TABLE WILL BE 35 ONES
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 220/220 ------
SUB MSK35 IF THERE HAVE BEEN INCONSISTANT
TNZ DIAGND
LXA IR4,1
NXTEQV CLA TABLE-1,1
SUB MSK35 LAST INCONSISTANCY IS FOLLOWED BY
TZE DIAGND ANOTHER WORD OF ONES
LDQ TABLE-1,1
NOTEQV TSX ERROR,4
TXI NXTEQV,1,1
DIAGND CLA ERNBR
TZE SPACE2 IF NO ERROR, READ IN SECTION II
STO 24 SAVE FOR BIG D
CLA TW13 PUT RECORD NUMBER IN 2 FOR PRINT OUT
STO 2
LXA IR4,2
DIAGRD RTD 1 SPACE OVER REST OF SYSTEM IN FORTRAN
CPY 0
TRA DIAGRD
TXI TST2FL,2,1
TST2FL TXL DIAGRD,2,1
RTB 1 END FILE SKIP, START TO READ BIG D
LXA IR4,1
DCPY CPY 25,1
TXI DCPY,1,-1
NOP
BIGD TSX 26,4
REW NOP REPLACED BY SPACE2 AT 1263. WAS REWIND
NOP
REM ENTER WITH AC ZERO. EXIT WITH TSX FROM TABLE
REM WHICH HAS MISSING BETA, IN DEC OF AC AND
REM ALPHA IN ADDRESS OF AC.
NOBETA SXD ALFA,4
TSX SAVALF,4
LXD ALFA,4
TRA 1,4
REM ENTER WITH HASH IN AC. EXIT WITH CONTENTS OF ALPHA IN AC
SAVALF SXD ERAS,4
LXD ERNBR,4
CLA ALFA
STO ERLIST,4
TXI NEXTA,4,1 SAME RETURN AS ERROR ROUTINE.
REM ENTER WITH MQ=BCD SYMBOL OR HASH,0, ALPHA
REM MAKES 2 WORD ENTRY IN ERROR LIST
REM 1...KIND OF ERROR,0, TABLE IN WHICH ERROR FOUND
REM 2...CONTENTS OF MQ
REM EXIT AC HASH, MQ NOT CHANGED
ERROR PXD 0,4 PUT TSX FROM SECTION SCANNING
LXD ERNBR,4 FOR ERROR, IN DEC OF 1ST WORD
STD ERAS
STD ERLIST,4
CLA IR4 PUT TSX FROM DABLE IN WHI+H
ARS 18 ERROR WAS FOUND, IN ADDR. OF 1ST WORD
STA ERLIST,4
STQ ERLIST-1,4 PUT MQ IN 2ND WORD
REM ------ SCANNED 10/8/06 304349-VOLUME_I.PDF PAGE 221/221 ------
TXI NEXTA,4,2
NEXTA SXD ERNBR,4
LXD ERAS,4
TRA 1,4
REM ENTER WITH AC ALL ZERO, EXCEPT ADDRESS WHICH HAS BETA
REM FROM TIFGO OR TDO, OR ALPHA+1 FROM SAME. EXIT SAME, EXCEPT
REM WHERE MATCH IS FOUND, THEN AC HAS HASH
ISNONX SXD IR4,4 ERROR WILL RECORD WHICH TABLE WAS SCANNED
TRA PATS2
CASH CAS NONEXT,2
TRA NEXTH
YESNOX TRA NONEXB THIS WILL BE CHANGED TO BYPASS ERROR WHEN
NEXTH TXI TXLH,2,1 SCANNING BETA TABLE
TXLH TXL CASH,2,0
TRA PATRE2
NONEXB ALS 18 ERROR, SAVE BETA AND ALPHA IN LIST
STD ALFA
LDQ ALFA
TSXH TSX ERROR,4
INFORM LXD IR4,4
SSM SET RETURN TO SHOW ERROR
TRA PATRE2
REM ENTER WITH HASH IN AC MQ HAS BCD SYMBOL. EXIT WITH HASH IN
REM AC AMD MQ, SYMBOL IS STORED IN NAME. DC IS MINUS ONLY WHEN
REM ILLEGAL CHARACTER PRESENT
CHECKA STQ NAME
SXD IR4,4
SXD IR2,2
SXD IR1,1
LXD SYMBL,1 6 INTO IR1
NXTNAM LXA SYMBL,2 10 INTO IR2
PXD 0,0 CLEAR AC AND COMPARE NEXT BCD
LGL 6 CHARACTER WITH TABLE OF ILLEGAL SYMBOLS
ACAS CAS SYMBL,2
TRA ATIX
TRA WRONG
ATIX TIX ACAS,2,1 GET NEXT ILLEGAL SYMBOL FOR COMPARISON
TIX NXTNAM,1,1 GET NEXT BCD CHARACTER FOR COMPARISON
RETNA LXD IR4,4
LXD IR2,2
LXD IR1,1
TRA 1,4
WRONG LDQ NAME
CHATSX TSX ERROR,4
SSM SIGNAL THAT ERROR HAS BEEN PICKED UP
TRA RETNA
REM ENTER WITH HASH IN AC + MQ, EXIT SAME EXCEPT WHERE NO MATCH
REM THEN MINUS
CHECKB LDQ NAME
SXD IR4,4
LXA IJK,4
PXD 0,0
LGL 6
BCAS CAS IJK,4
REM ------ SCANNED 10/8/06 304349-VOLUME_I.PDF PAGE 222/222 ------
TRA BTIX
TRA RETNB
BTIX TIX BCAS,4,1
LDQ NAME
CHBTSX TSX ERROR,4
SSM
RETNB LXD IR4,4
TRA 1,4
REM ENTER WITH BETA FROM TIFGO ENTRIES WHICH ARE MINUS OR HAVE 0,
REM 3,4,5 OR 6 IN ADDRESS OF 1ST WORD. TIFGO 1 AND 2 ARE ALREADY
REM IN BETA TABLE. EXIT WITH SAME.
MORBTS SXD ERAS,4
LXD BETANB,4
STOBET STO BETA,4
TXI STBET,4,-1
STBET SXD BETANB,4
SXD BETANB,4
LXD ERAS,4
TRA 1,4
ADOB SXD ERAS,4
LXD ERNBR,4
CLA TABLE,1
STO ERLIST,4
CLA TABLE-1,1
STO ERLIST-1,4
TXI NEXTA,4,2
IR1 HTR
IR2 HTR 2
IR4 HTR 0
ADDONE HTR 1
DECONE HTR 0,0,1
DECTWO HTR 0,0,2
DECTRE HTR 0,0,3
ADDMSK OCT 000000077777
TAGMSK OCT 000000700000
DECMSK OCT 077777000000
MSK35 OCT 377777777777
ADTABL CPY TABLE,1
ADTIFG HTR TIFGOT
ADTRAD CPY TRADT,4
CPTRAD HTR COPYAA
CHNONX HTR INFORM
ALFA
TW13 HTR 213
TRADNB
ERNBR
IDENT
WDCONT
NAME
ERAS
XERAS
BST STORE NUMBER OF TIMES WORD COUNT WRONG
BSTA DITTO IDENTIFICATION
DOTAG
REM ------ SCANNED 10/8/06 304349-VOLUME_I.PDF PAGE 223/223 ------
DOBETA
NOP NOP
FRETNB
BCD 100000I
BCD 100000K
BCD 100000J
BCD 100000L
BCD 100000M
BCD 100000N
IJK HTR 6,0,0
BCD 100000+
OCT 000000000014 OTHER MINUS SIGN
BCD 100000
BCD 100000/
BCD 100000$
BCD 100000(
BCD 100000)
BCD 100000=
BCD 100000,
BCD 100000.
BCD 100000*
SYMBL HTR 11,0,6
AFTRSZ HTR IDNTFY
OCT 000000000013
HTR SUBARG
OCT 000000000014
HTR UPPER
OCT 000000000000
HTR TEIFNO
OCT 000000000002
HTR TIFGO
OCT 000000000003
HTR TRAD
OCT 000000000001
HTR TDO
OCT 000000000007
HTR FRET
OCT 000000000010
HTR EQUIV
TAPTAB HTR 16
PTCH TIX SZW,1,1 SIZ TABLE HAS CHECK SUM ENTRY NOT
SZW PXD 0,1 NOT INCLUDED IN WORD COUNT
ARS 18
TRA SUBWDS
PATIF CLA ADTABL
STO COPY
TRA NOTIFG
SPACE2 RTB 2
RTB 2
IOD
RTT
NOP
TRA 4
PAQADD TZE NXTALF
REM ------ SCANNED 10/8/06 304349-VOLUME_I.PDF PAGE 224/224 ------
ADD ADDONE
TRA ADDQ
PATS2 SXD PATERA,2
LXA IR4,2
TRA CASH
PATRE2 LXD PATERA,2
TRA 1,4
PATERA
END
REM BLOCK ONE OF SECTION TWO.
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 221/225 ------
REM BLOCK ONE OF SECTION TWO.
REM MASTER RECORD CARD = FN027 F2100000
REM BLOCK ONE OF SECTION TWO PERFORMS THE F2100001
REM PRELIMINARY DO NEST STRUCTURE ANALYSIS F2100002
REM REQUIRED FOR THE SUCCEEDING BLOCKS. IT AXSIGNS F2100003
REM LEVEL NUMBERS AND THE P0SSIBILITY OF CARRY. F2100004
REM TRANSFERS OUT OF THE RANGE OF DOS ARE NOTED AND ENTERED F2100005
REM INTO TABLE TRALEV. IF THERE IS A VARIABLE F2100006
REM PARAMETER OF A DO ITS HIGHEST LEVEL OF DEFINITION F2100007
REM IS ASSIGNED. F2100008
REM FINALLY, A SEARCH IS MADE T0 DETERMINE F2100009
REM WHETHER A DO INDEX COUNTER IS F2100010
REM NECESSARY T0 KEEP CURRENT THE VALUES F2100011
REM OF THE DO INDEX. F2100012
ORG 25 F2100015
DOTAG BSS 1 F2100017
BSS 1349 F2100020
DOTAGZ BSS 1 F2100030
TIFGO BSS 1 F2100040
BSS 599 F2100050
TIFZ BSS 1 F2100060
TRAD BSS 1 F2100070
BSS 249 F2100080
TRADZ BSS 1 F2100090
TRALEV BSS 1 F2100100
BSS 599 F2100110
TLTZ BSS 1 F2100120
ORG 1376 F2100130
FORVAL BSS 1 F2100140
BSS 999 F2100150
4VALZ BSS 1 F2100160
ORG 1376 F2100170
FORVAR BSS 1 F2100180
BSS 1499 F2100190
4VARZ BSS 1 F2100200
ORG 476 F2100210
FORTAG BSS 1 F2100211
BSS 1499 F2100230
FORTZ BSS 1 F2100240
REM PROGRAM C ONSTANTS F2100250
ORG 2876 F2100260
L(0) 0,0,0 F2100270
L(1) 0,0,1 F2100280
L(2) 0,0,2 F2100290
L(3) 0,0,3 F2100300
L(4) 0,0,4 F2100310
L(5) 0,0,5 F2100320
L(6) 0,0,6 F2100330
L(9) 0,0,9 F2100340
L(600) 0,0,600 F2100350
L(1000 0,0,1000 F2100360
L(1350 0,0,1350 F2100370
L(1500 0,0,1500 F2100380
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 222/226 ------
L(MZ) MZE F2100390
BITONE OCT 200000000000 F2100400
BITTWO OCT 100000000000 F2100410
DECADD OCT 77777077777 F2100420
DECMSK OCT 77777000000 F2100430
TAGMSK OCT 700000 F2100440
ADDMSK OCT 77777 F2100450
NCMSK OCT -377777477777 F2100460
CR1 OCT 100000 F2100470
CR2 OCT 200000 F2100480
REM BEGIN BLO CK ONE. F2100490
TAP00 REW 148 F2100500
REW 147 F2100510
RTT F2100520
NOP F2100530
BST TTAPE POSITION TAPE TWO F2100540
LXD L(9),1 FOR READING IN TAPE F2100550
TAP10 BST TTAPE TABLES F2100560
TIX TAP10,1,1 F2100570
PSE 96 ALL LIGHTS OFF F2100580
PSE 98 TRALEV LIGHT 98 ON F2100590
LXD L(2),2 READ F2100600
CLA TIFAD IN F2100610
TSX RTAPE,4 TIEFGO F2100620
SXD TIFGO-1,1 SAVE NEXT UNUSED INDEX F2100630
LXD L(3),2 READ F2100640
CLA TRADAD IN F2100650
TSX RTAPE,4 TRAD F2100660
SXD TRAD-1,1 SAVE NEXT UNUSED INDEX F2100670
LXD L(1),2 READ F2100680
CLA DOAD IN F2100690
TSX RTAPE,4 TDO WITH DOTAG FORMAT F2100700
SXD DOTAG-1,1 SAVE NEXT UNUSED INDEX F2100710
TXL MR00,1,1349 TEST FOR EMPTY DOTAG F2100720
PSE 99 DOTAG EMPTY F2100730
TRA TS4VAL F2100740
REM MR00 COMPUTES LEVEL, X, CARRY BITS. F2100750
MR00 LXD DOTAG-1,1 INITIALIZE TEST F2100760
SXD MR70,1 INSTRUCTION. F2100770
LXD L(1350,1 INITIALIZE XRA TO MAX DOTAG. F2100780
MR05 CLA L(1) INITIALIZE LEVEL TO ONE F2100790
MR10 PDX 0,2 PUT LEVEL IN XRB F2100800
STO DOTAGZ+5,1 STORE LEVEL IN L WORD F2100810
CLA DOTAGZ,1 INSPECT TAG OF FIRST WORD) F2100820
SXD MR14,4 F2100830
PAX 0,4 F2100840
STD MR12 F2100850
MR12 TXH MR15,4 F2100860
TRA ERBETA BETA LESS THAN OR EQUAL TO ALPHA F2100871
MR14 HTR F2100880
MR15 LXD MR14,4 F2100890
ANA TAGMSK IF ZERO( TRA TO MR20) F2100900
TZE MR20 IF NOT ZERO( PUT BIT F2100910
CLA BITTWO IN L WORD FOR X NOT F2100920
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 223/227 ------
ORS DOTAGZ+5,1 COMPUTABLE AND GO TO F2100930
TRA MR60 END. F2100940
MR20 CLA DOTAGZ+3,1 COMPUTE X AND STORE IN F2100950
SUB DOTAGZ+2,1 L WORD F2100960
ADD DOTAGZ+4,1 F2100970
LRS 35 F2100980
DVH DOTAGZ+4,1 F2100990
MPY DOTAGZ+4,1 F2101000
LLS 35 F2101010
STA DOTAGZ+5,1 F2101020
TXL MR60,2,1 IF L IS ONE( SKIP CARRY TEST) F2101030
CLA DOTAGZ,4 OBTAIN NEXT BACK.SUBNEST F2101040
ARS 15 DO( FIRST WORD. IN-SPECT TAG F2101050
LBT FOR VARIABLE N3) IF NOT. F2101060
TRA MR30 0) VARIABLE( CONTINUE-WITH MR30, F2101070
TRA MR60 1) OTHERWISE GO TO END. F2101080
MR30 CLA DOTAGZ,4 OBTAIN FIRST WORD OF NEXT F2101090
ANA DECADD BACK SUBNEST DO, REMOVE F2101100
ADD L(1) TAG, AND ADD ONE TO ALPHA. F2101110
SUB DOTAGZ,1 SUB FIRST WORD CURRENT DO. F2101120
TNZ MR40 (TAG IS ZERO). IF RESULT IS F2101130
CLA CR1 ZERO, CARRY IS TYPE ONE, F2101140
TRA MR50 IF NOT ZERO, CARRY IS TYPE F2101150
MR40 CLA CR2 TWO. INDICATE TYPE IN F2101160
MR50 ORS DOTAGZ+5,1 L WORD OF CURRENT DA. F2101170
MR60 PXD 0,1 MAKE CURRENT.DO NEXT BACK F2101180
PDX 0,4 SUBNEST DO. F2101190
TXI MR70,1,-9 TAKE NEXT DO IN DOTAG. F2101200
MR70 TXL ERTST,1,0 NO MORE DOS, EXIT TO TEST IF ERRORS F2101211
CLA DOTAGZ,1 OBTAIN FIRST WORD NEW DO. F2101220
ANA ADDMSK OBTAIN BETA F2101230
STO MRES AND SAVE F2101240
MR75 CLA DOTAGZ,4 OBTAIN BETA OF XRC DO, F2101250
ANA ADDMSK AND SUBTRCT NEW BETA.. F2101260
STO MRES1 F2101270
SUB MRES IF NOT NEGATIVE, XRC DD F2101280
TMI MR80 CONTAINS NEW DO. OTHERWISE, TRA F2101290
CLA DOTAGZ+5,4 XRC DO CONTAINS NEW DO, F2101300
ANA DECMSK OBTAIN LEVEL OF XRC DO, F2101310
ADD L(1) ADD ONE, STORE IN L. F2101320
TRA MR10 GO TO MR10 F2101330
MR80 CLA DOTAGZ,1 F2101340
ANA DECMSK F2101350
ARS 18 F2101360
CAS MRES1 F2101370
TRA MR85 ALPHA(XRA) GREATER THAN BETA(XRC) F2101380
TRA ERLIST EQUALITY F2101391
TRA ERLIST LESS THAN F2101401
MR85 CLA DOTAGZ+5,4 F2101410
PDX 0,2 NEWDO. IF XRL DO IS OF F2101420
TXL MR05,2,1 LEVEL ONE, START NEW NEST F2101430
TXI MR75,4,9 BY TRA TO MR05. ELSE TRA MR75, F2101440
MRES HTR ES F2101450
MRES1 HTR F2101460
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 224/228 ------
REM FLOW, TRANSFER ANALYS1S, F2101470
FLOW LXD TIFGO-1,4 TEST FOR EMPTY TIFGO F2101480
TXH SV00,4,599 F2101490
LXD DOTAG-1,1 INITIALIZE F2101500
SXD FLO30,1 TEST F2101510
SXD FLO60,4 INSTRUCTIONS F2101520
SXD ADL60,1 F2101530
SXD INC40,1 F2101540
SXD RNC70,1 F2101550
LXA TLT50,1 INITIALIZE TRALEV F2101560
SXD TLT50,1 INDEX VALUE F2101570
FLO10 LXD L(600),4 INIT1ALIZE F2101580
SXD TIFX,4 CURRENT TIFGO INDEX F2101590
LXD L(1350,1 INITIALIZE XRA, DOTAG INDEX F2101600
FLO15 CLA DOTAGZ+5,1 OBTAIN LEVEL OF DO F2101610
PDX 0,2 AND F2101620
TXL FLO40,2,1 TRA IF LEVEL ONE. IF NOT F2101630
FLO20 TXI FLO30,1,-9 LEVEL ONE, FIND NEXT F2101640
FLO30 TXH FLO15,1 LEVEL ONE, IF ANY. F2101650
TRA FLOEND F2101660
FLO40 SXD BNX,1 SAVE BEGINNING 0O NEST INDEX. F2101670
CLA DOTAGZ,1 INITIALIZE F2101680
PAX 0,2 BEGINNING OF NEST F2101690
ANA DECMSK AND F2101700
STO BNA END OF NEST F2101710
PXD 0,2 ADDRESSES F2101720
STO ENA F2101730
LXD TIFX,4 OBTAIN CURRENT T1FGO INDEX F2101740
FLO50 CLA TIFZ,4 AND SEARCH FOR TIFGO F2101750
ANA DECMSK ENTRY IN NEST. F2101760
CAS BNA COMPARE WITH BNA F2101770
TRA FLO70 GREATER THAN OR EQUAL TO F2101780
TSX DIAG,4 BNA, MAY BE IN NEST. ERROR. GO TO DIAGNOSTIC. F2101795
FLO55 TXI FLO60,4,-2 LESS THAN BNA, GO BACK F2101800
FLO60 TXH FLO50,4 FOR NEXT TIFGO ENTRY, F2101810
TRA FLOEND IF ANY. IF NONE, EXIT F2101820
FLO65 LXD BNX,1 F2101830
TRA FLO20 F2101840
FLO70 SXD TIFX,4 SAVE CURRENT TIFGO INDEX F2101850
CAS ENA COMPARE G AND ENA F2101860
TRA FLO65 G GREATER, GO BACK FOR NEXT NEST. F2101870
NOP G EQUAL TO F2101880
STO G OR LESS THAN G, SAVE G. F2101890
CLA TIFZ,4 TEST FOR THREE ADDRESS IF. F2101900
TMI FLO75 USE ADDRESS TO DETERMINE F2101910
PAX 0,2 WHETHER OR NOT THIS IS AN F2101920
TXL FLO75,2,5 ASSIGN FORMULA. IF IT IS, F2101930
TXL FLO55,2,6 IGNORE, TAKE NEXT TIFGO ENTRY F2101940
TXL FLO75,2,7 TEST FOR ADD. GREATER THAN F2101950
TSX DIAG,4 SEVEN. ERROr. GO TO DIAGN0STIC. F2101965
FLO75 CLA G OBTAIN G F2101970
LXD BNX,1 OBTAIN CURRENT NEST INDEX F2101980
TSX ADLOC,4 OBTAIN XDG AND LDG F2101990
CLA BITONE PUT BIT IN DOTAG FOR TRA F2102000
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 225/229 ------
ORS DOTAGZ+6,1 IN IMMEDIATE RANGE. F2102010
PXD 0,1 SAVE F2102020
STO XDG XDG F2102030
PXD 0,2 AND F2102040
STO LDG LDG F2102050
CLS G LIST MINUS G F2102060
TSX TLT00,4 IN TRALEV BUFFER. F2102070
LXD TIFX,4 OBTAIN FIRST WORD OF F2102080
CLA TIFZ,4 TIFGO ENTRY F2102090
TMI 3ADIF TRA IF 3ADIF F2102100
PAX 0,2 PUT ADDRESS IN XRB F2102110
FLO80 TRA FLO80+8,2 INDEXED TRA, F2102120
TSX DIAG,4 7, R0YS TRA. ERROR, GO TO DIAGNOSTIC. F2102135
TSX DIAG,4 6, ASSIGN FORMULA ERROR. GO TO DIAGNOSTIC. F2102145
TRA 2ADIF 5, 2 ADDRESS TYPE F2102150
TRA 2ADIF 4, 2 ADIF F2102160
TRA 2ADIF 3, 2ADIF F2102170
TRA GOTOVN 2 VECTOR TYPE TRA F2102180
TRA GOTOVN 1 GO TO N (ASSIGN) F2102190
TRA GOTOK 0 GO TO CONSTANT F2102200
FLO90 LXD TIFX,4 GO BACK FOR NEXT F2102210
TXI FLO60,4,-2 TIFGO ENTRY, F2102220
FLOEND LXD TLT50,1 TEST IF ANY TRALEV ENTRIES F2102230
TXH SV00,1,599 F2102240
TSX TLT20,4 IF SO, GO TO WRITE ROUTINE F2102250
TRA SV00 F2102260
REM CONTROL ROUTINES F2102270
3ADIF ANA ADDMSK THE FOLLOWING ROUTINES F2102280
ALS 18 ARRANGE TO PROCESS ALL OF F2102290
TSX FA000,4 THE ADDRESSES ASSOCIATED F2102300
LXD TIFX,4 WITH THE TIFGO ENTRY, F2102310
2ADIF CLA TIFZ+1,4 ONE AT A TIME. F2102320
ANA DECMSK WHEN ALL ADDRESSES F2102330
TSX FA000,4 ARE PR0CESSED, F2102340
LXD TIFX,4 CONTR0L IS RETURED TO F2102350
GOTOK CLA TIFZ+1,4 FLO90 FOR NEXT F2102360
ANA ADDMSK TIFGO ENTRY. F2102370
ALS 18 F2102380
TSX FA000,4 F2102390
TRA FLO90 F2102400
GOTOVN CLA TIFZ+1,4 FOR GOTOV TRANSFERS, F2102410
PAX 0,4 USE WORD TWO F2102420
SXD GTV20,4 FOR INDEXING F2102430
PDX 0,4 VALUES NECESSARY F2102440
TRA GTV20 F2102450
GTV10 CLA TRADZ,4 TO GET ADDRESSES F2102460
ALS 18 FR0M TABLE TRAD. F2102470
SXD GTV30,4 FOR GOTON (ASSIGN) TYPE F2102480
TSX FA000,4 TRANSFERS, ALL ADDRESSES F2102490
LXD GTV30,4 MUST BE PROCESSED EVEN F2102500
TXI GTV20,4,-1 THOUGH THEY ARE ON SAME F2102510
GTV20 TXH GTV10,4 LEVEL BECAUSE OF F2102520
GTV30 TXL FLO90,0 CARRY RESTRICTIONS. F2102530
REM ANALYSIS OF ADDRESS F2102540
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 226/230 ------
FA000 SXD RS60,4 SAVE TSX SET F2102550
STO A SAVE ADDRESS F2102560
LXD BNX,1 OBTAIN F2102570
TSX ADLOC,4 INDEX OF DO CONTAINING F2102580
PXD 0,1 ADDRESS AND LEVEL OF F2102590
STO XDA THAT DO. F2102600
PXD 0,2 SAVE IN F2102610
STO LDA XDA AND LDA. F2102620
TXL FA010,2,20 TEST LEVEL F2102630
TSX DIAG,4 LEV. ADD OF TRA EXCEEDS 20. ERROr. GO TO DIAGNOSTIC. F2102645
FA010 ARS 18 F2102650
STA FA020 TRANSFER F2102660
CAL L(MZ) LEVEL IN F2102670
LXD XDG,1 XDG DO. F2102680
FA020 ARS F2102690
ORS DOTAGZ+7,1 F2102700
CLA LDA LIST F2102710
ARS 18 ADDRESS AND LEVEL F2102720
ADD A IN F2102730
TSX TLT00,4 TLT. CONTINUE WITH RS00 F2102740
REM TRANSFER BIT INSERTION IN DO FORMULA F2102750
RS00 LXD XDG,1 XRA CONTAINS XDG F2102760
LXD LDG,2 XRB CONTAINS LDG F2102770
RS10 PXD 0,2 IF G AND A IN SAME DO, F2102780
SUB LDA EXIT. THIS ROUTINE INSERTS F2102790
TZE INC00 BIT MEANING THERE IS A JUMP F2102800
TPL RS20 OUT OF THE RANGE OF THIS DO. F2102810
TSX DIAG,4 JUMP INTO HIGHER LEVEL. ERROr. GO TO DIAGNOSTIC. F2102825
RS20 CAL L(MZ) F2102830
ORS DOTAGZ+5,1 F2102840
TXL INC00,2,1 FIND NEXT BACK SUBNEST F2102850
RS30 TXI RS40,1,9 DO FORMULA F2102860
RS40 CLA DOTAGZ+5,1 AND RETURN F2102870
STD RS50 TO TEST F2102880
RS50 TXL RS30,2 LEVEL F2102890
PDX 0,2 AT F2102900
RS60 TXL RS10,0 RS10 F2102910
REM INDEXING NO CARRY CONDITION F2102920
INC00 CLA LDA EXIT IF F2102930
TZE RNC00 LDA IS ZERO. F2102940
CLA G PLACE G ANDA F2102950
LDQ A IN F2102960
TLQ INC20 INCX AND INCY SO THAT F2102970
STO INCX INCX IS LESS THAN INCY. F2102980
STQ INCY F2102990
TRA INC30 F2103000
INC20 STQ INCX F2103010
STO INCY F2103020
INC30 LXD XDA,1 INITIALIZE XRA F2103030
INC35 TXI INC40,1,-9 FIND DO OF LEVEL LDA F2103040
INC40 TXL RNC00,1 PLUS ONE. F2103050
CLA DOTAGZ+5,1 F2103060
ANA DECMSK F2103070
SUB LDA F2103080
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 227/231 ------
SUB L(1) F2103090
TZE INC50 DO OF LEVEL LDA PLUS ONE FOUND. F2103100
TPL INC35 LEVEL TO HIGH, GO BACK. F2103110
TRA RNC00 LEVEL TO LOW, DA EXHAUSTED. F2103120
INC50 CLA DOTAGZ,1 OBTAIN BETA OF F2103130
PAX 0,2 THIS DO IN DECREMENT. F2103140
PXD 0,2 F2103150
CAS INCY COMPARE WITH INCY. F2103160
TRA RNC00 GREATER THAN OR EQUAL TO F2103170
TRA RNC00 GREATEST OF G, A, EXIT. F2103180
CAS INCX LESS THAN INCY, COMPARE F2103190
TRA INC60 WITH INCX. GREATER THAN F2103200
TRA INC60 OR EQUAL TO INCX, GO TO INC60. F2103210
TRA INC35 LESS THAN INCX, GET NEXT DO. F2103220
INC60 CAL NCMSK AND OUT CARRY BITS. F2103230
ANS DOTAGZ+5,1 F2103240
TRA INC35 GO BACK FOR NEXT DO. F2103250
INCX HTR ES. F2103260
INCY HTR ES. F2103270
REM RESET NO CARRY CONDITION. NO CARRY TRANSFER LEVEL F2103280
RNC00 CLA LDA EXIT IF LDA IS ZERO F2103290
TZE RNC95 F2103300
CLA LDG EXIT IF F2103310
SUB LDA LDA EQUALS F2103320
TZE RNC95 LDG F2103330
PDX 0,4 INITIALIZE COUNTER XR6 F2103340
LXD XDG,1 INITIALIZE XRA F2103350
CLA LDG AND F2103360
PDX 0,2 XRB. C(ACC) LDG. F2103370
TXI RNC50,2,1 C(XRB) LDG PLUS ONE. F2103380
RNC20 TXI RNC30,1,9 FIND NEXT BACKS F2103390
RNC30 TXH RNC95,1,1350 SUBNESTDO. F2103400
CLA DOTAGZ+5,1 F2103410
STD RNC40 F2103420
RNC40 TXL RNC20,2 F2103430
RNC50 SXD RNC75,1 SAVE XRA F2103440
STD RNC85 SAVE LEVEL OF THIS DO F2103450
PXD 0,2 SAVE LEVEL OF NEXT INNER F2103460
STO RNC90 SUBNEST DO. F2103470
RNC60 TXI RNC70,1,-9 TAKE NEXT DOWN DO IF ANY. F2103480
RNC70 TXL RNC80,1 F2103490
CLA DOTAGZ,1 IF BETA F2103500
ANA ADDMSK OF THIS DO F2103510
ALS 18 IS LESS F2103520
SUB G THAN G, F2103530
TPL RNC80 TEST LEVEL F2103540
CLA DOTAGZ+5,1 TO SEE IF F2103550
ANA DECMSK THIS DO IS OF SAME F2103560
SUB RNC90 LEVEL AS NEXT INNERMOST F2103570
TNZ RNC60 SUBNEST DO. IF NOT, GET NEXT DO. F2103580
CLA DOTAGZ+6,1 IF SO, MAKE NO CARRY F2103590
ANA DECMSK TRANSFER LEVEL OF THIS F2103600
SUB LDA DO EQUAL TO GREATER F2103610
TPL RNC60 OF PREVIOUS VALUE F2103620
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 228/232 ------
CLA LDA AND CURRENT LDA. F2103630
STD DOTAGZ+6,1 F2103640
RNC75 TXL RNC60,0 GO BACK FOR NEXT TEST DO F2103650
RNC80 LXD RNC75,1 GO BACK FOR NEXT SUBNEST DO, F2103660
LXD RNC85,2 IF COUNTER PERMITS. F2103670
TIX RNC20,4,1 OTHERWISE, EXIT. F2103680
RNC85 TXL RNC95,0 F2103690
RNC90 HTR ES F2103700
RNC95 LXD RS60,4 GO BACK TO CONTROL ROUTINE F2103710
TRA 1,4 FOR NEXT ADDRESS. F2103720
REM INDEX AND LEVEL OF ADDRESS F2103730
ADLOC SXD ADL20,4 SAVE TSX SET F2103740
LXD L(0),4 INITIALIZE XRC, F2103750
SXD ADL30,4 AND DEC OF ADL30, PUT ADDRESS F2103760
STO ADL90 IN ADL90. XRA CONTAINS BNX F2103770
ADL10 CLA DOTAGZ,1 OBTAIN FIRST WORD. F2103780
PAX 0,2 SAVE BETA F2103790
ANA DECMSK GET ALPHA ALONE. F2103800
CAS ADL90 COMPARE WITH ADDRESS. IF F2103810
ADL20 TXL ADL70,0 ALPHA NOT LESS THAN ADD, THEN F2103820
ADL30 TXL ADL70,0 ADD IN LAST CHOOSEN DO. F2103830
PXD 0,2 IF ALPHA LESS THAN ADD, F2103840
CAS ADL90 COMPARE WITH BETA. F2103850
NOP IF BETA IS NOT LESS THAN F2103860
TRA ADL40 ADDRESS, THIS DO CONTAINS F2103870
TXH ADL50,4,0 ADDRESS. EXIT IF OUT OF NEST F2103880
TRA ADL70 TO ADL 70. OTHERWISE, GO TO 30 F2103890
ADL40 SXD ADL30,1 IF DO IN THIS NEST, SXD. F2103900
ADL50 TXI ADL60,1,-9 IN ANY CASE, TAKE NEXT DOWN F2103910
ADL60 TXL ADL70,1 DO, IF ANY, F2103920
CLA DOTAGZ+5,1 PUT LEVEL IN XRC. F2103930
PDX 0,4 AND GO BACK FOR TEST F2103940
TXH ADL10,4,1 UNLESS NGW DO HAS LEVEL ONE. F2103950
ADL70 LXD ADL30,3 OBTAIN XDA IN XRA, XRB. F2103960
TXL ADL80,1,0 EXIT IF ZERO. F2103970
CLA DOTAGZ+5,1 IF NOT ZERO, GET LDA IN F2103980
PDX 0,2 XRB, PUT F2103990
ADL80 LXD ADL20,4 TSX SET IN XRC F2104000
TRA 1,4 AND RETURN. F2104010
ADL90 HTR F2104020
REM TRALEV LISTING F2104030
TLT00 LXD TLT50,1 OBTAIN CURRENT TRALEV F2104040
STO TLTZ,1 INDEX. STORE ENTRY. F2104030
TXI TLT10,1,-1 IF TABLE NOW FULL, GO TO F2104060
TLT10 SXD TLT50,1 TAPE WRITING ROUTINE. F2104070
TXL TLT20,1,0 OTHERWISE, SAVE NEW INDEX F2104080
TRA 1,4 AND RETURN. F2104090
TLT20 WRS TLTAPE SELECT TAPE TO WRITE AWAY F2104100
LXD TLT50,1 BUFFER. INITIALIZE XRA F2104110
SXD TLT40,1 AND TEST INSTR. F2104120
MSE 98 TURN OFF TRALEV TAPE EMPTY F2104130
NOP LIGHT F2104140
LXA TLT50,1 RE-INITIALIZE INDEX QUANTITIES F2104150
SXD TLT50,1 F2104160
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 229/233 ------
TLT30 CPY TLTZ,1 COPY BUFFER. F2104170
TXI TLT40,1,-1 F2104180
TLT40 TXH TLT30,1 F2104190
TRA 1,4 RETURN. F2104200
TLT50 HTR 600 BUFFER SIZE F2104210
REM ES FORFLOW F2104220
BNX BSS 1 BEGINNING OF NEST INDEX F2104230
BNA BSS 1 BEGINNING OF NEST ADDRESS F2104240
ENA BSS 1 END OF NEST ADDRESS F2104250
G BSS 1 GAMMA OF SOME TIFGO ENTRY F2104260
XDG BSS 1 INDEX OF DO WITH G IN IMMED. F2104270
LDG BSS 1 RANGE. LEVEL OF XDG. F2104280
A BSS 1 AN ADDRESS TO WHICH G TRANSFERS. F2104290
XDA BSS 1 1NDEX OF DO WITH A IN IMMED. F2104300
LDA BSS 1 RANGE. LEVEL OF XDA. F2104310
TIFX BSS 1 CURRENT TIFGO INDEX. F2104320
REM DO SYMBOL DEFINITION OF VARIABLE RANGES AND INCREMENTS F2104330
SV00 LXD DOTAG-1,1 F2104340
SXD SV80,1 F2104350
SXD SV95,1 F2104360
SXD TRA40,1 F2104370
LXD L(1350,1 INITIALIZE XRA F2104380
SXD SV44,1 SAVE CURRENT DO INDEX F2104390
SV10 SXD SV98,1 SAVE NEST INDEX F2104400
SV20 CLA DOTAGZ,1 OBTAIN FIRST WORD CURRENT F2104410
ANA TAGMSK DO AND INSPECT TAG F2104420
TZE SV90 IF ZERO, GO TO INDEXING F2104430
LXD SV98,4 OTHERWISE, NEST INDEX IN XRC F2104440
SV30 CLA DOTAGZ+1,4 OBTAIN SYM OF XRC, F2104450
LXD L(3),2 INITIALIZE XRB COUNTER F2104460
SV40 CAS DOTAGZ+4,1 AND TEST FOR SYM EQUALS VAR.N. F2104470
SV44 TXL SV50,0 CURRENT DO INDEX STORAGE. F2104480
SV48 TXL SF00,0 INDEX STO OF N IN CUR. DO F2104490
SV50 TXI SV60,1,1 TAKE NEXT.N, COUNT F2104500
SV60 TIX SV40,2,1 IN XRB AND GO BACK. F2104510
SV65 LXD SV44,1 SYM NOT VAR.N., PUT CURRENT F2104520
SV70 TXI SV80,4,-9 DO INDEX IN XRA AND INDEX F2104530
SV80 TXL SV90,4 XRC. IF TABLE ENDS, GO70 SU90. F2104540
CLA DOTAGZ+5,4 OTHERWISE TEST FOR,NEW NEST, F2104550
PDX 0,2 IF NOT NEW NEST, GO BACK TO. F2104560
TXH SV30,2,1 TEST SYM. OTHERWISE. F2104570
SV90 TXI SV95,1,-9 TAKE NEXT DOWN DO F2104580
SV95 TXL TS4VAL,1 POSSIBLE. OTHERWISE, EXIT F2104590
SXD SV44,1 SAVE CURRENT DO INDEX. F2104600
CLA DOTAGZ+5,1 F2104610
PDX 0,2 INSPECT LEVEL. F2104620
TXH SV20,2,1 IF NOT NEW NEST, TRA SV20 F2104630
SV98 TXL SV10,0 1F NEW NEST, SV10 (NEST.INDEX STO.)F2104640
SF00 SXD SV48,1 SAVE INDEX OF N. N CURRENT DO F2104650
SXD SF10,2 SAVE N COUNTER. F2104660
SXD SF15,4 F2104670
PXD 0,4 SAVE INDEX OF SYMBOL DO F2104680
STO SFES1 IN FULL WORD. F2104690
LXD SV44,1 OBTAIN INDEX OF CURRENT DO F2104700
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 230/234 ------
PXD 0,1 IN ACC. AND COMPARE F2104710
CAS SFES1 WITH INDEX OF SYMBOL DO. F2104720
SF10 TXL SF20,0 CURRENT INDEX GREATER. F2104730
TRA SF79 EQUALITY F2104740
PSE 97 SYMBOL INDEX GREATER, F2104750
SF15 TXL SF30,0 TURN ON LIGHT 97. F2104760
SF20 LXD SV44,4 CUR. IND. GREATER, PUT IN XRC F2104770
LXD SFES1,1 SYM. IND. IN XRA. F2104780
MSE 97 LIGHT 97 OFF. F2104790
NOP AT SF30, XRA CONTAIN LEAST F2104800
SF30 PXD 0,4 OF CUR. IND, SYM. IND. XRC F2104810
STO SFES1 CONTAINS GREATER. PUT IN ES. F2104820
SF35 CLA DOTAGZ+5,1 PUT LEVEL OF D(XRA) IN F2104830
PDX 0,2 XRB. HALT IF F2104840
TXH SF40,2,1 LEVEL F2104850
TSX DIAG,4 IS ONE ERROr. GO TO DIAGNOSTIC F2104865
SF40 TXI SF50,1,9 BACK UP IN XRA- F2104870
SF50 TXL SF60,1,1350 HALT IF TOP OD DOTAG F2104880
TSX DIAG,4 PASSED. ERROr. GO TO DIAGNOSTIC F2104893
SF60 CLA DOTAGZ+5,1 THIS ROUTINE, BY RAISING F2104900
STD SF70 XRA, EXITS TO SF80 OR F2104910
SF70 TXL SF40,2 SF90 UPON FINDING A DO F2104920
PXD 0,1 IN THE SUBNEST OF XRA F2104930
CAS SFES1 WHICH IS THE DO OF XRC OR F2104940
TRA SF73 CONTAINS THE DO OF XRC F2104950
TRA SF80 AND CURRENT DO. F2104960
TRA SF35 GO BACK FOR NEXT DO F2104970
SF73 SXD SF76,1 THIS ROUTINE (THROUGH SF76) F2104980
SF74 LXD SF15,1 F2104990
TSX TRA00,4 USES TRA00 F2105000
TZE SFEND F2105010
STO SF78 TO DETERMINE THE F2105020
LXD SF76,1 GREATEST EXIT LEVEL OF F2105030
CLA DOTAGZ+5,1 DEFINITION FROM A F2105040
ANA DECMSK DO SYM NOT IN THE F2105050
CAS SF78 SUBNEST OF A DO WITH F2105060
CLA SF78 VARIABLE NS, BUT IN A F2105070
NOP SUBNEST WHICH HAS A F2105080
SF76 TXL SF90,0 NON EMPTY INTERSECTION F2105090
SF78 HTR WITH THAT SUB NEST. F2105100
SF79 CLA DOTAGZ+5,1 F2105110
ANA DECMSK F2111120
SUB L(1) F2105130
TNZ SF90 F2105140
TRA SFEND F2105150
SF80 MSE 97 EQUALITY, IF SYM DO IS F2105160
TSX DIAG,4 CURRENT DO, ERROr. GO TO DIAGNOSTIC. F2105173
CLA BITONE F2105180
ORS DOTAGZ+5,1 F2105190
CLA DOTAGZ+5,1 OBTAIN LEVEL OF DEFINITION F2105200
ANA DECMSK AND STORE F2105210
SF90 ARS 18 IN ADDRESS PART F2105220
STO SFES1 OF SFESI. F2105230
LXD SV48,1 INDEX OF VAR.N. IN CUR. DO. F2105240
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 231/235 ------
CLA DOTAGZ+8,1 OBTAIN PREVIOUS LEV. DEF. F2105250
ANA ADDMSK AND COMPARE F2105260
CAS SFES1 WITH NEW, F2105270
TRA SFEND EXIT UNLESS F2105280
TRA SFEND NEW LEV. F2105290
CLA SFES1 IS LARGGER, IN WHICH CASE F2105300
STA DOTAGZ+8,1 REPLACE OLD WITH NEW F2105310
LXD SF10,2 OBTAIN N COUNTER IN XRB F2105320
SF92 CLA DOTAGZ+4,1 OBTAIN VAR. N IN ACC. F2105330
TRA SF96 GO TO INDEXING. F2105340
SF94 CAS DOTAGZ+4,1 COMPARE, TO FIND DUPLICATE F2105350
TRA SF96 N S. F2105360
TRA SF99 DUPE FOUND. F2105370
SF96 TXI SF98,1,1 INDEX IN DO FORMULA F2105380
SF98 TIX SF94,2,1 AND IN COUNTER F2105390
TRA SFEND F2105400
SF99 CLA SFES1 REPLACE F2105410
STA DOTAGZ+8,1 OLD LEVEL F2105420
TRA SF92 OF DEFINITION. F2105430
SFEND LXD SF15,4 GO BACK FOR NEXT F2105440
TRA SV65 SYMBOL DO F2105450
SFES1 HTR ES, F2105460
REM GREATEST TRANSFER LEVEL OUT OF DO FORMULA F2105470
TRA00 CLA DOTAGZ+5,1 OBTAIL LEVEL OF DO F2105480
PDX 0,2 USE MAX LEV TWENTY F2105490
TRA10 TXL TRA20,2,20 F2105500
LXD TRA10,2 F2105510
TRA20 SXD TRA50,2 INITIALIZE TEST INSTR. F2105520
PXD 0,2 COMPUTE LEVEL MINUS ONE F2105530
ARS 18 AND INITIALIZE SHIFT INSTR. F2105540
SUB TRAN1 COMPUTE 35 MINUS (L M1NUS F2105530
STA TRA70 ONE) AND F2105560
SUB TRAN2 INITIALIZE F2105570
STA TRA80 SHIFT INSTR. F2105580
PXD 0,0 INITIALIZE F2105590
STO TRAN5 ES LOCATION TO ZERO F2105600
TRA30 CAL DOTAGZ+7,1 OR INTO TRAN5 ALL THE F2105610
ORS TRAN5 T2 WORDS OF THIS DO F2105620
TXI TRA40,1,-9 AND ALL DOS CONTAINED F2105630
TRA40 TXL TRA60,1 BY THIS DO. F2105640
CLA DOTAGZ+5,1 F2105650
PDX 0,2 F2105660
TRA50 TXH TRA30,2 F2105670
TRA60 LDQ TRAN4 PUT MASK IN QUOTIENT F2105680
TRA70 LLS REGISTER, SHIFT COMPUTED F2105690
TRA80 ALS AMOUNTS TO CONSTRUCT F2105700
ANA TRAN5 MASK IN ACC. AND IN F2105710
TZE TRA95 UNION OF T2 WORDS. EXIT IF ZERO. F2105720
STO TRAN5 OBTAIN LOW ORDER BIT F2105730
SUB TRAN1 IN ACC. F2105740
STO TRAN6 F2105750
ORA TRAN5 F2105760
SUB TRAN6 F2105770
LXD L(1),1 F2105780
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 232/236 ------
TRA85 CAS TRATAB+19,1 SEARCH TABLE F2105790
TRA TRA86 TO OBTAIN F2105800
TRA TRA90 LEVEL INTEGER F2105810
TRA86 TXI TRA87,1,1 F2105820
TRA87 TXL TRA85,1,19 F2105830
TSX DIAG,4 ERROr GO TO DIAGNOSTIC. F2103845
TRA90 PXD 0,1 PUT LEVEL IN ACC DECREMENT F2105850
TRA95 TRA 1,4 EXIT. F2105860
TRAN1 HTR 1 F2105870
TRAN2 HTR 35 F2105880
TRAN4 OCT 377777777777 F2105890
TRAN5 HTR F2105900
TRAN6 HTR F2105910
TRATAB OCT 200000 F2105920
OCT 400000 F2105930
OCT 1000000 F2105940
OCT 2000000 F2105950
OCT 4000000 F2105960
OCT 10000000 F2105970
OCT 20000000 F2105980
OCT 40000000 F2105990
OCT 100000000 F2106000
OCT 200000000 F2106010
OCT 400000000 F2106020
OCT 1000000000 F2106030
OCT 2000000000 F2106040
OCT 4000000000 F2106050
OCT 10000000000 F2106060
OCT 20000000000 F2106070
OCT 40000000000 F2106080
OCT 100000000000 F2106090
OCT 200000000000 F2106100
REM FORVAL TABLE SEARCH FOR VARIABLE RANGES AND INCREMENTS F2106110
TS4VAL CLA 4VALAD READ IN F2106120
LXD L(6),2 FORVAL F2106130
TSX RTAPE,4 F2106140
TXL TSV10,1,999 F2106150
PSE 100 IF FORVAL EMPTY, SET F2106160
TRA T190 SENSE LIGHT AND EXTT F2106170
TSV10 SXD TS40,1 INITIALIZE TEST INSTRS. F2106180
SXD TS75,1 F2106190
MSE 99 TEST FOR EMPTY DOTAG F2106200
TRA TSV20 OFF, NOT EMPTY F2106210
PSE 99 ON, DOTAG EMPTY F2106220
TRA T190 EXIT F2106230
TSV20 LXD DOTAG-1,1 DOTAG TEST INITIALIZING F2106240
SXD TS35,1 F2106230
LXD L(1350,1 INITIALIZE XRA F2106260
LXD L(1000,4 AND F2106270
SXD XFOR,4 XFOR. CONTINUE WITH TS00 F2106280
TS00 MSE 97 SENSE LIGHT-97 OFF F2106290
NOP F2106300
TS10 CLA DOTAGZ+5,1 OBTAIN LEVEL OF CURRENT F2106310
PDX 0,2 DO IN XRB. IF L IS ONE, F2106320
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 233/237 ------
TXL TS15,2,1 GO TO NEST PROCEDURE. IF F2106330
MSE 97 L 1S NOT ONE AND LIGHT IS F2106340
TRA TS30,0 OFF, GO TO INNER DO PRECEDURE, F2106350
PSE 97 IF LIGHT IS ON, CONTINUE F2106360
TXI TS35,1,-9 INDEXING FOR NEXT NEST. F2106370
TS15 MSE 97 F2106380
NOP F2106390
CLA DOTAGZ,1 L IS ONE, DO NEST PR0CEDURE. F2106400
PAX 0,2 ESTABLISH BEGINNING OF F2106410
ANA DECMSK NEST ADDRESS BNA, AND F2106420
STO TBNA END OF NEST ADDRESS ENA. F2106430
PXD 0,2 SEARCH IN FORTAG UNTIL F2106440
STO TENA FOR NRS. FOUND GREATER F2106450
LXD XFOR,4 THAN ENA. IF NONE, EXIT F2106460
CLA TBNA FROM ENTIRE ROUTINE. F2106470
TS20 CAS 4VALZ,4 TEST WHETHER FIRST SUCH F2106480
TXI TS40,4,-2 NR. IS IN NEST IF NOT, F2106490
TSX DIAG,4 FIND NEXT NEST. IF SO, (ERROr. GO TO DIAGNOSTIC.)F2106503
SXD XFOR,4 GO TO INDEXING INSTRS. F2106510
CLA TENA FOR NEXT DO. F2106520
SUB 4VALZ,4 F2106530
TPL TS25 F2106540
PSE 97 RECORD NO FORVAL FALLS IN THIS NEST. F2106550
TS25 TXI TS35,1,-9 F2106560
TS30 CLA DOTAGZ,1 INNER DO PROCEDURE. F2106570
ANA TAGMSK TEST FOR NON ZERO TAG, F2106580
TNZ TS50 IN WHICH CASE TRA FOR F2106590
TS33 TXI TS35,1,-9 TABLE SEARCH. OTHERWISE, F2106600
TS35 TXH TS10,1 INDEX FOR NEXT DO, IF POSSIBLE. F2106610
TS38 TXL T190,0 EXIT, STORAGE FOR INDEX CUR. DO. F2106620
TS40 TXH TS20,4 INDEX TEST FOR FORVAL F2106630
TRA T190 EXIT F2106640
TS50 SXD TS38,1 SAVE INDEX OF CURRENT DO F2106650
SXD T110,2 SAVE LEVEL OF CURRENT DO F2106660
LXD XFOR,4 OBTAIN FORVAL INDEX IN XRC F2106670
TS55 LXD L(3),2 PUT THREE IN XRC F2106680
LXD TS38,1 CURRENT DO IN XRA F2106690
CLA TENA TEST FOR END OF NEST F2106700
SUB 4VALZ,4 F2106710
TMI TS33 NOT IN NEST TRA FOR NEXT DO. F2106720
CLA 4VALZ+1,4 IN NEST 0BTAIN FORTAG F2106730
TS60 CAS DOTAGZ+4,1 SYMBOL, COMPARE WITH VAR F2106740
TRA TS65 N SYMBOLS. F2106750
TRA TS80 EQUALITY F2106760
TS65 TXI TS70,1,1 INDEX IN XRA, F2106770
TS70 TIX TS60,2,1 COUNT IN XRB F2106780
TXI TS75,4,-2 TAKE NEXT FORTAG ENTRY, F2106790
TS75 TXH TS55,4 IF ANY F2106800
LXD TS38,1 RESTORE CURRENT DO INDEX F2106810
TXI TS35,1,-9 AND TRA FOR NEXT DO. F2106820
TS80 SXD T148,2 SAVE VAR. N. COUNTER. F2106830
SXD T144,1 SAVE COUNTER OF SYM IN DO F2106840
LXD TS38,1 CURRENT DO INDEX IN XRA F2106850
LXD T110,2 CURRENT DO LEVEL IN XRB F2106860
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 234/238 ------
TXI TS85,2,1 ADJUST XRB FOR CURRENT DO TEST. F2106870
TS85 CLA DOTAGZ+5,1 OBTAIN NEXT BACK DO IN F2106880
STD TS90 SUBNEST. ON FIRST TIME F2106890
TS90 TXH T100,2 THROUGH, CURRENT DO IS F2106900
TS92 TXI TS85,1,9 PRODUCED. F2106910
TS94 TIX TS92,2,1 ADJUST LEVEL. F2106920
TSX DIAG,4 IF NOT IN NEST, ERROr. GO TO DIAGNOSTIC. F2106933
T100 CLA DOTAGZ,1 NEXT BACK DO FOUND. F2106940
ANA DECMSK TEST TO SEE IF FORTAG F2106950
SUB 4VALZ,4 FORMULA NR. IS IN THIS F2106960
TPL TS94 DO. IF NOT, GO TO TS94 F2106970
CLA DOTAGZ,1 TO ADJUST LEVEL FOR F2106980
ANA ADDMSK OBTAINING NEW SUBNEST DO. F2106990
ALS 18 F2107000
SUB 4VALZ,4 F2107010
TMI TS94 F2107020
T110 TXL T120,2 DEC CONTAINS CURRENT LEVEL. F2107030
TRA T170 APPARENT DEFINITION OF A VARIABLE N WITHIN F2107044
REM RANGE OF THE DO WITH VARIABLE N. IGNORE AND F2107046
REM GET NEXT FORVAL. F2107047
T120 LXD T144,1 PUT CUR. VAR. DO INDEX IN F2107050
CLA DOTAGZ+8,1 XRA, AND OBTAIN LEV. DEF, F2107060
PAX 0,2 OF VAR. N. F2107070
SXD T130,2 STORE IN DEC OF T130. F2107080
LXD TS90,2 OBTAIN LEVEL OF DO CONTAINING F2107000
T130 TXL T170,2 FURTAG FOR. NR. F2107100
PXD 0,2 CHOOSE LARGER AND PUT IN F2107110
ARS 18 LEV, DEF. FIELD OF CURRENT DO. F2107120
STA DOTAGZ+8,1 IF CHANGE MADE, SAVE F2107130
STO T195 LEVEL, F2107140
LXD T148,2 AND TEST TO SEE IF THIS F2107150
CLA DOTAGZ+4,1 SYMBOL F2107160
TXI T160,1,1 DUPLICATED F2107170
T140 CAS DOTAGZ+4,1 IN DO VAR.N S. F2107180
T144 TXL T150,0 IF SO, REPLACE ITS LEVEL(DEC HAS IX FOR VAR N) F2107100
T148 TXL T180,0 OF DEF BY THIS ( DEC HAS 3,2,1 IF FORVAL F2107200
REM MATCHES VARIABLE N3,N2,N1) F2107201
T150 TXI T160,1,1 NEW LEVEL. F2107210
T160 TIX T140,2,1 F2107220
T170 TXI TS75,4,-2 F2107230
T180 CLA T195 F2107240
STA DOTAGZ+8,1 F2107230
CLA DOTAGZ+4,1 F2107260
TXI T160,1,1 F2107270
T190 TRA RH00 EXIT F2107280
T195 HTR ES F2107290
XFOR HTR FORTAG INDEX F2107300
TBNA HTR ES F2107310
TENA HTR ES F2107320
REM USE OF SYMBOL WITHIN RANGE AS FXD POINT VAR. FORVAR SEARCH. F2107330
RH00 LXD L(5),2 READ IN F2107340
CLA 4VARAD FORVAR F2107350
TSX RTAPE,4 F2107360
TXH RH95,1,1499 EXIT IF FORVAR EMPTY F2107370
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 235/239 ------
MSE 99 TEST FOR EMPTY DOTAG. F2107380
TRA RH05 NOT EMPTY F2107390
PSE 99 EMTPY, RESTORE SENSE LIGHT F2107400
TRA RH95 AND EXIT. F2107410
RH05 SXD RH60,1 FORVAR.TEST F2107420
SXD RH75,1 INIT1ALIZING F2107430
LXD DOTAG-1,1 DOTAG TEST F2107440
SXD RH90,1 INITIALIZING F2107450
LXD L(1500,1 MAX WORDS IN FORVAL F2107460
SXD RHNNX,1 IN NEXT NEST INDEX. F2107470
MSE 97 TURN LIGHT 97 OFF. F2107480
NOP F2107490
LXD L(1350,1 PUT MAX WDS IN DOTAG IN XRA. F2107500
RH10 CLA DOTAGZ,1 OBTAIN FIRST DOTAG WORD. F2107510
PAX 0,2 SEPARATE ALPHA AND BETA, F2107520
ANA DECMSK STORE IN RFIRST AND RLAST F2107530
STO RFIRST F2107540
PXD 0,2 F2107550
STO RLAST F2107560
CLA DOTAGZ+5,1 OBTAIN LEVEL IN XRB. F2107570
PDX 0,2 F2107580
TXH RH30,2,1 TRA IF LEVEL GREATER THAN ONE. F2107590
MSE 97 LEVEL IS ONE, TEST WHETHER, F2107600
TRA RH20 ON LAST LEVEL ONE, FORVAR F2107610
TRA RH95 EXHAUSTED, IF SO, EXIT, F2107620
RH20 LXD RHNNX,4 OTHERWISE, ADJUST FORVAR F2107630
SXD RHCNX,4 1NDEX TO SKIP LAST NEST AREA F2107640
RH30 LXD RHCNX,4 PUT FORVAR INDEX IN XRC F2107650
CLA RFIRST BEGIN SEARCH FOR FIRSTL. F2107660
RH40 CAS 4VARZ,4 FORVAR ENTRY IN RANGE. F2107670
TXI RH60,4,-2 F2107680
TSX DIAG,4 ERROr GO TO DIAGNOSTIC F2107695
SXD RHCNX,4 SAVE INDEX AT THIS POINT, F2107700
RH50 CLA RLAST FOR NEXT DO, AND COMPARE F2107710
CAS 4VARZ,4 FORVAR ENTRY WITH RLAST F2107720
NOP F2107730
TRA RH70 TRA, IN RANGE. F2107740
TRA RH80 TRA, NOT IN RANGE F2107750
RH60 TXH RH40,4 IF NO ENTRIES GREATER F2107760
TRA RH95 THAN RFIRST, EXIT. F2107770
RH70 CLA DOTAGZ+1,1 IN RANGE, COMPARE SYMB0LS F2107780
SUB 4VARZ+1,4 IF EQUAL, PUT BIT IN F2107790
TNZ RH72 DOTAG-ENTRY. F2107800
CLA BITONE F2107810
ORS DOTAGZ+5,1 F2107820
TXH RH85,2,1 F2107830
RH72 TXI RH75,4,-2 INDEX FORVAR AND GO BACK, F2107840
RH75 TXH RH50,4 IF POSSIBLE. OTHERWISE, F2107850
TXH RH85,2,1 TEST LEVEL. IF LEVEL IS F2107860
PSE 97 ONE, ARRANGE TO EXIT WHEN F2107870
TRA RH85 NEXT LEVEL ONE ENCOUNTERED F2107880
RH80 TXH RH85,2,1 N0T IN RANGE, TEST LEVEL F2107890
SXD RHNNX,4 SET NEXT NEST INDEX IF L IS ONE. F2107900
RH85 TXI RH90,1,-9 INDEX IN DOTAG AND GO F2107910
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 236/240 ------
RH90 TXH RH10,1 BACK, IF POSSIBLE. F2107920
RH95 TRA LB00 EXIT F2107930
RHNNX HTR NEXT NGST INDEX F2107940
RHCNX HTR CURRENT NEST INDEX F2107950
RFIRST HTR ALPHA ADDRESS F2107960
RLAST HTR BETA ADDRESS F2107970
REM TAPE READING ROUTINE F2107980
RTAPE STA RT40 INITIALIZE TABLE ADDRESS F2107990
STO RT92 F2108000
SXD RT80,4 SAVEXRC, TSX SET F2108010
PXD 0,2 SAVE XRB, F2108020
ARS 18 TABLE NR, IN ADDRESS. F2108030
STO RT90 F2108040
LXD RTD18,4 INITIALIZE ERROr COUNTER. F2108050
SXD RT73,4 F2108060
RT10 RDS TTAPE SELECT TAPE F2108070
LXD RT92,1 PUT MAX NR WORDS IN XRA F2108080
LXD L(2),4 PUT TWO IN XRC F2108090
RT20 CPY RT95+2,4 COPY FIRST TWO WORDS. F2108100
TRA RT30 INTO E.S. F2108110
TSX DIAG,4 EOF. ERROr. GO TO DIAGNOSTIC F2108125
TSX DIAG,4 EOR ERROR. GO TO DIAGNOSTIC. F2108135
RT30 TIX RT20,4,1 F2108140
TXL RTDO0,2,1 F2108150
RT40 CPY 0,1 COPY TABLE F2108160
TXI RT40,1,-1 COUNT NR. OF WORDS. F2108170
TSX DIAG,4 EOF ERROr. GO TO DIAGNOSTIC. F2108183
RT45 WRS 219 ERROr. GO TO DIAGNOSTIC. F2108183
RTT ERROr TEST F2108190
TRA RT70 ERROr, TRA F2108200
CLA RT90 NO ERROr, F2108220
SUB RT95 TEST TABLE NR. F2108230
TZE RT60 NO ERROr F2108240
TSX DIAG,4 WRONG TABLE 1DENT NR. ERROr. GO TO DIAGNOSTIC. F2108255
RT60 LXD RT80,4 TABLE CORRECT, F2108260
TRA 1,4 RETURN. F2108270
RT70 LXD RT73,4 F2108280
BST TTAPE ERROr, BACKSPACE TAPE F2108290
TNX RT75,4,1 F2108300
SXD RT73,4 COUNT DOWN ERROR COUNTER F2108310
RT73 TXL RT10,0 F2108320
RT75 LDQ RT90 IF FIVE FAILURES, PUT F2108332
TSX DIAG,4 TABLE NR. IN MQ. ERROR. GO TO DIAGNOSTIC. F2108344
RT80 HTR TSX INDEX STORAGE F2108350
RT90 HTR TABLE NR STORAGE, C.S. F2108360
RT92 HTR ADDRESS WORD STORAGE F2108370
RT95 HTR TABLE NR, WD ONE OF TABLE. F2108380
RT96 HTR NR. OF WDS IN DEC. F2108390
RTDO0 PXD 0,0 THIS ROUTINE F2108400
RTD10 LXD RTD18,4 READS IN ONE F2108410
RTD15 CPY DOTAGZ,1 ENTRY FROM F2108420
TXI RTD20,1,-1 TDO, AFTER WHICH F2108430
TSX DIAG,4 FOUR ZERO WORDS =ERROr. GO TO DIAGNOSTIC. F2108445
RTD18 TXL RT45,0,5 ARE STORED,BEFORE F2108450
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 237/241 ------
RTD20 TIX RTD15,4,1 READING IN F2108460
RTD23 TXI RTD25,4,3 THE NEXT ENTRY. F2108470
RTD25 STO DOTAGZ,1 STORE ZERO F2108480
TXI RTD30,1,-1 INDEX F2108490
RTD30 STO DOTAGZ,1 AND REPEAT. F2108500
TXI RTD35,1,-1 WHEN DOTAG F2108510
RTD35 STO DOTAGZ,1 ENTRY IS F2108520
TXI RTD40,1,-1 COMPLETE, F2108530
RTD40 STO DOTAGZ,1 TRA F2108540
TXI RTD10,1,-1 TO RTD10 F2108550
DOAD HTR DOTAGZ,0,1350 ADDRESS PART CONTAINS F2108560
4VALAD HTR 4VALZ,0,1000 ADDRESS OF LAST WORD IN F2108570
TIFAD HTR TIFZ,0,600 TABLE PLUS ONE. F2108580
TRADAD HTR TRADZ,0,250 DEC CONTAINS MAX NR OF F2108590
4VARAD HTR 4VARZ,0,1500 WRDS. F2108600
4TAGAD HTR FORTZ,0,1500 F2108610
REM TRANSFER IN EXTENDED RANGE BIT. F2108620
LB00 MSE 99 TEST FOR EMPTY DOTAG F2108630
TRA LB02 OFF, NOT EMPTY F2108640
PSE 99 ON, EMPTY, RESET LIGHT F2108650
TRA EB00 AND EX1T F2108660
LB02 LXD DOTAG-1,1 OBTAIN NEXT UNUSED INDEX F2108670
LB05 TXL LB60,0 TRA TO ADJUST FOR LAST DO. F2108680
LB10 CLA DOTAGZ+6,1 OBTAIN T1 WORD. F2108690
TMI LB60 TEST SIGN, TRA IF NEG. F2108700
ANA BITONE TEST FOR TRA IN IMMED. RANGE. F2108710
TZE LB60 IF NONE,TRA. F2108720
SXD LB05,1 SAVE XRA F2108730
CLA DOTAGZ+5,1 PUT LEVEL F2108740
PDX 0,2 IN XRB F2108750
LB20 CAL LMSK OR IN F2108760
ORS DOTAGZ+6,1 MSK F2108770
TXL LB50,2,1 EXIT IF LEVEL ONE. F2108780
LB25 TXI LB30,1,9 FIND NEXT BACK F2108790
LB30 CLA DOTAGZ+5,1 SUBNEST DO, F2108800
STD LB40 F2108810
LB40 TXL LB25,2 F2108820
PDX 0,2 SAVE NEW LEVEL IN XRB. F2108830
CLA DOTAGZ+6,1 TEST SIGN OF WORD T1. F2108840
TPL LB20 IF PLUS GO TO PUT IN MSK. F2108850
LB50 LXD LB05,1 IF NOT, FIND NEXT DO F2108860
LB60 TXI LB70,1,9 IN MAIN PASS. F2108870
LB70 TXL LB10,1,1350 EB00 FOLLOWS F2108880
REM END OF BLOCK ROUTINE F2108890
EB00 REW 147 REWIND DOTAG TAPE F2108900
MSE 99 TEST FOR EMPTY DQTAG F2108910
TRA EB10 OFF, NOT EMPTY F2108920
PSE 99 ON, EMPTY, RESTORE AND TRA. F2108930
TRA EB50 F2108940
EB10 LXD DOTAG-1,1 INITIALIZE TEST INSTR. F2108950
SXD EB40,1 AND F2108960
LXD L(1350,1 XRA F2108970
EB20 LXD L(9),4 WRITE F2108980
CLA DOTAGZ+5,1 DOTAG F2108990
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 238/242 ------
PDX 0,2 ON F2109000
TXH EB30,2,1 TAPE F2109010
WRS 147 ONE F2109020
EB30 CPY DOTAGZ,1 NEST F2109030
TXI EB40,1,-1 PER F2109040
EB40 TXL EB50,1 RECORD F2109050
TIX EB30,4,1 F2109060
TRA EB20 F2109070
EB50 WEF 147 WRITE END OF FILE F2109080
EB60 LXD L(4),2 READ F2109090
CLA 4TAGAD IN F2109100
TSX RTAPE,4 FORTAG. F2109110
SXD FORTAG-1,1 SET SENSE LIGHT 97 F2109120
MSE 97 ON IF FORTAG F2109130
NOP EMPTY, OFF IF F2109140
TXL EB70,1,1499 FORTAG F2109150
PSE 97 NOT EMPTY. F2109160
EB70 RDS TTAPE MOVE TTAPE PAST F2109170
CPY EB80 END OF FILE MARK. F2109180
TRA EB70 F2109190
TRA EB90 EOF F2109200
TSX DIAG,4 SHOULD NOT BE EOR HERE. ERROr. GO TO DIAGNOSTIC. F2III215
EB80 HTR ES F2109220
EB90 MSE 98 IS TRALEV TALBE EMPTY F2109230
TRA EB95 F2109240
WRS TLTAPE ON, EMPTY. F2109250
CPY L(0) F2109260
CPY L(0) F2109270
PSE 98 F2109280
EB95 WEF TLTAPE TRALEV TAPE F2109290
RDS 145 SKIP OVER DIAGNOSTIC RECORD ON SYSTEM TAPE F2109295
TRA ONETCS GO TO ONE TO CS ( MONITOR). F2109296
ERLIST SXD ERIR2,2 SAVE X R B F2109311
LXD ERNBR,2 GET ERROr NUMBER F2109321
CLA DOTAGZ,4 SAVE ALPHA DO BETA F2109331
STO LIST,2 IN LIST F2109141
CLA DOTAGZ+1,4 AND SYMBOL F2109351
STO LIST-1,2 F2109361
CLA DOTAGZ,1 SAVE OTHER ALPHA DO BETA F2109371
STO LIST-2,2 F2109181
CLA DOTAGZ+1,1 AND SYMBOL F2109391
STO LIST-3,2 F2102401
TXI ERNXT,2,4 F2109411
ERNXT SXD ERNBR,2 F2109421
LXD ERIR2,2 F2109431
TRA MR60 F2109441
ERIR2 F2109451
ERNBR F2109461
ERBETA SXD ERIR2,2 SAVE ALPHA DO BETA F2109471
LXD ERNBR,2 WHERE ALPHA F2109481
STZ LIST,2 IS GREATER THAN F2109491
CLA DOTAGZ,1 ITS BETA F2109501
STO LIST-1,2 F2109511
CLA DOTAGZ+1,1 F2109521
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 239/243 ------
STO LIST-2,2 F2109531
TXI ERNX,2,3 F2109541
ERNX SXD ERNBR,2 F2109551
LXD ERIR2,2 F2109561
TRA MR15 F2109571
ERTST LXD ERNBR,2 F2109581
TXL FLOW,2,0 F2109591
TSX 4,4 F2109601
LIST SYN 32767 F2109611
ONETCS EQU 4 F2109710
DIAG EQU 4 F2109711
LMSK SYN L(MZ) F2109712
TTAPE EQU 146 F2109722
TLTAPE EQU 148 F2109732
END END OF BLOCK 1 F2109742
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 240/244 ------
REM BLOCK TWO OF SECTION TWO.
REM MASTER RECORD CARD = FN034 F2200004
REM BLOCK 2 OF SECTION 2 PERFORMS SUBSCRIPT ANALYSIS FOR THOSE F2200006
REM SUBSCRIPT COMBINATIONS WHICH HAVE SUBSCRIPTS F2200010
REM SOME OR ALL OF WHICH ARE UNDER CONTROL OF THEIR RESPECTIVE F2200020
REM DOS. THERE ARE TWO MACHINE STATES, ONE F2200030
REM OF WHICH IS RESERVED EXCLUSIVELY F2200040
REM FOR THOSE SUBSCRIPT COMBINATIONS F2200050
REM SOME SUBSCRIPT ELEMENT/S OF WHICH ARE F2200060
REM NOT UNDER CONTROL OF A DO (RELATIVE F2200070
REM CONSTANT). F2200080
ORG 25 F2200090
DOTAG BSS 1 F2200100
BSS 449 F2200110
DOTAGZ BSS 1 F2200120
FORTAG BSS 1 F2200140
BSS 1499 F2200150
FORTZ BSS 1 F2200160
ORG 1976 F2200170
DOREC BSS 1 (INIT ZERO) F2200180
BSS 1 F2200190
ATSW BSS 1 ADDED TAG SWITCH. EQ 1 IF PROC ADDED TAGS(INITOF2200200
NEWTAG BSS 1 (INIT 4000M0DS, FIRSTTAG) F2200210
XC BSS 1 IX CURRENT DO. F2200220
LC BSS 1 LEV CURRENT DO F2200230
ALPHA BSS 1 ALPHA CURRENT DO F2200240
BETA BSS 1 BETA CURRENT DO F2200250
TAG BSS 1 TAG CURRENT TAG IN ROUTINE TAG F2200260
TS BSS 1 TAG, EITHER FORTAG OR NEW TAG NAME OF CURRENT F2200270
TAG1 BSS 1 4TH WD OF TAGTAG F2200280
GR0UP BSS 1 GROUP NR. IN DEC F2200290
C1 BSS 1 COEFF 1ST SYMB (HERE T0 D2 BELOW, INIT 0,SUBCOMF2200300
S1 BSS 1 SUBSCR 1ST SYMB F2200310
C2 BSS 1 COEFF 2ND SYMB F2200320
S2 BSS 1 SUBSC 2ND F2200330
C3 BSS 1 COEFF 3RD F2200340
S3 BSS 1 SUBSC 3RD F2200350
D1 BSS 1 DIMENSION 1ST F2200360
D2 BSS 1 DIM 2ND F2200370
X1 BSS 1 IX DO MATHCHING 1ST SYMB.) (HERE TO CARWRD F2200380
L1 BSS 1 LEV DO MATCHING 1ST SYMB BELOW, INIT 0,IDENTF2200390
X2 BSS 1 IX DO MATHCING 2ND SYMB F2200400
L2 BSS 1 LEV DO MATCHING 2ND F2200410
X3 BSS 1 IX DO MATCHING 3RD F2200420
L3 BSS 1 LEV DO MATCHING 3RD F2200430
XL BSS 1 IX LOWEST LEVEL DOSUB F2200440
LL BSS 1 LEV LOWEST LEVEL DOSUB F2200450
NRSUBS BSS 1 NR. SUBSCRIPTS IN SUBSCR COMBINATION F2200460
NRRC BSS 1 NR. RELCONS IN SUBSCR COMBINATION F2200470
NRDS BSS 1 NR DOSUBS IN S.C. F2200480
DORC BSS 1 BIT POS 15,16,17 EQ 1 IF CORRES X1,X2,X3 DORC F2200490
RCSUBS BSS 1 BIT POS 15,16,17 EQ 1 IF CORRES X1,X2,X3 RELCONF2200500
DOSUBS BSS 1 BIT POS 15,16,17 EQ 1 IF CORRES X1,X2,X3 DOSUB F2200510
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 241/245 ------
DELTA BSS 1 F2200520
RCDUP BSS 1 BIT POS 15,16,17,EQ1 FOR CORRES DUPE RELCONS F2200530
DUPES BSS 1 BIT POS 15,16,17 EQ 1 FOR CORRES DUPE DOSUBS F2200540
RSYM1 BSS 1 -- F2200550
RSYM2 BSS 1 F2200560
CARWRD BSS 1 BIT 11 IF LEFT TYPE 1 CARRY, 12 LEFT TYPE 2, F2200570
REM 13 CENTER TYPE 1, 14 CENTER TYPE 2. F2200571
REM S SET NEG IF COUNTER AND TEST FOUND F2200572
TL1 BSS 1 F2200580
TL2 BSS 1 F2200590
A BSS 1 F2200600
B BSS 1 F2200610
NEXTA BSS 1 F2200620
LASTB BSS 1 F2200630
REBITS BSS 1 F2200640
TRABIT BSS 1 F2200650
LOWP0S BSS 1 5,3,1 1F LL SUBSCR IS X1,X2,X3 RESPECT. (ID) F2200660
L(0) 0,0,0 F2200670
L(1) 0,0,1 F2200680
L(2) 0,0,2 F2200690
L(3) 0,0,3 F2200711
L(4) 0,0,4 F2200710
L(5) 0,0,5 F2200720
L(6) 0,0,6 F2200730
L(20) 0,0,20 F2200740
L(36) 0,0,36 F2200750
L(60) 0,0,60 F2200760
L(450) 0,0,450 F2200770
L(1500 0,0,1500 F2200780
L(1)A 1 F2200790
L(2)A 2 F2200800
L(4)A 4 F2200810
L(MZ) MZE F2200820
35ONES OCT 377777777777 F2200830
DECMSK OCT 77777000000 F2200840
ADDMSK OCT 77777 F2200850
CR1 OCT 100000000 BIT 11 F2200860
CR2 OCT 40000000 BIT 12 F2200870
CARMSK OCT 300000 BITS 19,20 (CARRY BITS OF DOTAG, WD 6) F2200880
FRSTAG OCT 4000 F2200890
BITONE OCT 200000000000 F220090D
BITTWO OCT 100000000000 F2200910
2BITS OCT -200000000000 S AND 1 BIT F2200920
BIT18 OCT 400000 F2200930
BIT19 OCT 200000 F2200940
BIT20 OCT 100000 F2200950
ADTXX 100 DEC CONTAINS (FROM)HERE TO NAMXX BELOW, F2200960
RESXX 300 IX VALUE FOR NEXT (DEC INiT SET TO-ADD) F2200970
TAGXX 80 TABLE ENTRY. F2200980
NAMXX 100 F2200990
BEGIN REW DOTAPE REWIND DOTAG TAPE F2201000
LXD L(5),1 INITIALIZE F2201010
BEG10 CLA LADDIN+5,1 DRUM PROGRAM F2201020
ANA ADDMSK ADDRESSES F2201030
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 242/246 ------
STO LADDS+5,1
TIX BEG10,1,1 F2201040
CLA L(0) , , F2201050
STO DOREC F2201060
RTT TURN F2201070
NOP LIGHT OFF F2201080
LXD L(0),6 TEST FOR EMPTY F2201090
MSE 100 FORVAL F2201110
LXD L(1),4 OFF, NOT EMPTY F2201120
SXD END80,4 ON, EMPTY F2201130
MSE 99 TEST FOR F2201140
LXD L(1),2 EMPTY DOTAG F2201150
SXD END85,2 SAVE TABLE INFO 1N END PROG. F2201160
TXL END,2,0 IF DOTAG EMPTY, GO TO END. F2201170
LXD FORTAG-1,1 INITIALIZE F2201170
SXD TINF30,1 FORTAG F2201180
SXD TAG20,1 TEST F2201190
SXD TAG90,1 INSTRUCTIONS. F2201200
PAT01 CLA FRSTAG INITIALIZE NEW TAG NAME BASE F2201220
STO NEWTAG F2201230
TRA NEST F2201240
END WEF ATAPE WEF ON TAGTAG TAPE F2201250
WRS 195 MAKE END OF DRUMTAG TABLE ENTRY. F2201260
LDA LADDS+4 F2201270
CPY 35ONES F2201280
CPY 35ONES F2201290
LXD L(5),1 F2201300
END10 WRS 219 DELAY. F2201310
WRS ADRUM WRITE. F2201320
CLA LADDIN+5,1 ALL F2201330
SUB L(2)A DRUM F2201340
STA END90 TABLE F2201350
CLA LADDIN+5,1 WORD F2201360
ANA ADDMSK COUNTS F2201370
SUB LADDS+5,1 IN F2201380
SSP FIRST F2201390
STO END95 TWO F2201400
LDA END90 WORDS F2201410
CPY END95 PRECEDING F2201420
CPY END95 EACH TABLE . (TSXCOM, TRASTO, NAMKEY, F2201430
TIX END10,1,1 CHATAG, DRMTAG) F2201440
PSE 96 RESTORE SENSE LIGHTS F2201450
LXD END80,1 SL 100 ON, FORVAL EMPTY F2201450
TXH END20,1,0 SL 99 ON, DOTAG EMPTY, F2201470
PSE 100 F2201480
END20 LXD END85,1 F2201490
TXH END30,1,0 F2201500
PSE 99 F2201510
END30 WEF TAPE2 WRITE EOF AFTER DONEST RECORDS F2201520
WRS TAPE2 F2201530
CPY DOREC MAKE AN EXTRA FILE WITH F2201540
CPY DOREC DONEST RECORD COUNT. F2201550
WEF TAPE2 F2201560
CLA LADDS+1 TRASTO CARRYOVER TO BLOCK 3 F2201570
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 243/247 ------
STO 4093 F2201580
CLA LADDS TSXCOM CARRYOVER TO BLOCK 3. F2201590
STO 4094 F2201600
CLA LADDS+2 NAMKEY (OR NAME) CARRYOVER TO BLOCK 3, F2201610
STO 4095 F2201620
TRA NORMRT F2201635
END80 HTR ES. (DEC HAS 1 IF FORVAL NOT EMPTY) F2201640
END85 HTR FOR (DEC HAS 1 IF DOTAG NOT EMPTY) F2201650
END90 HTR END F2201670
END95 HTR PROGRAM. F2201680
NEST LXD L(0),1 READ F2201690
NEST10 RDS DOTAPE ONE F2201700
LXD L(450),2 NEST OF DO FORMULAS F2201710
NEST20 CPY DOTAGZ,2 FROM F2201720
TXI NEST60,2,-1 DOTAPE. F2201730
TRA END IF EOF, GO TO ROUTINE END. F2201740
NEST30 CLA L(0) INITIALIZING INSTRUCTIONS. F2201750
STO ATSW F2201760
SXD XC,2 PUT C(XRB) IN XC F2201780
SXD DOTAG-1,2 INITIALIZE F2201790
SXD NEST95,2 DECS F2201800
SXD TRAW20,2 THAT F2201810
SXD TRAW50,2 TEST F2201820
SXD SPC040,2 END OF F2201830
SXD SPC090,2 DONEST. F2201840
LXA ADTXX,4 INIT F2201850
SXD ADTXX,4 DECS F2201860
LXA RESXX,4 FROM F2201870
SXD RESXX,4 ADDRESSES. F2201880
LXA TAGXX,4 F2201890
SXD TAGXX,4 F2201900
LXA NAMXX,4 F2201910
SXD NAMXX,4 F2201920
WRS 219 MAKE F2201930
RTT RTT F2201940
TRA NEST35 TEST F2201950
TRA DOFOR IF NO ERROR, GO TO DOFOR. F2201960
NEST35 TXI NEST40,1,1 IF ERROR, . F2201970
NEST40 TXH NEST50,1,4 TRY 4 TIMES MORE FOR F2201985
BST DOTAPE CORRECT READ. F2201990
TRA NEST10 AFTER FIFTH INCORRECT READ, F2202002
NEST50 TSX DIAG,4 ERROR. GO TO DIAGNOSTIC F2202015
NEST60 TXH NEST20,2,0 INDEX COPY. IF DOTAG F2202020
CPY NEST70 STORAGE FULL, AND MORE F2202030
TSX DIAG,4 NEST ENTRIES REMAIN. ERROR. GO TO DIAGNOSTIC. F2202045
TSX DIAG,4 INCORRECT EOF. ERROR. GO TO DIAGNOSTIC. F2202055
TRA NEST30 NO ENTRIES LEFT, GO TO NEST30). F2202060
NEST70 HTR E.S. F2202070
NESTEN LXD L(4),2 PUT END OF NEST INDICATION F2202080
CLA 35ONES IN TAGTAG, CONSISTING OF F2202090
NEST80 STO E1+4,2 FOUR WORDS OF 35 ONES. F2202100
TIX NEST80,2,1 F2202120
TSX TAGENT,4 ENTER IN TAGTAG AND F2202130
TSX TETAPE,2 WRITE BUFFER ON TAPE. F2202140
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 244/248 ------
CLA L(1)
STO ATSW SET ADDED TAG SWITCH F2202150
TSX DRMENT,4 AND GO TO DRMENT TO F2202160
LXD NAMXX,1 PROCESS ADDED TAGS F2202170
REM SXD NEST84,1 TO DRUM TABLE NAME F2202190
SXD NEST84,1 TO DRUM TABLE NAME F2202190
LXA NAMXX,1 ALL ENTRIES F2202200
NEST81 TXL NEST84,0 IN CORE TABLE NAME F2202210
NEST82 CLA NAMZ,1 F2202210
STO E1 F2202220
CLA NAMZ+1,1 F2202230
STO E2 F2202240
CLA NAMKEY F2202250
SXD NEST81,1 F2202260
TSX LIST,4 F2202270
LXD NEST81,1 F2202280
TXI NEST84,1,-2 F2202290
NEST84 TXH NEST82,1 F2202300
LXD ADTXX,1 TRANSFER F2202310
SXD NEST88,1 TO DRUM TABLE NAME F2202320
LXA ADTXX,1 ALL ENTRIESP F2202340
NEST85 TXL NEST88,0 IN CORE TABLE ADTAG F2202340
NEST86 CLA ADTAGZ+1,1 EXCEPT F2202360
TMI NEST87 RESET F2202370
STO E2 ENTRIES F2202380
CLA ADTAGZ,1 F2202380
STO E1 F2202390
PDX 0,2 F2202400
CLA DOTAGZ,2 F2202410
STD E1 F2202420
SXD NEST85,1 F2202430
CLA NAMKEY F2202440
TSX LIST,4 F2202450
LXD NEST85,1 F2202460
NEST87 TXI NEST88,1,-2 F2202470
NEST88 TXH NEST86,1 F2202480
NST100 LXD DOTAG-1,1 F2202490
TRA NST120 F2202500
NST110 CLA DOTAGZ+8,1 DOES BIT 20 WD 9 OF THIS DOTAG F2202510
ANA BBIT EQ 1. F2202530
TZE NST120 AND F2202530
CLA DOTAGZ-1,1 DOES BIT 18 WD 9 OF PRIOR DOTAG F2202550
ANA ABIT EQ 1. F2202550
TNZ NST120 F2202560
CLA ADDMSK YES. ERASE DEC WD 9 F2202570
ANS DOTAGZ+8,1 OF PRIOR DOTAG. F2202580
NST120 TXI NST130,1,9 F2202590
NST130 TXL NST110,1,441 F2202610
CLA DOREC WRITE F2202620
ADD L(1) DOTAG F2202630
STO DOREC ON F2202640
WRS TAPE2 TAPE TWO. F2202660
LXD L(450),1 COUNT NR. F2202670
NEST90 CPY DOTAGZ,1 OF NESTS. F2202680
rem ------ scanned 10/8/06 304349-Volume_I.pdf Page 245/249 ------
TXI NEST95,1,-1 IN DOREC. F2202700
NEST95 TXH NEST90,1 (DEC HAS DOTAG IX) F2202710
TRA NEST RETURN FOR NEXT NEST, F2202720
DOFOR LXD XC,1 OBTAIN F2202730
TXI DOF10,1,9 NEXT BACK DO, F2202740
DOF10 TXH NESTEN,1,450 IF ANY. F2202750
TSX DOINFO,4 USE DOINFO F2202760
TRA TAG00 AND GO TO TAG00 ROUT1NE. F2202770
DOFEND LXD XC,1 IS A COUNTER F2202780
CLA DOTAGZ+8,1 F2202790
ANA BIT19 F2202800
TZE MAKESC F2202810
CAL DOTAGZ+5,1 NECESSARY BECAUSE OF F2202820
ANA 2BITS TRANSFERS OR COMPUTATION WITH F2202830
TNZ DOF15 SYMBOL. F2202840
CLA BIT20 TEST FOR F2202850
ANA DOTAGZ+6,1 DELTA TWO F2202860
TZE DOF20 INSERT F2202870
DOF15 CLA DOTAGZ+6,1 HAS A COUNTER BEEN F2202880
ANA BITTWO FOUND. F2202890
TNZ DOF4