Forgot your password?
Document Actions
32K 709/7090 FORTRAN - SECTION ONE, ONE PRIME, ONE DOUBLE PRIME (RECORDS 13-17)
$JOB ASSEMBLY OF MONITOR, COMPILER SECTIONS 1 THROUGH 6 OF $00000010
$* FORTRAN II PROCESSOR, 7090-FO-928 00000020
$* VERSION 3, MODIFICATION LEVEL 35 (35)00000030
$EXECUTE IBSFAP $00000050
* 32K 709/7090 FORTRAN SECTION ONE F1A00010
* FAP F1A00020
* SECTIONS ONE, ONE PRIME, ONE DOUBLE PRIME (RECORDS 13-17) F1A00030
COUNT 12000 F1A00050
ABS F1A00060
REM F1A00070
REM SECTION 1= READS IN AND CLASSIFIES STATEMENTS. FOR ARITHMETICF1A00080
REM FORMULAS, COMPILES THE OBJECT (OUTPUT) INSTRUCTIONS. FOR F1A00090
REM NONARITHMETIC STATEMENTS INCLUDING INPUT-OUTPUT, DOES A F1A00100
REM PARTIAL COMPILATION, AND RECORDS THE REMAINING INFORMATION F1A00110
REM IN TABLES. F1A00120
REM F1A00130
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A00140
REM F1A00150
SST FORTRAN $F1A00151
REM F1A00160
REM SYNONYMS USED BY SECTION ONE. F1A00170
A EQU 1 F1A00180
B EQU 2 F1A00190
C EQU 4 F1A00200
.. EQU 0 F1A00210
REM F1A00220
TAGA SYN 4 F1A00230
TAGB SYN 2 F1A00240
TAGC SYN 4 F1A00250
REM F1A00260
REM F1A00270
REM PARAMETERS VARIABLE AT ASSEMBLY TIME F1A00280
REM F1A00290
TMFACT SYN 7 CONSTANT FOR EXPANDING TABLE SIZES. $F1A00300
TNFACT SYN 8 CONSTANT FOR REDUCING TABLE SIZES $F1A00310
BMFACT SYN 7 $F1A00320
BNFACT SYN 8 $F1A00330
AMFACT SYN 7 $F1A00340
ANFACT SYN 8 $F1A00350
REM F1A00360
TOPTAB SYN BOTIOP-1 TOP OF AVAILABLE MEMORY. F1A00370
BOTMEM SYN BOTTOM BOTTOM OF AVAILABLE MEMORY. F1A00380
TITLE $F1A00385
EJECT F1A01150
REM F1A01160
REM DEFINITIONS OF TAPES FOR DUMPING THE CORE BUFFERS. F1A01170
REM F1A01180
CITTAP SYN 2 COMPAIL TAPE ADDRESS. F1A01190
TEIFTP SYN 3 TEIFNO. F1A01200
DOLPTP SYN 3 TDO. F1A01210
TIFGTP SYN 3 TIFGO. F1A01220
TRADTP SYN 3 TRAD. F1A01230
FRTGTP SYN 3 FORTAG. F1A01240
FRVRTP SYN 3 FORVAR. F1A01250
FRVLTP SYN 3 FORVAL. F1A01260
FRETTP SYN 3 FRET. F1A01270
EQITTP SYN 3 EQUIT. F1A01280
CLSBTP SYN 3 CLOSUB. F1A01290
FRMTTP SYN 3 FORMAT. F1A01300
SBDFTP SYN 3 SUBDEF. F1A01310
CMMNTP SYN 3 COMMON. F1A01320
HLRGTP SYN 3 HOLARG. F1A01330
NONXTP SYN 3 NONEXC. F1A01340
STOPTP SYN 3 TSTOPS. F1A01350
CALLTP SYN 3 CALLFN. F1A01360
FMTNTP SYN 3 FMTEFN. F1A01370
ENDITP SYN 3 ENDI. F1A01380
INPUTP SYN 2 BCD INPUT TAPE. F1A01390
EXEQTP SYN 4 EXECUTABLE STATEMENT INTERMEDIATE TAPE. F1A01400
BUFTAP SYN 3 CORE BUFFER DUMP TAPE. F1A01410
TABTAP SYN 2 TABLE TAPE. F1A01420
EJECT F1A01430
REM DEFINITIONS OF MAXIMUM SIZES FOR TAPE TABLES. F1A01440
REM F1A01450
FRMTMX SYN 6000*TMFACT/TNFACT NUMBER OF BCD WORDS IN FORMAT STATS. F1A01460
CLSBMX SYN 6000*TMFACT/TNFACT NUMBER OF SUBPROGRAMS. F1A01470
NONXMX SYN 1200*TMFACT/TNFACT NUMBER OF NON-EXECUTABLE STATEMENTS. F1A01480
STOPMX SYN 1200*TMFACT/TNFACT NUMBER OF STOP AND RETURN STATEMENTS.F1A01490
FMTNMX SYN 2000*TMFACT/TNFACT NUMBER OF REFERENCES TO FORMAT STATS.F1A01500
CALLMX SYN 2400*TMFACT/TNFACT NUMBER OF CALL STATEMENTS. (FUNCTION)F1A01510
HLRGMX SYN 3600*TMFACT/TNFACT NUMBER OF BCD WORDS USED AS HOLERITH F1A01520
REM ARGUMENTS FOR SUBROUTINES. F1A01530
DOLPMX SYN 600*TMFACT/TNFACT NUMBER OF DO LOOPS. F1A01540
FRVLMX SYN 2000*TMFACT/TNFACT NUMBER OF FIXED POINT VARIABLES (N-S)F1A01550
REM APPEARING TO THE LEFT OF EQUAL SIGNS.F1A01560
FRVRMX SYN 3000*TMFACT/TNFACT NUMBER OF FIXED POINT VARIABLES (N-S)F1A01570
REM APPEARING TO THE RIGHT OF EQUAL SIGNSF1A01580
FRTGMX SYN 6000*TMFACT/TNFACT NUMBER OF I-TAU TAGS. F1A01590
FRSBMX SYN 200*TMFACT/TNFACT NUMBER OF ARITHMETIC STAT. FUNCTIONS.F1A01600
SBDFMX SYN 180*TMFACT/TNFACT NUMBER OF SUBPROGRAM DEFINITIONS. F1A01610
TIFGMX SYN 1200*TMFACT/TNFACT NUMBER OF IF AND GO TO STATEMENTS. F1A01620
TRADMX SYN 1000*TMFACT/TNFACT NUMBER OF BRANCHES IN COMPUTED AND F1A01630
REM ASSIGNED GO TO'S. F1A01640
TEIFMX SYN 3000*TMFACT/TNFACT NUMBER EXTERNAL FORMULA NUMBERS. F1A01650
CMMNMX SYN 6000*TMFACT/TNFACT NUMBER OF COMMON VARIABLES. F1A01660
FRETMX SYN 3000*TMFACT/TNFACT NUMBER OF FREQUENCY ESTIMATES. F1A01670
EQITMX SYN 3000*TMFACT/TNFACT NUMBER OF EQUIVALENCED VARIABLES. F1A01680
ENDIMX SYN 36 NUMBER OF END CARD SETTINGS. F1A01690
FLCNMX SYN 1800*TMFACT/TNFACT NUMBER OF FLOATING POINT VARIABLES. F1A01700
FXCNMX SYN 400*TMFACT/TNFACT NUMBER OF FIXED POINT VARIABLES. F1A01710
TAU1MX SYN 400*TMFACT/TNFACT NUMBER OF 1 DIMENSIONAL SYMBOLIC TAGSF1A01720
TAU2MX SYN 360*TMFACT/TNFACT NUMBER OF 2 DIMENSIONAL SYMBOLIC TAGSF1A01730
TAU3MX SYN 300*TMFACT/TNFACT NUMBER OF 3 DIMENSIONAL SYMBOLIC TAGSF1A01740
DIM1MX SYN 400*TMFACT/TNFACT NUMBER OF ARRAYS OF 1 DIMENSION. F1A01750
DIM2MX SYN 400*TMFACT/TNFACT NUMBER OF ARRAYS OF 2 DIMENSIONS. F1A01760
DIM3MX SYN 360*TMFACT/TNFACT NUMBER OF ARRAYS OF 3 DIMENSIONS. F1A01770
DLT1MX SYN 150*TMFACT/TNFACT NUMBER OF DP-CA ARRAYS. F1A01780
DLT2MX SYN 400*TMFACT/TNFACT NUMBER OF DP-CA NON-SUBSCRIPTED F1A01790
REM VARIABLES. F1A01800
REM F1A01810
EJECT F1A01820
REM DEFINITIONS OF MAXIMUM SIZES FOR TABLE BUFFERS. F1A01830
REM F1A01840
FREGSZ SYN 111 SIZE OF FORMULA REGION. F1A01850
FTBFSZ SYN 12 FT BUFFER LENGTH. F1A01860
CITSIZ SYN 200 LENGTH OF EACH CIT BUFFER. F1A01870
BOLSIZ SYN 19 LENGTH OF BOOLEAN OPERATION CODE TABLE. F1A01880
BFSZ SYN 4000*BMFACT/BNFACT TEMPORARY FORMAT BUFFER. F1A01890
FRMTSZ SYN 200*BMFACT/BNFACT FORMAT. F1A01900
CLSBSZ SYN 200*BMFACT/BNFACT CLOSUB. F1A01910
NONXSZ SYN 250*BMFACT/BNFACT NONEXC. F1A01920
STOPSZ SYN 100*BMFACT/BNFACT TSTOPS. F1A01930
FMTNSZ SYN 200*BMFACT/BNFACT FMTEFN. F1A01940
CALLSZ SYN 200*BMFACT/BNFACT CALLFN. F1A01950
HLRGSZ SYN 200*BMFACT/BNFACT HOLARG. F1A01960
DOLPSZ SYN 100*BMFACT/BNFACT TDO. F1A01970
FRVLSZ SYN 150*BMFACT/BNFACT FORVAL. F1A01980
FRVRSZ SYN 300*BMFACT/BNFACT FORVAR. F1A01990
FRTGSZ SYN 600*BMFACT/BNFACT FORTAG. F1A02000
DLT1SZ SYN DLT1MX DLST1 (SIZ). F1A02010
DLT2SZ SYN DLT2MX DLST2 (SIZ). F1A02020
DIM1SZ SYN DIM1MX DIM1 (SIZ). F1A02030
DIM2SZ SYN DIM2MX DIM2 (SIZ). F1A02040
DIM3SZ SYN DIM3MX DIM3 (SIZ). F1A02050
FLCNSZ SYN FLCNMX FLOCON. F1A02060
FXCNSZ SYN FXCNMX FIXCON. F1A02070
TAU1SZ SYN TAU1MX TAU1 (I-TAU). F1A02080
TAU2SZ SYN TAU2MX TAU2 (I-TAU). F1A02090
TAU3SZ SYN TAU3MX TAU3 (I-TAU). F1A02100
FRSBSZ SYN FRSBMX FORSUB. F1A02110
SBDFSZ SYN SBDFMX SUBDEF. F1A02120
TRADSZ SYN 250*BMFACT/BNFACT TRAD. F1A02130
TIFGSZ SYN 300*BMFACT/BNFACT TIFGO. F1A02140
TEIFSZ SYN 600*BMFACT/BNFACT TEIFNO. F1A02150
CMMNSZ SYN 800*BMFACT/BNFACT COMMON. F1A02160
FRETSZ SYN 100*BMFACT/BNFACT FRET. F1A02170
EQITSZ SYN 350*BMFACT/BNFACT EQUIT. F1A02180
ENDISZ SYN ENDIMX END. F1A02190
ELSESZ SYN 3 COMPENSATING VARIABLE. F1A02200
OTHRSZ SYN 0 COMPENSATING VARIABLE. F1A02210
REM F1A02220
REM F1A02230
REM F1A02240
REM DEFINITIONS OF MAXIMUM SIZES FOR INTERNAL TABLES. F1A02250
REM F1A02260
LAMBSZ SYN 4800*AMFACT/ANFACT LAMBDA. F1A02270
SCRPSZ SYN LAMBSZ/2 OPTIMIZED LAMBDA. F1A02280
ALPHSZ SYN 556*AMFACT/ANFACT ALPHA. F1A02290
BETASZ SYN LAMBSZ/4 BETA. F1A02300
SGMASZ SYN 120*AMFACT/ANFACT SIGMA1. F1A02310
RGRGSZ SYN 200*AMFACT/ANFACT ARGREG. F1A02320
REM F1A02330
EJECT F1A02340
REM DEFINITION OF ORIGIN FOR TABLES AND BUFFERS (TABORG). F1A02350
REM F1A02360
TABLSA SYN 6*TAU3SZ+4*TAU2SZ+2*TAU1SZ+1+FXCNSZ+FLCNSZ F1A02370
TABLSB SYN 2*DLT1SZ+DLT2SZ+2*DIM1SZ+2*DIM2SZ+3*DIM3SZ F1A02380
TABLSC SYN LAMBSZ+BETASZ+SGMASZ F1A02390
TABLSD SYN CLSBSZ+SBDFSZ+ELSESZ F1A02400
TABLSE SYN NONXSZ+STOPSZ+FRETSZ+FRMTSZ+2*TIFGSZ+TRADSZ+5*DOLPSZ F1A02410
TABLSF SYN TEIFSZ+2*FRSBSZ+HLRGSZ+FMTNSZ+ENDISZ+CMMNSZ F1A02420
TABLSG SYN 2*FRVRSZ+2*FRVLSZ+FRTGSZ+2*EQITSZ+CALLSZ+OTHRSZ+2 F1A02430
TABLSH SYN TABLSA+TABLSB+TABLSC+TABLSD+TABLSE+TABLSF+TABLSG F1A02440
REM F1A02450
TABORG SYN TOPTAB-TABLSH ORIGIN FOR TABLE BUFFERS. F1A02460
TTL * SECTION ONE * COMMON BLOCK * RECORD 9F13 * F1A02550
REM F1A02570
ORG SYSCUR $F1A02580
LBL 9F13,THE WORKS F1A02590
BCI 1,9F1300 $F1A02600
ORG (LODR) $F1A02610
TXI INITIL,,130 ENTRY POINT,,RECORD NUMBER F1A02620
REM F1A02630
REM F1A02640
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A02650
REM F1A02660
ABS F1A02670
ORGONE ORG BOTMEM F1A02680
REM F1A02690
REM TABLE PARAMETERS FOR CORE AND TAPE TABLES GENERATED BY F1A02700
REM SECTION ONE. F1A02710
REM F1A02720
REM PARAMETERS FOR USE BY SECTION 1 PRIME AND 1 DOUBLE PRIME.F1A02730
REM F1A02740
REM F1A02750
REM WORD CONTAINING LAST EXTERNAL FORMULA NUMBER AND LAST F1A02760
REM INTERNAL FORMULA NUMBER. F1A02770
EIFNO PZE **,,** EXTERNAL,,INTERNAL FORMULA NUMBER. F1A02780
REM F1A02790
EIFLOC PZE **,TAGC,** LOCATION OF TEIFNO TABLE,,WORD COUNT F1A02800
TIFLOC PZE **,TAGB,** LOCATION OF TIFGO TABLE,,WORD COUNT F1A02810
TRDLOC PZE **,TAGB,** LOCATION OF TRAD TABLE,,WORD COUNT F1A02820
TDOLOC PZE **,TAGB,** LOCATION OF TDO TABLE,,WORD COUNT F1A02830
FRTLOC PZE **,TAGB,** LOCATION OF FRET TABLE,,WORD COUNT F1A02840
EQTLOC PZE **,TAGB,** LOCATION OF EQUIT TABLE,,WORD COUNT F1A02850
NXCLOC PZE **,TAGC,** LOCATION OF NONEXC TABLE,,WORD COUNT F1A02860
STPLOC PZE **,TAGC,** LOCATION OF TSTOPS TABLE,,WORD COUNT F1A02870
REM F1A02880
ONLINE PZE **,,** ON-LINE INDICATOR,,LOCATION OF CALL. F1A02890
REM F1A02900
REM PARAMETER FOR THE FORSUB TABLE. F1A02910
BK PZE **,,** FORSUB COUNTER. F1A02920
REM F1A02930
REM PARAMETER FOR THE COMPAIL (CIT) TABLE . F1A02940
CITCNT PZE **,,-20 COUNT OF REC. ON TAPE,,BUFFER INCREMENT $F1A02950
REM F1A02960
XEQCTR PZE ** COUNT OF EXECUTABLE STATEMENTS. F1A02970
REM F1A02980
DGFLAG PZE ** SIGNAL FOR PRIOR DIAGNOSTIC CALL. F1A02990
REM F1A03000
EJECT F1A03010
REM PARAMETERS FOR ALL TAPE TABLES EXCEPT COMPAIL (CIT) F1A03020
REM GENERATED BY SECTION ONE. F1A03030
REM ENTRIES ARE MADE IN THESE TABLES BY THE TET00 SUBROUTINE IN F1A03040
REM SECTION ONE. F1A03050
REM THE TAP00 SUBROUTINE IN SECTION ONE PRIME ASSEMBLES THE F1A03060
REM FRAGMENTS OF A GIVEN TABLE INTO AN ENTITY FOR LATER SECTIONS.F1A03070
REM F1A03080
REM EACH TABLE HAS AN IDENTIFICATION NUMBER WHICH IS ALSO AN F1A03090
REM INDEX TO ITS SET OF PARAMETERS IN THE FOLLOWING LIST. WHERE F1A03100
REM O = ORIGIN OF TABLE BUFFER, F1A03110
REM B = BUFFER CAPACITY, F1A03120
REM A = ADDRESS OF TABLE ENTRY, F1A03130
REM E = ENTRY LENGTH IN WORDS, F1A03140
REM C = COUNT OF BLOCKS PUT ON TAPE, F1A03150
REM P = PORTION OF BUFFER THAT IS FULL.F1A03160
REM T = TAPE FOR DUMPING BUFFERS. F1A03170
REM X = MARKS THE SPOT FOR ASSEMBLING F1A03180
REM THE TABLE IN SECTION I PRIME. F1A03190
REM M = MAXIMUM TABLE SIZE. F1A03200
REM N = NUMBER OF WORDS IN TABLE. F1A03210
REM L = LABEL ATTACHED TO THIS TABLE. F1A03220
REM F1A03230
INTETX PZE TEIFBF,TAGA,** 00) O,,P F1A03240
PZE EIFNO+1,TAGB,1 A,,E F1A03250
PZE TEIFSZ,,TEIFTP B,,T F1A03260
INTETA PZE TEIFNO,TAGC,TEIFMX X,,M F1A03270
PZE **,,** C,,N F1A03280
BCI 1,TEIFNO L F1A03290
REM F1A03300
PZE DOLPBF,TAGA,** 01) O,,P F1A03310
PZE 1C+5,TAGB,5 A,,E F1A03320
PZE DOLPSZ*5,,DOLPTP B,,T F1A03330
INTETB PZE TDOTAB,TAGC,DOLPMX*5 X,,M F1A03340
PZE **,,** C,,N F1A03350
BCI 1,TDO L F1A03360
REM F1A03370
PZE TIFGBF,TAGA,** 02) O,,P F1A03380
PZE 1C+2,TAGB,2 A,,E F1A03390
PZE TIFGSZ*2,,TIFGTP B,,T F1A03400
INTETC PZE TIFGOT,TAGC,TIFGMX*2 X,,M F1A03410
PZE **,,** C,,N F1A03420
BCI 1,TIFGO L F1A03430
REM F1A03440
PZE TRADBF,TAGA,** 03) O,,P F1A03450
PZE 1G+1,TAGB,1 A,,E F1A03460
PZE TRADSZ,,TRADTP B,,T F1A03470
INTETD PZE TRADTB,TAGC,TRADMX X,,M F1A03480
PZE **,,** C,,N F1A03490
BCI 1,TRAD L F1A03500
REM F1A03510
PZE FRTGBF,TAGA,** 04) O,,P F1A03520
PZE G+1,TAGB,1 A,,E F1A03530
PZE FRTGSZ,,FRTGTP B,,T F1A03540
INTETE PZE FORTAG,TAGC,FRTGMX X,,M F1A03550
PZE **,,** C,,N F1A03560
BCI 1,FORTAG L F1A03570
REM F1A03580
PZE FRVRBF,TAGA,** 05) O,,P F1A03590
PZE G+2,TAGB,2 A,,E F1A03600
PZE FRVRSZ*2,,FRVRTP B,,T F1A03610
INTETF PZE FORVAR,TAGC,FRVRMX*2 X,,M F1A03620
PZE **,,** C,,N F1A03630
BCI 1,FORVAR L F1A03640
REM F1A03650
PZE FRVLBF,TAGA,** 06) O,,P F1A03660
PZE G+2,TAGB,2 A,,E F1A03670
PZE FRVLSZ*2,,FRVLTP B,,T F1A03680
INTETG PZE FORVAL,TAGC,FRVLMX*2 X,,M F1A03690
PZE **,,** C,,N F1A03700
BCI 1,FORVAL L F1A03710
REM F1A03720
PZE FRETBF,TAGA,** 07) O,,P F1A03730
PZE 1G+1,TAGB,1 A,,E F1A03740
PZE FRETSZ,,FRETTP B,,T F1A03750
INTETH PZE FRETTB,TAGC,FRETMX X,,M F1A03760
PZE **,,** C,,N F1A03770
BCI 1,FRET L F1A03780
REM F1A03790
PZE EQITBF,TAGA,** 08) O,,P F1A03800
PZE 1C+2,TAGB,2 A,,E F1A03810
PZE EQITSZ*2,,EQITTP B,,T F1A03820
INTETI PZE EQUITT,TAGC,EQITMX*2 X,,M F1A03830
PZE **,,** C,,N F1A03840
BCI 1,EQUIT L F1A03850
REM F1A03860
CLSBCN PZE CLSBBF,TAGA,1 09( O,,P F1A03870
PZE G+1,TAGB,1 A,,E F1A03880
PZE CLSBSZ,,CLSBTP B,,T F1A03890
INTETJ PZE CLOSUB,TAGC,CLSBMX X,,M F1A03900
PZE **,,** C,,N F1A03910
BCI 1,CLOSUB L F1A03920
REM F1A03930
REM THE CLOSUB TABLE HAS ONE PRESET ENTRY OF (FPT). F1A03940
REM (FPT) IS A FLOATING POINT TRAP SUBROUTINE CALLED FOR F1A03950
REM BY MAIN PROGRAMS COMPILED BY FORTRAM. F1A03960
REM F1A03970
PZE FRMTBF,TAGA,** 10) O,,P F1A03980
PZE G+1,TAGB,1 A,,E F1A03990
PZE BFSZ,,FRMTTP B,,T F1A04000
INTETK PZE FORMAT,TAGC,FRMTMX X,,M F1A04010
PZE **,,** C,,N F1A04020
BCI 1,FORMAT L F1A04030
REM F1A04040
SBDFCN PZE SBDFBF,TAGA,** 11) O,,P F1A04050
PZE 1G+1,TAGB,1 A,,E F1A04060
PZE SBDFSZ,,SBDFTP B,,T F1A04070
INTETL PZE SUBDEF,TAGC,SBDFMX X,,M F1A04080
PZE **,,** C,,N F1A04090
BCI 1,SUBDEF L F1A04100
REM F1A04110
PZE CMMNBF,TAGA,** 12) O,,P F1A04120
PZE 1G+1,TAGB,1 A,,E F1A04130
PZE CMMNSZ,,CMMNTP B,,T F1A04140
INTETM PZE COMMON,TAGC,CMMNMX X,,M F1A04150
PZE **,,** C,,N F1A04160
BCI 1,COMMON L F1A04170
REM F1A04180
PZE HLRGBF,TAGA,** 13) O,,P F1A04190
PZE 1G+1,TAGB,1 A,,E F1A04200
PZE HLRGSZ,,HLRGTP B,,T F1A04210
INTETN PZE HOLARG,TAGC,HLRGMX X,,M F1A04220
PZE **,,** C,,N F1A04230
BCI 1,HOLARG L F1A04240
REM F1A04250
PZE NONXBF,TAGA,** 14) O,,P F1A04260
PZE EIFNO+1,TAGB,1 A,,E F1A04270
PZE NONXSZ,,NONXTP B,,T F1A04280
INTETO PZE NONEXC,TAGC,NONXMX X,,M F1A04290
PZE **,,** C,,N F1A04300
BCI 1,NONEXC L F1A04310
REM F1A04320
PZE STOPBF,TAGA,** 15) O,,P F1A04330
PZE EIFNO+1,TAGB,1 A,,E F1A04340
PZE STOPSZ,,STOPTP B,,T F1A04350
INTETP PZE TSTOPS,TAGC,STOPMX X,,M F1A04360
PZE **,,** C,,N F1A04370
BCI 1,TSTOPS L F1A04380
REM F1A04390
PZE CALLBF,TAGA,** 16) O,,P F1A04400
PZE CALLNM+1,TAGB,1 A,,E F1A04410
PZE CALLSZ,,CALLTP B,,T F1A04420
INTETQ PZE CALLFN,TAGC,CALLMX X,,M F1A04430
PZE **,,** C,,N F1A04440
BCI 1,CALLFN L F1A04450
REM F1A04460
PZE FMTNBF,TAGA,** 17) O,,P F1A04470
PZE SET+1,TAGB,1 A,,E F1A04480
PZE FMTNSZ,,FMTNTP B,,T F1A04490
INTETR PZE FMTEFN,TAGC,FMTNMX X,,M F1A04500
PZE **,,** C,,N F1A04510
BCI 1,FMTEFN L F1A04520
REM F1A04530
PZE 18) O,,P TSKIPS TABLE. F1A04540
PZE A,,E NOT USED IN F1A04550
PZE B,,T 709/7090 F1A04560
PZE X,,M FORTRAN. F1A04570
PZE C,,N F1A04580
BCI 1, L F1A04590
REM F1A04600
ENDICN PZE ENDIBF,TAGA,** 19) O,,P F1A04610
PZE G+1,TAGB,1 A,,E F1A04620
PZE ENDISZ,,ENDITP B,,T F1A04630
INTETT PZE ENDTAB,TAGC,ENDIMX X,,M F1A04640
PZE **,,** C,,N F1A04650
BCI 1,END L F1A04660
REM F1A04670
BSS 6 EXPANSION SPACE. F1A04680
EJECT F1A04690
REM PARAMETERS FOR ALL CORE TABLES WHICH ARE GENERATED AND F1A04700
REM SEARCHED BY THE TBSR00 (TABLE SEARCH) SUBROUTINE. F1A04710
REM ALL OF THESE TABLES AND THEIR PARAMETERS EXCEPT SIGMA ARE F1A04720
REM LEFT IN CORES FOR SECTION ONE PRIME. F1A04730
REM F1A04740
REM F1A04750
REM ENTRY TO THE TBSR00 ROUTINE IS BY TSX TO ....IX WHERE ....IX F1A04760
REM IS THE LAST WORD OF THE BLOCK OF PARAMETERS ASSOCIATED WITH F1A04770
REM A GIVEN TABLE. THE PARAMETERS ARE... F1A04780
REM *** = TXH/TXL OP SWITCH FOR DIMS, F1A04790
REM ARG1 = LOCATION OF 1ST ARGUMENT, F1A04800
REM L = LENGTH OF ARGUMENT, F1A04810
REM NCA = NEXT CORE ADDRESS, F1A04820
REM N = CURRENT NUMBER OF ENTRIES, F1A04830
REM FCA = 1ST CORE ADDRESS, F1A04840
REM J = MAXIMUM NUMBER OF ENTRIES, F1A04850
REM EP = ENTRY POINT TO TBSR00. F1A04860
REM ID = IDENTIFICATION FOR DIAG. F1A04870
REM F1A04880
REM F1A04890
TXL G+1,,1 FXCN) *** ARG1,,L F1A04900
PZE FXCNBF+1,,** NCA,,N F1A04910
PZE FXCNBF,,FXCNSZ FCA,,J F1A04920
FXCNIX TXI TBSR00,0,-11 TXI EP,,ID F1A04930
REM F1A04940
TXL G+1,,1 FLCN) *** ARG1,,L F1A04950
PZE FLCNBF+1,,** NCA,,N F1A04960
PZE FLCNBF,,FLCNSZ FCA,,J F1A04970
FLCNIX TXI CORR01,0,-10 TXI EP,,ID F1A04980
REM F1A04990
TXL E+3+2,,2 TAU1) *** ARG1,,L F1A05000
PZE TAU1BF+2,,** NCA,,N F1A05010
PZE TAU1BF,,TAU1SZ FCA,,J F1A05020
TAU1IX TXI TBSR00,0,-9 TXI EP,,ID F1A05030
REM F1A05040
TXL E+3+4,,4 TAU2) *** ARG1,,L F1A05050
PZE TAU2BF+4,,** NCA,,N F1A05060
PZE TAU2BF,,TAU2SZ FCA,,J F1A05070
TAU2IX TXI TBSR00,0,-8 TXI EP,,ID F1A05080
REM F1A05090
TXL E+3+6,,6 TAU3) *** ARG1,,L F1A05100
PZE TAU3BF+6,,** NCA,,N F1A05110
PZE TAU3BF,,TAU3SZ FCA,,J F1A05120
TAU3IX TXI TBSR00,0,-7 TXI EP,,ID F1A05130
REM F1A05140
TXLOP TXL E+11+1,,1 SIG1) *** ARG1,,L F1A05150
PZE **,,** NCA,,N F1A05160
PZE SIGMA1,,SGMASZ FCA,,J F1A05170
SIG1IX TXI TBSR00,0,-6 TXI EP,,ID F1A05180
REM F1A05190
TXHOP TXH 1C+2,,2 DIM1) *** ARG1,,L F1A05200
PZE DIM1BF+2,,** NCA,,N F1A05210
ORGDM1 PZE DIM1BF,,DIM1SZ FCA,,J F1A05220
DIM1IX TXI TBSR00,0,-3 TXI EP,,ID F1A05230
REM F1A05240
TXH 1C+2,,2 DIM2) *** ARG1,,L F1A05250
PZE DIM2BF+2,,** NCA,,N F1A05260
ORGDM2 PZE DIM2BF,,DIM2SZ FCA,,J F1A05270
DIM2IX TXI TBSR00,0,-2 TXI EP,,ID F1A05280
REM F1A05290
TXH 1C+3,,3 DIM3) *** ARG1,,L F1A05300
PZE DIM3BF+3,,** NCA,,N F1A05310
PZE DIM3BF,,DIM3SZ FCA,,J F1A05320
DIM3IX TXI TBSR00,0,-1 TXI EP,,ID F1A05330
REM F1A05340
TXH 1C+2,,2 DLT1) *** ARG1,,L F1A05350
PZE DLT1BF+2,,** NCA,,N F1A05360
PZE DLT1BF,,DLT1SZ FCA,,J F1A05370
DLIST1 TXI TBSR00,,-12 TXI EP,,ID F1A05380
REM F1A05390
TXL E+3,,1 DLT2) *** ARG1,,L F1A05400
PZE DLT2BF+1,,** NCA,,N F1A05410
PZE DLT2BF,,DLT2SZ FCA,,J F1A05420
DLIST2 TXI TBSR00,0,-13 TXI EP,,ID F1A05430
REM F1A05440
BSS 4 EXPANSION SPACE. F1A05450
REM F1A05460
REM TEST FOR IMPROPERLY WRITTEN COMPLEX CONSTANT WHICH IS F1A05470
REM ABOUT TO BE ENTERED AS A SINGLE PRECISION STANDARD F1A05480
REM FORTRAN CONSTANT. F1A05490
CORR01 CLA MODECL F1A05500
SUB L(I) TEST FOR CA MODE F1A05510
TNZ TBSR00 NO, CONTINUE F1A05520
TRA ICM6 YES, ERROR, GO TO DIAGNOSTIC F1A05530
EJECT F1A05540
REM MACHINE ERROR CALLS TO DIAGNOSTIC. F1A05550
REM F1A05560
REM F1A05570
MRTN77 TXI (DIAG),,0 *GO TO MACHINE ERROR DIAGNOSTIC. F1A05580
REM CHARACTER IN AC IS GREATER THAN 77 OCTAL. F1A05590
REM SECTION ONE SCANS A SATEMENT 1 CHARACTER AT A TIME. F1A05600
REM THE AC WAS CLEARED PRIOR TO SHIFTING IN THE CURRENT F1A05610
REM SIX BITS. A COMPARISION WAS MADE WITH A CELL CONTAINING F1A05620
REM THE NUMBER 77 OCTAL AND THE AC GREATER THAN BRANCH WAS F1A05630
REM TAKEN. 77 OCTAL IS AN INTERNAL CHARACTER USED AS AN F1A05640
REM END OF STATEMENT FLAG. F1A05650
REM F1A05660
OCTL12 TXI (DIAG),,0 *GO TO MACHINE ERROR DIAGNOSTIC. F1A05670
REM STATEMENT SCAN IS THE SAME THE ONE DESCRIBED IN MRTN77 F1A05680
REM ERROR. HOWEVER, THIS TIME THE AC CONTAINS THE NUMBER F1A05690
REM 12 OCTAL, AN ILLEGAL CHARACTER IN ANY SENSE. F1A05700
REM F1A05710
TXI (DIAG),,0 NOT USED. F1A05720
REM F1A05730
TXI (DIAG),,0 NOT USED. F1A05740
REM F1A05750
REM F1A05760
REM F1A05770
REM F1A05780
REM F1A05790
REM CALLS TO THE SECTION I DIAGNOSTIC THAT WOULD F1A05800
REM FALL INTO DUPLICATE LOCATION NUMBERS IN F1A05810
REM RECORDS 9F10 AND 9F11. F1A05820
REM F1A05830
ER0033 TSX DIAG,4 *N.A. STATEMENT NOT FOUND IN DICTIONARY. F1A05840
REM F1A05850
BSS 4 ADDITIONAL SPACE. F1A05860
REM F1A05870
EJECT F1A05880
REM F1A05890
REM RE-ENTRY TO PASS1 OR PASS 2. F1A05900
REM F1A05910
PASS1 TXH PASS2,,0 (TXH-TXL) SWITCH FOR PASS 1 OR PASS 2. F1A05920
LXD LDFT2,4 HAS AN EOF BEEN SENSED ON BCD INPUT TAPE. F1A05930
TXH LDFR0,4,0 *NO, GET NEXT STATEMENT. F1A05940
TRA CLOSP1 *YES, CLOSE OUT PASS 1 AND GET PASS 2. F1A05950
REM F1A05960
REM *************************************************************F1A05961
REM F1A05962
REM CIT00 / CALLS I/O ROUTINE. F1A05970
REM F1A05980
REM ENTERS FOUR WORD CITS INTO THE CIT BUFFER AND F1A05990
REM DUMPS A BUFFER WHEN IT BECOMES FULL. F1A06000
REM THE ROUTINE ALSO MAPS ARITHMETIC INSTRUCTIONS F1A06010
REM INTO BOOLEAN OPERATIONS IF THE CURRENT STATEMENT F1A06020
REM MODE IS BOOLEAN. F1A06030
REM F1A06040
CIT00 ZET DGFLAG HAS THERE BEEN A DIAGNOSTIC. F1A06050
TRA BERPCH GO TO BOOLEAN TEST PATCH $F1A06060
SXA CITJ1,1 SAVE IR1 AND IR2. F1A06070
SXA CITJ2,2 F1A06080
TRA COMP1 TEST FOR FUNCTION OR SUBROUTINE $F1A06090
ZET *+1 IS THIS A CLOSE OUT CALL. F1A06100
CITA0 TXH CITC0,2,-CITSIZ NO, IS THE BUFFER FULL. F1A06110
SXA CITB0,4 YES. F1A06120
LXA CITD0,1 GET CURRENT BUFFER ORIGIN. F1A06130
SXA CIT01,1 SET IN I/O COMMAND. F1A06140
TXL CITB0,2,0 *NOTHING TO WRITE. F1A06150
PXD ,2 GET TRUE NUMBER. F1A06160
PDC ,2 F1A06170
SXD CIT01,2 SET I/O COMMAND WORD COUNT. F1A06180
TSX (TAPE),4 WRITE CIT RECORD. F1A06190
PZE CIT01,,(WBNP) F1A06200
PZE CIT02,,CITTAP F1A06210
CLA CITCNT INCREMENT CIT RECORD COUNT. F1A06220
ADD L(1) F1A06230
STO CITCNT F1A06240
TXL *+2,1,CITBUF SET NEW BUFFER ORIGIN. F1A06250
TXI *+2,1,-CITSIZ F1A06260
TXI *+1,1,CITSIZ F1A06270
SXA CITD0,1 SET ADDRESSES IN ROUTINE. F1A06280
TXI *+1,1,1 F1A06290
SXA CITE0,1 F1A06300
TXI *+1,1,-4 F1A06310
SXA CITF0,1 F1A06320
CITB0 AXT **,4 RESTORE LINKAGE. F1A06330
AXT 0,2 RESET BUFFER INCREMENT. F1A06340
NZT CITA0 IS THIS A CLOSE OUT CALL. F1A06350
TRA CITJ0 YES. F1A06360
CITC0 AXT 2,1 NO, LOAD LOOP COUNT. F1A06370
CITC1 CAL* 1,4 GET FIRST (OR THIRD) WORD OF CIT. F1A06380
CITD0 SLW CITBUF,2 STORE IN CURRENT BUFFER. F1A06390
CLA 1,4 GET ADDRESS OF SECOND (OR FOURTH) F1A06400
ARS 18 WORD OF CIT. F1A06410
STA *+1 F1A06420
CAL ** GET WORD. F1A06430
CITE0 SLW CITBUF+1,2 STORE IN CURRENT BUFFER. F1A06440
TXI *+1,2,-2 INCREMENT BUFFER INDEX. F1A06450
TXI *+1,4,-1 INCREMENT LINKAGE ADDRESS. F1A06460
TIX CITC1,1,1 GET NEXT TWO WORDS OF CIT. F1A06470
CAL MODECL IS THIS A BOOLEAN STATEMENT. F1A06480
ERA L(B) F1A06490
TNZ CITJ0 *NO. F1A06500
CITF0 CAL CITBUF-3,2 YES, GET THE OPERATION CODE. F1A06510
LAS ALL1 IS THIS AN ARITHMETIC STATEMENT FUNCTION. F1A06520
TRA *+2 NO. F1A06530
TRA CITJ0 YES, DO NOT MODIFY FLAG. F1A06540
SLW ERASE SAVE DECREMENT, IF ANY. F1A06550
AXT BOLSIZ,1 LOAD COUNT OF BOOLEAN OPERATION CODES. F1A06560
CITG0 LDQ BTABL,1 GET FIRST (OR NEXT) DICTIONARY WORD AND F1A06570
SLQ ERASE SPLIT OF ALGEBRAIC OPERATION CODE. F1A06580
LAS ERASE ARE OPERATION CODES IDENTICAL. F1A06590
TRA *+2 NO. F1A06600
TRA CITH0 YES, MAP LOGICAL COUNTER PART. F1A06610
TIX CITG0,1,1 NO, CONTINUE COMPARISON. F1A06620
BER001 TSX DIAG,4 OPERATION CODE NOT IN DICTIONARY. F1A06630
CITH0 LGL 18 MOVE LOGICAL COUTERPART INTO DECREMENT. F1A06640
SLQ* CITF0 SET LOGICAL COUNTERPART IN CURRENT CIT. F1A06650
CITJ0 SXD CITCNT,2 SAVE BUFFER INCREMENT. F1A06660
CITJ1 AXT **,1 RESTORE INDICES. F1A06670
CITJ2 AXT **,2 F1A06680
TRA 1,4 RETURN TO CALLER. F1A06690
REM F1A06700
CIT01 IORT **,,** I/O COMMAND FOR WRITING CITS. F1A06710
CIT02 BCI 1,COMAIL COMPAIL LABEL. F1A06720
REM F1A06730
REM F1A06740
REM TABLE OF CORRESPONDENCE BETWEEN REAL ALGEBRA AND BOOLEAN. F1A06750
REM F1A06760
BSS 5 SPACE FOR POSSIBLE ADDITIONAL ENTRIES... F1A06770
BCD 1CHSCOM F1A06780
BCD 1CLACAL F1A06790
BCD 1CLSCAL F1A06800
BCD 1FADORA F1A06810
BCD 1FMPANA F1A06820
BCD 1STOSLW F1A06830
BCD 1COMCOM F1A06840
BCD 1LDQLDQ F1A06850
BCD 1SXDSXD F1A06860
BCD 1TSXTSX F1A06870
BCD 1LXDLXD F1A06880
BCD 1PXAPXA F1A06890
BCD 1SUBSUB F1A06900
BCD 1STASTA F1A06910
BCD 1STQSTQ F1A06920
BCD 1TRATRA F1A06930
BCD 1PZEPZE F1A06940
BCD 1XCAXCA F1A06950
BCD 1NTRNTR F1A06960
BTABL SYN * F1A06970
REM F1A06980
BOOLIN PZE 0 CELL FOR BOOLEAN INDICATOR. F1A06990
REM F1A07000
REM *************************************************************F1A07001
REM F1A07002
REM TET00 / CALLS I/O ROUTINE. F1A07010
REM F1A07020
REM MAKES ENTRIES INTO THE CORE BUFFERS FOR F1A07030
REM VARIOUS TABLES AND DUMPS A BUFFER WHEN F1A07040
REM IT BECOMES FULL. F1A07050
REM F1A07060
TET00 ZET DGFLAG HAS THERE BEEN A DIAGNOSTIC. F1A07070
TRA 2,1 *YES, DO NOT MAKE ENTRY. F1A07080
SXA TETX1,1 SAVE INDICES. F1A07090
SXA TETX2,2 F1A07100
SXA TETX4,4 F1A07110
STQ TEMP SAVE CONTENTS OF MQ. F1A07120
LDQ 1,1 GET TABLE IDENTIFICATION. F1A07130
STQ TABNUM SAVE FOR POSSIBLE WRITE. F1A07140
MPY L(6) F1A07150
XCA F1A07160
PAC ,1 F1A07170
CLA INTETX,1 GET COUNT OF WORDS IN BUFFER. F1A07180
STD TETA0 SET TEST FOR FULL BUFFER. F1A07190
CLA INTETX+2,1 GET MAXIMUM BUFFER LENGTH. F1A07200
PAX ,2 LOAD BUFFER LENGTH. F1A07210
ZET TETCL IS THIS A CALL TO CLOSE OUT BUFFER. F1A07220
TETA0 TXH TETC0,2,** *NO, IS BUFFER FULL. F1A07230
STD TETB1 YES, SET TAPE ADDRESS. F1A07240
CLA INTETX,1 GET BUFFER ADDRESS AND WORD COUNT. F1A07250
STA TETIO+1 SET I/O COMMAND FOR WRITING. F1A07260
STD TETIO+1 F1A07270
ANA 1BAR F1A07280
TZE TETB2 *WORD COUNT OF BUFFER ZERO, NIL TO WRITE. F1A07290
CLA INTETX+4,1 INCREMENT COUNT OF BUFFERS. F1A07300
ADD L(1) DUMPED ON TAPE. F1A07310
STA INTETX+4,1 SAVE COUNT. F1A07320
PAX ,4 SET BUFFER NUMBER IN RECORD LABEL. F1A07330
ADD TETA0 UPDATE COUNT OF WORDS ON TAPE. F1A07340
STD INTETX+4,1 F1A07350
SXD TABNUM,4 F1A07360
TSX (TAPE),4 DUMP BUFFER ON DESIGNATED TAPE. F1A07370
TETB0 PZE TETIO,,(WBNC) OPERATION CODE MAY BECOME A PROCEED. F1A07380
TETB1 PZE INTETX+5,1,** F1A07390
SXA TETFLG,4 RESET NO DUMP FLAG. F1A07400
TETB2 CLA TETCL IS THIS A CALL TO CLOSE OUT BUFFER. F1A07410
TZE TETE0 *YES, DO NOT MAKE AN ENTRY. F1A07420
STD TETA0 NO, RESET COUNT OF WORDS IN BUFFER. F1A07430
TETC0 LDC TETA0,4 LOAD 2S COMPLEMENT OF BUFFER WORD COUNT. F1A07440
CLA INTETX+1,1 GET COUNT OF WORDS IN THIS TABLE ENTRY. F1A07450
PDX ,2 LOAD ENTRY LENGTH. F1A07460
TETD0 CAL* INTETX+1,1 GET A WORD OF THIS ENTRY. F1A07470
SLW* INTETX,1 STORE IN TABLE BUFFER. F1A07480
TXI *+1,4,-1 INCREMENT BUFFER REFERENCE. F1A07490
TIX TETD0,2,1 DECREMENT ENTRY REFERENCE AND TEST COUNT. F1A07500
CAL TETA0 UPDATE COUNT OF WORDS IN BUFFER. F1A07510
ADD INTETX+1,1 F1A07520
TETE0 STD INTETX,1 F1A07530
TETX1 AXT **,1 RESTORE INDICES. F1A07540
TETX2 AXT **,2 F1A07550
TETX4 AXT **,4 F1A07560
LDQ TEMP RESTORE CONTENTS OF MQ. F1A07570
TRA 2,1 *RETURN TO CALLER. F1A07580
REM F1A07590
TETFLG PZE ** BUFFER DUMP FLAG. F1A07600
TETCL PZE -1 CLOSE OUT BUFFER FLAG. F1A07610
REM F1A07620
TETIO IOCP TABNUM,,1 I/O COMMAND TO WRITE LABEL. F1A07630
IOCT **,,** I/O COMMAND TO WRITE BUFFER. $F1A07640
REM F1A07650
REM *************************************************************F1A07651
RP2I CLA PS2L SET EXIT TO PASS TWO $F1A07653
TRA *+2 $F1A07657
D12CS CLA DIAGL SET EXIT TO SECTION ONE DIAGNOSTIC. $F1A07660
STO 1TOCS+1 SETS EXIT FOR DISKS. $F1A07665
1TOCS TSX (LOAD),4,1 CALLS THE ONE TO CS ROUTINE. $F1A07670
PZE F1A07680
REM F1A07690
REM *************************************************************F1A07691
REM F1A07700
REM SUBROUTINE TO CALL THE SECTION I DIAGNOSTIC. F1A07710
REM F1A07720
P1DXIT AXT 0,4 SET END OF SECTION ONE FLAG FOR DIAG. F1A07730
REM F1A07740
DIAG SXD ONLINE,4 SAVE LOCATION OF CALL. F1A07750
NZT *+2 IS SYSTEM TAPE POSITIONED AT DIAGNOSTIC. F1A07760
TRA 1TOCS-2 *YES, READ IN DIAGNOSTIC. $F1A07770
DGX1 TSX (TAPE),4 NO, SPACE OVER PASS 2. F1A07780
PZE FRSP,,(SKBP) F1A07790
PZE ,,SYSTAP F1A07800
TRA 1TOCS-2 * READ IN DIAGNOSTIC. $F1A07810
DIAGL BCI 1,9F1500 $F1A07813
PS2L BCI 1,9F1400 $F1A07817
REM F1A07820
REM *************************************************************F1A07821
REM F1A07822
REM I/O COMMANDS USED BY PASS 2. F1A07830
REM F1A07840
REM F-REGION AND CONTROL INFORMATION. F1A07850
REM F1A07860
IORT FREGON-4,,FREGSZ+4 LOADS BUFFER 1. F1A07870
DCF PZE **,2,-FREGON ORIGIN OF CURRENT F-REGION,,2S COMPLIMENT.F1A07880
IORT FREGON+FREGSZ,,FREGSZ+4 LOADS BUFFER 2. F1A07890
REM F1A07900
REM CURRENT CONTROL WORDS. F1A07910
REM F1A07920
TLABEL PZE **,,** PROCESSOR ADDRESS,,F-SCAN POSITION. F1A07930
MODECL PZE ** MODE INDICATOR. F1A07940
EFN PZE **,,0 EXTERNAL FORMULA NUMBER IN BINARY (IF ANY)F1A07950
FIRST5 PZE ** FIRST 5 CHARACTERS OF STATEMENT IN BCD. F1A07960
REM F1A07970
REM F-REGION DEFINITION - FORMULA REGION. F1A07980
BEGFRG SYN * ORIGIN OF FT-REGION. F1A07990
BSS 4 CONTROL WORD RESERVATION. F1A08000
FREGON BSS FREGSZ STATEMENT RESERVATION. F1A08010
FRGBF2 SYN * ORIGIN OF SECOND F-REGION BUFFER. F1A08020
BSS FREGSZ+4 BUFFER 2 FOR F-REGION. F1A08030
REM F1A08040
ENDFRG SYN * END OF F-REGION. F1A08050
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A08060
REM F1A08070
REM COMMON/3-CONSTANTS AND VARIABLES= F1A08080
REM F1A08090
COMCON BSS 0 F1A08100
REM F1A08110
FRSP PZE 1,,0 CONTROL WORD TO FORWARD SPACE 1 RECORD. F1A08120
BKSP MZE 1,,0 CONTROL WORD TO BACKSPACE 1 RECORD. F1A08130
REWD PZE ,,-1 CONTROL WORD TO REWIND TAPE. F1A08140
REM F1A08150
TRAILR IOCP ALL1,,1 F1A08160
IOCP ALL1,,1 F1A08170
IOCP ALL1,,1 F1A08180
IOCT ALL1,,1 $F1A08190
TRAIL BCI 1,MARKER F1A08200
REM F1A08210
WTXQ5 BCI 1,EXEQ LABEL FOR EXEQUTABLE STATEMENT RECORDS. F1A08220
EXEQF BCI 1,EOF 1 END-OF-FILE LABEL. F1A08230
REM F1A08240
REM *************************************************************F1A08250
REM F1A08260
TEN OCT 12 (1010) - CTEST-11 F1A08270
ENDMK OCT 77 111111 - CTEST-10 F1A08280
OPEN OCT 74 ( - CTEST-9 F1A08290
COMMA OCT 73 , - CTEST-8 F1A08300
CLOS OCT 34 ) - CTEST-7 F1A08310
EQUAL OCT 13 = - CTEST-6 F1A08320
11Z OCT 40 - - CTEST-5 F1A08330
SLASH OCT 61 / - CTEST-4 F1A08340
POINT OCT 33 . - CTEST-3 F1A08350
12Z OCT 20 + - CTEST-2 F1A08360
STAR OCT 54 * - CTEST-1 F1A08370
CTEST BSS 0 ADDRESS USED FOR INDEXING ABOVE. F1A08380
REM F1A08390
MASK2 OCT 77777 2**15-1 -ARITHMETIC. F1A08400
L(0) BCD 1000000 0 F1A08410
L(1) BCD 1000001 1 F1A08420
L(2) BCD 1000002 2 F1A08430
L(3) BCD 1000003 3 F1A08440
L(4) BCD 1000004 4 F1A08450
L(5) BCD 1000005 5 F1A08460
L(6) BCD 1000006 6 F1A08470
L(7) BCD 1000007 7 F1A08480
L(8) BCD 1000008 8 F1A08490
L(9) BCD 1000009 9 F1A08500
MINUS OCT 14 - F1A08510
L(A) BCD 100000A F1A08520
L(B) BCD 100000B F1A08530
L(C) BCD 100000C CONSTANT USED BY PASS1 AND DIAG. F1A08540
L(D) BCD 100000D F1A08550
L(F) BCD 100000F CONSTANT USED BY PASS2 AND DIAG. F1A08560
L(H) BCD 100000H H F1A08570
L(I) BCD 100000I F1A08580
L(L) BCD 100000L F1A08590
L(O) BCD 100000O O (ALPHABETIC) F1A08600
SPECOP OCT 53 00000$ F1A08610
BLANK OCT 60 000000000060 F1A08620
IFSYM OCT 6712 CONSTANT USED BY PASS2 AND DIAG. F1A08630
IFSYM2 OCT 671260606060 F1A08640
CALLSM OCT 711260606060 F1A08650
CALLER OCT 7112 CONSTANT USED BY PASS2 AND DIAG. F1A08660
2E18 OCT 1000000 DECREMENT=1 F1A08670
5BLANS BCD 10 006060606060 F1A08680
1BAR OCT 77777000000 (2**15-1)*2**18DECREMENT MASK. F1A08690
BLANKS BCD 1 606060606060 F1A08700
ALL1 OCT -377777777777 END OF STATEMENT WORD. F1A08710
MAXIMA OCT 077777777777 F1A08720
COMVAR BSS 0 F1A08730
ARGCNT PZE 4,,1 ARGUMENT COUNTER USED BY C30,C32. F1A08740
SET PON .. VARIABLE USED TO COMPILE 8).... F1A08750
REM END OF COMMON CONSTANTS AND VARIABLES. F1A08760
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A08770
REM F1A08780
REM COMMON/4-SUBROUTINES USED BY SECTION ONE= F1A08790
REM F1A08800
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A08810
REM F1A08820
REM C0160,2/ CALLS=C0190,DIAG. F1A08830
REM C0160 ASSEMBLES LEFT-ADJUSTED IN 1G, THE CHAR IN THE AC AND F1A08840
REM SUCCESSIVE NB CHARS STARTING IN THE MQ, UNTIL A ,()= OR ENDMKF1A08850
REM IS MET AND LEFT IN THE AC. ALSO MARKS END OF WORD WITH A F1A08860
REM BLANK, IF LESS THAN 6 CHARACTERS. F1A08870
C0160 SXD C016X,2 SAVE THE C(XR2), AND F1A08880
LXA L(0),2 SET XR2 TO CONTROL SHIFTING. F1A08890
STZ 1G CLEAR WORKING STORAGE. F1A08900
TSX TESTH0,4 TEST FIRST CHARACTER FOR NUMERIC, ERROR. F1A08910
C0161 AXT CTEST-ENDMK,4 TEST F1A08920
C0162 CAS CTEST,4 CHARACTER F1A08930
C016X TXI C0163,0,** IN THE AC F1A08940
FWA TXI C0165,0,** AGAINST F1A08950
C0163 TIX C0162,4,1 ALL PUNCTUATION. F1A08960
TXL C0164,2,30 IF SYMBOL EXCEEDS 6 CHARACTERS, F1A08970
ER0001 BSS 0 F1A08980
TSX DIAG,4 * GO TO THE DIAGNOSTIC. F1A08990
C0164 ALS 30,2 BUILD LEFT-ADJUSTED F1A09000
ORS 1G SYMBOL IN WORKING STORAGE. F1A09010
TSX C0190,4 * GET NEXT NB CHARACTER IN THE AC. F1A09020
TXI C0161,2,6 UPDATE SHIFT COUNT, AND CONTINUE. F1A09030
C0165 TXH C0167,2,0 IF PUNCTUATION IS 1ST CHARACTER, F1A09040
ER0002 BSS 0 F1A09050
C0166 TSX DIAG,4 * OR ILLEGAL, GO TO THE DIAGNOSTIC. F1A09060
C0167 TXL C0166,4,5 IF LEGAL PUNCTUATION, THEN F1A09070
STO 1H SAVE, AND F1A09080
PXD ,0 F1A09090
LDQ BLANKS COMPLETE VARIABLE NAMES LESS THAN SIX CHAR-F1A09100
LGL 36,2 ARCTERS WITH BCD BLANKS. F1A09110
ORS 1G THAN 6 CHARACTERS IN LENGTH. F1A09120
CLA 1H PICKUP PUNCTUATION MARK, F1A09130
LXD C016X,2 RESTORE THE C(XR2), AND F1A09140
TRA 1,2 * RETURN TO CALLER. F1A09150
REM END OF PROGRAM C0160. F1A09160
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A09170
REM F1A09180
REM C0180,2/ CALLS=C0190. F1A09190
REM C0180 CONVERTS SUCCESSIVE NUMERICS STARTING IN THE AC TO F1A09200
REM BINARY, PLACES RESULT IN 1G, AND LEAVES 1ST NON-NUMERIC IN ACF1A09210
C0180X TSX C0190,4 * OBTAIN 1ST NUMERIC IN THE AC. F1A09220
C0180 TSX TESTI0,4 TEST CHARACTER FOR NUMERIC. F1A09230
C0181 STO 1G PLACE 1ST NUMERIC IN 1G. F1A09240
TSX C0190,4 * EXAMINE NEXT NON-BLANK CHARACTER, F1A09250
CAS L(9) AND IF NON-NUMERIC, THEN F1A09260
TRA 1,2 * RETURN TO CALLER. F1A09270
NOP IF NUMERIC, THEN F1A09280
STO 2G SAVE DIGIT IN 2G. F1A09290
CLA 1G MULTIPLY F1A09300
ALS 2 C(1G) F1A09310
ADD 1G BY F1A09320
ALS 1 10, F1A09330
ADD 2G AND ADD CURRENT DIGIT. F1A09340
TXI C0181,0,0 REPEAT PROCESS FOR NEXT CHARACTER. F1A09350
REM END OF PROGRAM C0180. F1A09360
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A09370
REM F1A09380
REM C0190X,4/ F1A09390
REM C0190X INITIALIZES C0190 TO OBTAIN 1ST WORD OF FORMULA IN F. F1A09400
C0190X CLA DCF SET FORMULA WORD ADDRESS F1A09410
STD FWA TO THE FIRST WORD OF F-REGION. F1A09420
SXA XCHCTR,0 SET CHARACTER COUNT TO ZERO. F1A09430
TRA 1,4 * RETURN TO MAIN ROUTINE. F1A09440
REM END OF PROGRAM C0190X. F1A09450
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A09460
REM F1A09470
REM C0390,4/ F1A09480
REM C0390 INSERTS THE CHARACTER IN THE AC INTO THE 1ST POSITION F1A09490
REM TO THE LEFT OF THAT DEFINED BY FWA AND XR1. F1A09500
C0390 CLA ENDMK PREPARE TO CHANGE F1A09510
LXD FWA,2 THE PROPER CHARACTER F1A09520
LXA XCHCTR,1 IN THE F-REGION. F1A09530
TNX C0393,1,1 ADJUST MASK F1A09540
C0392 LGL 6 TO POSITION F1A09550
TIX C0392,1,1 CHARACTER. F1A09560
C0393 COM INVERT MASK, AND F1A09570
ANS -1,2 ERASE PROPER CHARACTER. F1A09580
XCL MOVE TO AC AND F1A09590
ORS -1,2 INSERT IN ERASED POSITION. F1A09600
REM C0390 CONTINUES BY USING C0190. F1A09610
REM F1A09620
REM C0190,4/ F1A09630
REM C0190 OBTAINS IN AC THE NEXT NON-BLANK CHARACTER OF FORMULA. F1A09640
C0190 SXA C0194,1 SAVE C(IR1). F1A09650
XCHCTR AXT **,1 LOAD CHARACTER COUNT. F1A09660
LDQ RESIDU PICK UP ANY REMAINING CHARACTERS. F1A09670
C0191 TIX C0193,1,1 IF NONE, F1A09680
LXD FWA,1 PICK UP NEXT FORMULA F1A09690
LDQ 0,1 WORD FROM F-REGION, F1A09700
TXI C0192,1,-1 AND INCREASE F1A09710
C0192 SXD FWA,1 FORMULA WORD ADDRESS BY 1. F1A09720
AXT 6,1 RESET IR1 FOR 6 NEW CHARACTERS. F1A09730
C0193 PXD ,0 EXAMINE F1A09740
LGL 6 NEXT CHARACTER F1A09750
CAS BLANK AND COMPARE WITH A BLANK. F1A09760
TRA C0195 IF BLANK F1A09770
TRA C0191 GO EXAMINE NEXT CHARACTER. F1A09780
C0195 SXA XCHCTR,1 IF NOT BLANK, SAVE CHARACTER COUNT. F1A09790
STQ RESIDU SAVE ANY REMAINING CHARACTERS, F1A09800
C0194 AXT **,1 RESTORE C(IR1). F1A09810
TRA 1,4 * RETURN TO MAIN ROUTINE. F1A09820
REM END OF PROGRAM C0190. F1A09830
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A09840
REM F1A09850
REM DIM.SR,4/ CALLS=DIAG. F1A09860
REM DIM.SR SEARCHS THE DIMENSION TABLES. ENTRANCE IS TO DIM1SR, F1A09870
REM DIM2SR, OR DIM3SR ACCORDING TO THE DIMENSION. F1A09880
REM DIM1SR= ENTRY POINT FOR 1 DIMENSION TABLE. F1A09890
DIM1SR SXA DIMXR4,4 F1A09900
LXD DIM1IX-2,4 GET NO OF ENTRIES IN DIM1. F1A09910
CLA ORGDM1 GET ORIGIN ADDRESS OF DIM1 TABLE. F1A09920
TXI DMSR00,0,0 F1A09930
REM DIM2SR= ENTRY POINT FOR 2 DIMENSION TABLE. F1A09940
DIM2SR SXA DIMXR4,4 F1A09950
LXD DIM2IX-2,4 GET NO OF ENTRIES IN DIM2. F1A09960
CLA ORGDM2 GET ORIGIN ADDRESS OF DIM2 TABLE. F1A09970
DMSR00 STA DMSR01 SET ADDRESS OF COMPARISON TEST. F1A09980
STA DMSR03 SET ADDRESS OF RETRIEVAL INSTRUCTION. F1A09990
SXA DIMXR2,2 F1A10000
LXA L(0),2 SET INDEX 2 FOR FORWARD SEARCH. F1A10010
CLA E+2 ARGUMENT BEING SEARCHED FOR TO AC. F1A10020
DMSR01 CAS **,2 COMPARISON OF ARGUMENT TO 1ST WORD OF ENTRYF1A10030
TXI DMSR02,2,-2 NO F1A10040
TXI DMSR03,2,-1 YES F1A10050
TXI DMSR02,2,-2 NO F1A10060
DMSR02 TIX DMSR01,4,1 NOT THIS ENTRY, WAS THIS LAST ENTRY... F1A10070
TRA DIMXR2 F1A10080
DMSR03 CLA **,2 FOUND, SECOND WORD OF DIM ENTRY TO AC F1A10090
TRA DMSR07 F1A10100
REM DIM3SR= ENTRY POINT FOR 3 DIMENSION TABLE. F1A10110
DIM3SR SXA DIMXR4,4 F1A10120
SXA DIMXR2,2 F1A10130
LXD DIM3IX-2,4 GET NO OF ENTRIES IN DIM3. F1A10140
LXA L(0),2 SET INDEX 2 FOR FORWARD SEARCH. F1A10150
CLA E+2 ARGUMENT BEING SEARCHED FOR TO AC. F1A10160
DMSR04 CAS **,2 COMPARE ARGUMENT TO 1ST WORD OF DIM3 ENTRY F1A10170
TXI DMSR05,2,-3 NO F1A10180
TRA DMSR06 YES F1A10190
TXI DMSR05,2,-3 NO F1A10200
DMSR05 TIX DMSR04,4,1 NOT THIS ENTRY, WAS THIS LAST ENTRY... F1A10210
DIMXR2 AXT ..,2 F1A10220
DIMXR4 AXT ..,4 F1A10230
TRA 1,4 EXIT (NOT FOUND). F1A10240
DMSR06 CLA **,2 THIRD WORD OF DIM3 ENTRY TO D3. F1A10250
STO ERASE2 F1A10260
DMSR08 CLA **,2 SECOND WORD OF DIM3 ENTRY TO AC. F1A10270
DMSR07 STO ERASE1 AC TO D12. F1A10280
LXA DIMXR2,2 F1A10290
LXA DIMXR4,4 F1A10300
TRA 2,4 EXIT (FOUND). F1A10310
REM END OF PROGRAM DIM.SR. F1A10320
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A10330
REM F1A10340
REM SR6DC1,1/ CALLS=DIAG. F1A10350
REM SR6DC1 CONVERTS UP TO 6 BCD DIGITS TO THEIR BINARY EQUIV. F1A10360
SR6DC1 SXD SR6XR2,2 SAVE THE C(XR2), AND F1A10370
LXA L(6),2 SET TO COUNT 6 CHARACTERS. F1A10380
STZ ERASE1 INITIALIZE OUTPUT CELL TO 0. F1A10390
SR6DC2 PXD ,0 OBTAIN NEXT CHARACTER F1A10400
LGL 6 IN AC AND F1A10410
CAS BLANK TEST FOR BLANK. F1A10420
SR6XR2 TXI SR6DC3,0,** IF NOT BLANK, F1A10430
TXI SR6DC4,0,-1 F1A10440
SR6DC3 CAS L(9) TEST FOR NUMERIC. F1A10450
ER0004 BSS 0 F1A10460
TSX DIAG,4 * IF NON-NUMERIC - GO TO DIAGNOSTIC. F1A10470
NOP NOP IF NUMERIC, F1A10480
STO ERASE2 SAVE DIGIT, AND F1A10490
CLA ERASE1 MULTIPLY PREVIOUS PARTIAL F1A10500
ALS 2 RESULT BY 10, F1A10510
ADD ERASE1 AND ADD IN F1A10520
ALS 1 CURRENT DIGIT, SAVING F1A10530
ADD ERASE2 NEW PARTIAL RESULT. F1A10540
STO ERASE1 THEN F1A10550
SR6DC4 TIX SR6DC2,2,1 WHEN 6 CHARS HAVE BEEN TREATED, F1A10560
CLA ERASE1 PICKUP OUTPUT, F1A10570
LXD SR6XR2,2 RESTORE THE C(XR2), AND F1A10580
TRA TRA 1,1 * EXIT TO MAIN ROUTINE. F1A10590
REM END OF PROGRAM SR6DC1. F1A10600
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A10610
REM F1A10620
REM TBSR00(,4)/ CALLS=DIAG. F1A10630
REM TBSR00 IS CALLED BY TSX ....IX,4 -WHERE .... IS THE NAME OF F1A10640
REM THE CORE TABLE REFERRED TO. TBSR00 MAKES ENTRIES IN THE CORE F1A10650
REM TABLES, AND ALSO SEARCHES THE CORE TABLES FOR INFORMATION. F1A10660
REM F1A10670
TBSR00 SXA TBSR18-1,1 SAVE INDEX REGISTERS. F1A10680
SXA TBSR18,2 F1A10690
SXA TBSR18+1,4 F1A10700
CLA 0,4 GET ....IX,4 F1A10710
ADD L(1) FORM ....IX+1 F1A10720
STA TBSR01 SET ADDRESS OF PARAMETER MOVING LOOP. F1A10730
SUB L(3) FORM ....IX-2 F1A10740
STA TBSR09 SET ADDRESS FOR UPDATING PARAMETER. F1A10750
AXT 4,1 PREPARE TO MOVE 4 WORD PARAMETERS. F1A10760
TBSR01 CAL **,1 MOVE PARAMETERS TO TEMPORARY WORKING AREA. F1A10770
SLW TEMP,1 X F1A10780
TIX TBSR01,1,1 X F1A10790
CAL TEMP-4 GET ARG1+L,,L F1A10800
STA TBSR07 F1A10810
STA TBSR12 F1A10820
STP TBSR02 SET SWITCH TO SKIP SEARCH ON DIM TABLES. F1A10830
PDC ,1 GET 2S COMPLIMENT. F1A10840
SXD TBSR14,1 F1A10850
CLA TEMP-3 GET TA,,N F1A10860
STA TBSR08 F1A10870
STD TBSR95 SET TEST FOR TABLE OVERFLOW. F1A10880
CLA TEMP-2 GET FA,,J F1A10890
STA TBSR13 F1A10900
LXD TEMP-3,2 GET N. F1A10910
TXL TBSR06,2,0 F1A10920
TBSR02 PZE TBSR10,,0 SKIP SEARCH ON DIM TABLES. (TXH) F1A10930
TBSR05 LXD TEMP-2,1 GET J. F1A10940
TBSR95 TIX TBSR06,1,** TEST FOR N=J, YES WHEN TABLE IS FULL. F1A10950
LXD TEMP-1,4 LOAD IR4 WITH COMPLEMENT OF TABLE NUMBER. F1A10960
TRA DIAG *GO TO DIAGNOSTIC. F1A10970
TBSR06 LXD TEMP-4,3 GET L. F1A10980
TBSR07 CLA **,1 GET ARGUMENT F1A10990
TBSR08 STO **,1 AND ENTER IN TABLE. F1A11000
TIX TBSR07,1,1 ENTER L WORDS. F1A11010
PXA ,2 GET L. F1A11020
ADD TEMP-3 FORM TA+L,,N F1A11030
ADD 2E18 FORM TA+L,,N+1 F1A11040
TBSR09 STO ** UPDATE PERMANENT PARAMETER. F1A11050
LXD TEMP-3,2 GET TAG (N) WHICH IS NUMBER OF ENTRIES F1A11060
TRA TBSR17 PRECEDING THIS ENTRY. F1A11070
TBSR10 LXD TEMP-3,4 GET N. F1A11080
AXT 0,2 SET INDEX FOR FORWARD SCAN. F1A11090
TBSR11 LXD TEMP-4,1 GET L. F1A11100
SXA TBSR19,2 SAVE CURRENT NBAR. F1A11110
TBSR12 CLA **,1 COMPARE EACH WORD ON ARGUMENT TO CORRES- F1A11120
TBSR13 CAS **,2 PONDING WORD OF TABLE ENTRY. F1A11130
TRA TBSR93 UNEQUAL. F1A11140
TXI TBSR15,2,-1 EQUAL. F1A11150
TBSR93 TNX TBSR05,4,1 UNEQUAL, WAS THIS LAST ENTRY IN TABLE... F1A11160
TBSR19 AXT ..,2 GET LAST NBAR. F1A11170
TBSR14 TXI TBSR11,2,** INCREMENT LAST NBAR BY -(L) F1A11180
TBSR15 TIX TBSR12,1,1 THESE WORDS ARE EQUAL, TRY NEXT PAIR. F1A11190
LXD TEMP-3,2 ARGUMENT EQUALS TABLE ENTRY IN ALL WORDS, F1A11200
SXD TBSR16,4 COMPUTE TAG WHICH IS N-NUMBER OF ENTRIES F1A11210
TBSR16 TIX TBSR17,2,** WHICH DID NOT AGREE-1. F1A11220
LXA L(0),2 SPECIAL CASE OF FIRST ENTRY IN TABLE. F1A11230
TBSR17 PXA ,2 TAG TO AC. F1A11240
AXT **,1 RESTORE INDEX REGISTERS. F1A11250
TBSR18 AXT **,2 F1A11260
AXT **,4 F1A11270
TRA 1,4 RETURN TO CALLER +1. F1A11280
REM END OF PROGRAM TBSR00. F1A11290
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A11300
REM F1A11310
REM TESTFX,1/ F1A11320
REM TESTFX TESTS FOR FIXED OR FLOATING POINT VARIABLES. F1A11330
TESTFX CAL FIRSTC COMPARE FIRST CHARACTER F1A11340
CAS L(H) WITH H. F1A11350
CAS L(O) IF GREATER THAN H, COMPARE WITH O. F1A11360
TRA 1,1 * IF NOT GREATER THAN H, LESS THAN O,F1A11370
TRA 1,1 * THEN TAKE FLOATING POINT EXIT. F1A11380
TRA 2,1 * OTHERWISE, TAKE FIXED POINT EXIT. F1A11390
REM END OF PROGRAM TESTFX. F1A11400
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A11410
REM F1A11420
REM TEST..,4/ CALLS=DIAG. F1A11430
REM TEST.. TESTS THE CHARACTER IN THE AC(30-35). F1A11440
TEST.. BSS 0 TEST CHARACTER IN THE AC. F1A11450
REM TEST CHARACTER IN THE AC FOR COMMA OR ENDMARK. F1A11460
TESTA0 CAS COMMA F1A11470
TRA TESTA1 F1A11480
TRA 1,4 * RETURN TO CALLER. F1A11490
TESTA1 SUB ENDMK F1A11500
TZE 1,4 * RETURN TO CALLER. F1A11510
ER0015 TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. F1A11520
REM TEST CHARACTER IN THE AC FOR COMMA OR CLOSED PARENTHESIS. F1A11530
TESTB0 CAS COMMA F1A11540
TRA TESTB1 F1A11550
TRA 1,4 * RETURN TO CALLER. F1A11560
TESTB1 SUB CLOS F1A11570
TZE 1,4 * RETURN TO CALLER. F1A11580
ER0016 TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. F1A11590
REM TEST CHARACTER IN THE AC FOR OPEN PARENTHESIS OR ENDMARK. F1A11600
TESTC0 CAS OPEN F1A11610
TRA TESTC1 F1A11620
TRA 1,4 * RETURN TO CALLER. F1A11630
TESTC1 SUB ENDMK F1A11640
TZE 1,4 * RETURN TO CALLER. F1A11650
ER0017 TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. F1A11660
REM TEST CHARACTER IN THE AC FOR ENDMARK. F1A11670
TESTD0 CAS ENDMK F1A11680
TSX MRTN77,4 *CHARACTER GREATER THAN 77 OCTAL, IMPOSS. F1A11690
TRA 1,4 * RETURN TO CALLER. F1A11700
ER0019 TSX DIAG,4 *ERROR, END OF STATEMENT NOT REACHED. F1A11710
REM TEST CHARACTER IN THE AC FOR OPEN PARENTHESIS. F1A11720
TESTE0 CAS OPEN F1A11730
TRA TESTE1 F1A11740
TRA 1,4 * RETURN TO CALLER. F1A11750
ER0020 BSS 0 F1A11760
TESTE1 TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. F1A11770
REM TEST CHARACTER IN THE AC FOR CLOSED PARENTHESIS. F1A11780
TESTF0 CAS CLOS F1A11790
TRA TESTF1 F1A11800
TRA 1,4 * RETURN TO CALLER. F1A11810
ER0021 BSS 0 F1A11820
TESTF1 TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. F1A11830
REM TEST CHARACTER IN THE AC FOR COMMA. F1A11840
TESTG0 CAS COMMA F1A11850
TRA TESTG1 F1A11860
TRA 1,4 * RETURN TO CALLER. F1A11870
ER0022 BSS 0 F1A11880
TESTG1 TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. F1A11890
REM TEST CHARACTER IN THE AC FOR NON-NUMERIC. F1A11900
TESTH0 CAS L(9) F1A11910
TRA 1,4 * RETURN TO CALLER. F1A11920
NOP F1A11930
ER0023 TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. F1A11940
REM TEST CHARACTER IN THE AC FOR NUMERIC. F1A11950
TESTI0 CAS L(9) F1A11960
ER0024 TSX DIAG,4 * ERROR -- GO TO DIAGNOSTIC. F1A11970
TRA 1,4 * RETURN TO CALLER. F1A11980
TRA 1,4 * RETURN TO CALLER. F1A11990
REM END OF PROGRAM TEST... F1A12000
REM F1A12010
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A12020
REM F1A12030
REM ERASABLE STORAGE COMMON TO BOTH PASS 1 AND PASS 2. F1A12040
REM F1A12050
COMORG SYN * F1A12060
1C BSS 5 COMMON WORKING STORAGE. F1A12070
1G BSS 1 COMMON WORKING STORAGE. F1A12080
2G BSS 1 COMMON WORKING STORAGE FOR STATE A.F1A12090
3G BSS 1 F1A12100
1H BSS 1 F1A12110
CALLNM BSS 1 F1A12120
E BSS 14 WORKING STORAGE USED BY SS000. F1A12130
ERASE BSS 1 F1A12140
ERASE1 BSS 1 F1A12150
ERASE2 BSS 1 F1A12160
ERASE3 BSS 1 F1A12170
ERASE4 BSS 1 F1A12180
FIRSTC BSS 1 USED BY SS000,TESTFX,C3000. F1A12190
FSNAME BSS 1 NAME OF FUNCTION. F1A12200
G BSS 2 F1A12210
LEFT BSS 3 STORAGE USED BY ARITHMETIC, DIAG. F1A12220
RESIDU BSS 1 REMAINDER OF F-REGION WORD.(C0190) F1A12230
TABNUM BSS 1 F1A12240
TEMP BES 4 F1A12250
BSS 1 $F1A12251
REM F1A12260
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A12270
REM F1A12280
REM COMMON/6-PATCH AREA= F1A12290
CLAIFN PZE 0 STORAGE FOR CLA 2 IFN $F1A12291
COMP1 LXD CITCNT,2 LOAD CURRENT BUFFER INCREMENT $F1A12292
NZT CLAIFN WAS THIS FUNCTION OR SUBROUTINE $F1A12293
TRA CIT00+5 NO $F1A12294
CLA CLAIFN YES $F1A12295
STO CITBUF STORE IFN INSTEAD OF $F1A12296
STZ CLAIFN $$ INTO FIRST INSTRUCTION (CLA 2) $F1A12297
TRA CIT00+5 $F1A12298
REM PATCH CHECKS ON BOOLEAN ERRORS $F1A12300
BERPCH CAL MODECL CHECK INDICATOR, BOOLEAN ERROR PATCH $F1A12301
ERA L(B) IS STATEMENT BOOLEAN $F1A12302
TNZ 3,4 NO, RETURN TO CALLER $F1A12303
TRA CIT00+2 GO BACK TO CHECK FOR BOOL. ERROR $F1A12304
BSS 187 PATCH AREA $F1A12305
ENDCOM SYN * END OF COMMON . F1A12310
REM END OF COMMON PATCH AREA. F1A12320
REM F1A12330
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A12340
REM F1A12350
REM END OF THE COMMON PART OF SECTION ONE. F1A12360
TTL * SECTION ONE PASS ONE * RECORD 9F13 * F1A12370
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A12380
REM F1A12390
REM SECTION 1 / PASS1 = F1A12400
REM F1A12410
REM F1A12420
REM PASS 1/1-ASSEMBLE AND CLASSIFY ALL STATEMENTS= F1A12430
REM F1A12440
ORGP1 ORG ENDCOM F1A12450
REM F1A12460
INITIL LFTM MAKE SURE TRAP MODES ARE INACTIVE. F1A12470
LTM F1A12480
CAL L(4) SET MONITOR ERROR FLAG F1A12490
SLW (MSLN) FOR ERROR RECORDS. F1A12491
AXT TEMP-1C,4 ZERO OUT THE ERASEABLE $F1A12492
STZ TEMP,4 STORAGE FOR IBSYS. $F1A12493
TIX *-1,4,1 $F1A12494
AXT TOPTAB-ENDF10,4 F1A12500
STZ TOPTAB,4 CLEAR WORKING AREA. F1A12510
TIX *-1,4,1 F1A12520
AXT 4,1 F1A12530
INITZ SXD *+3,1 REWIND WORKING TAPES. F1A12540
TSX (TAPE),4 F1A12550
PZE REWD,,(SKDP) F1A12560
PZE ,,** F1A12570
TXL *+2,1,2 DO NOT REWIND SYSTEM TAPE. F1A12580
TIX INITZ,1,1 F1A12590
CAL L(FPT) INITIALIZE CLOSUB TABLE IN CASE F1A12600
SLW CLSBBF THIS A MAIN PROGRAM. F1A12610
CLA* (FGBX) GET MONITOR FLAGS. F1A12611
TPL *+8 *IS THIS MONITOR MODE, NO. F1A1261A
AXT (RBNP),4 YES. SET READ OPERATIONS TO BINARY. F1A1261B
SXD *+7,4 F1A1261C
AXT (RBEP),4 F1A1261D
SXD LDFTT,4 F1A1261E
AXT FINPUT,4 SET CALLING SEQUENCE TO READ LABELS. F1A1261F
SXA LDFTT+1,4 F1A1261G
SXA *+3,4 F1A1261H
TSX (TAPE),4 LOAD FT-REGION (BUFFER 1). F1A12620
PZE FTREG-1,,(RDNP) F1A12630
PZE ,,INPUTP F1A12640
CAL DIM3IX-1 INITIALIZE F1A12650
STA DMSR04 DIM3 F1A12660
ADD L(1) ADDRESS F1A12670
STA DMSR08 IN DIM3 F1A12680
ADD L(1) SEARCH F1A12690
STA DMSR06 ROUTINE. F1A12700
TSX LDFT0,4 LOAD FT-REGION (BUFFER 2). F1A12710
TRA LDFR0 GO TO PASS 1 SUBROUTINE TO LOAD F-REGION. F1A12720
REM F1A12730
L(FPT) BCI 1,(FPT) ASSUMED FIRST ENTRY IN CLOSUB. F1A12740
FINPUT BCI 1,FINPUT LABEL FOR READING INPUT TAPE. F1A12741
REM F1A12750
REM *************************************************************F1A12760
REM F1A12761
REM TERMINAL ROUTINE FOR PASS 1. F1A12770
REM F1A12780
CLOSP1 ZET *+1 HAS THERE BEEN A NO XEQ STAT. ERROR. F1A12790
TRA *+2 NOT YET. F1A12800
TRA P1DXIT YES, QUIT PROCESSING. F1A12810
LXA XEQCTR,4 ARE THERE ANY EXECUTABLE STATEMENTS. F1A12820
TXH *+3,4,0 *YES. F1A12830
STZ CLOSP1+1 NO, SET QUIT FLAG. F1A12840
NOXEQR TSX DIAG,4 GO TO DIAGNOSTIC. F1A12850
TSX (TAPE),4 WRITE A DUMMY RECORD AFTER THE F1A12860
PZE TRAILR,,(WBNP) EXECUTABLE STATEMENTS. F1A12870
PZE WTXQ5,,EXEQTP F1A12880
TSX (TAPE),4 WRITE END-OF-FILE AFTER EXECUTABLE F1A12890
PZE ,,(WEFP) STATEMENTS. F1A12900
PZE EXEQF,,EXEQTP F1A12910
TSX (TAPE),4 REWIND TAPE. F1A12920
PZE REWD,,(SKBP) F1A12930
PZE ,,EXEQTP F1A12940
ZET DGFLAG HAS THERE BEEN AN ERROR. F1A12941
TRA P1EXIT *YES, SKIP DUMP. F1A12942
LDC INTETI-3,1 COMPUTE THE ROOM IN THE TWO BUFFERS. F1A12950
TXI *+1,1,FRMTSZ-1 FORMAT, AND F1A12960
TXI *+1,1,EQITSZ*2 EQUIT. F1A12970
SXD TEST,1 F1A12980
LDC BFCNT,2 GET THE MUMBER TO MOVE F1A12990
TXI *+1,2,BFSZ F1A13000
TEST TXH DUMP,2,** TEST FOR ROOM ENOUGH F1A13010
SXD INTETK-3,2 UPDATE BUFFER P COUNT F1A13020
AXT FRMTBF+FRMTSZ-1,4 F1A13030
SXD *+1,2 SET BUFFER ORIGIN FOR 1 PRIME. F1A13040
TIX *+1,4,** F1A13050
SXA INTETK-3,4 F1A13060
LDC BFCNT,4 INITIALIZE MOVE LOOP F1A13070
TXI *+1,4,TABORG F1A13080
SXA *+1,4 F1A13090
MOVF CLA **,2 F1A13100
STO FRMTBF+FRMTSZ-1,2 F1A13110
TIX *-2,2,1 F1A13120
TSX (TAPE),4 F1A13130
PZE FRMTTP,,(CHKU) F1A13140
LXD FLBL,4 PUT DUMP COUNT WHERE 1 PRIME F1A13150
SXA INTETK+1,4 CAN FIND IT. F1A13160
TRA P1EXIT F1A13170
DUMP SXD *+1,1 GET THE NUMBER OF WORDS TO DUMP. F1A13180
TIX *+1,2,** F1A13190
PXD 0,2 F1A13200
ADD INTETK+1 F1A13210
STD INTETK+1 F1A13220
SXD FORIO+1,2 F1A13230
LXD FLBL,4 F1A13240
TXI *+1,4,1 UPDATE THE DUMP COUNT F1A13250
SXD FLBL,4 PUT IT IN THE LABEL F1A13260
TSX (TAPE),4 OUT THEY GO F1A13270
PZE FORIO,,(WBNP) CHECK LATER F1A13280
PZE INTETK+2,,FRMTTP F1A13290
STL TETFLG SET FLAG TO INDICATE DATA ON TAPE. F1A13291
LXD TEST,2 SET UP NUMBER TO BE MOVED F1A13300
TRA TEST+1 AND GO DO IT. F1A13310
P1EXIT CLS PASS1 FLIP SWITCH FOR PASS 2. F1A13320
STO PASS1 F1A13330
REM F1A13340
CALLP2 STZ DGX1 SET FLAG FOR DIAGNOSTIC CALLER. F1A13350
LXD INTETM-3,4 LOAD COUNT OF WORDS IN COMMON BUFFER. F1A13360
PXA ,4 PLACE IN AC. F1A13370
STO ERASE SAVE IN ERASABLE. F1A13380
CLA INTETM-1 GET COMMON MAXIMUM BUFFER SIZE. F1A13390
SUB ERASE SUBTRACT THE USED PORTION. F1A13400
ADD INTETN-1 ADD MAXIMUM SIZE FOR HOLARG TABLE BUFFER. F1A13410
STA INTETN-1 SET NEW BUFFER SIZE FOR HOLARG. F1A13420
CLA INTETM-3 GET COMMON BUFFER ORIGIN. F1A13430
ADD ERASE ADD COUNT OF WORDS IN COMMON BUFFER. F1A13440
STA INTETN-3 SET NEW HOLARG BUFFER ORIGIN. F1A13450
NZT DGFLAG HAS THERE BEEN A DIAGNOSTIC. F1A13460
TRA RP2I NO, GET PASS TWO. $F1A13470
TSX (TAPE),4 YES, REPOSITION SYSTEM TAPE TO BEFORE F1A13480
PZE BKSP,,(SKBP) PASS 2. F1A13490
PZE ,,SYSTAP F1A13500
TRA RP2I GET PASS TWO $F1A13510
REM F1A13520
REM *************************************************************F1A13521
REM F1A13530
REM SUBROUTINE USED TO WRITE EXECUTABLE STATEMENTS F1A13540
REM ON AN INTERMEDIATE TAPE FOR PROCESSING IN PASS2. F1A13550
REM F1A13560
REM WTXQ0 / CALLS CF000 TO PROCESS NON-EXECUTABLE STATEMENTS,F1A13570
REM OR I/O PACKAGE TO WRITE EXECUTABLE STATEMENTS. F1A13580
REM F1A13590
WTXQ0 CLA T,1 ENTRY POINT FOR STATEMENTS IN DICTIONARY. F1A13600
REM WTXQ1 IS THE ENTRY POINT FOR ARITH. STATEMENTS.F1A13610
WTXQ1 STO TLABEL SET TRANSFER LABEL. F1A13620
TMI CF000 *TRANSFER IF STATEMENT IS NON-EXECUTABLE. F1A13630
LDC DCF,1 GET TRUE ADDRESS OF CURRENT F-REGION. F1A13640
SXA WTXQ2,1 SET ADDRESS OF LOOP TO MOVE TLABEL, ETC. F1A13650
TXI *+1,1,-4 SET INDEX TO TRUE ADDRESS OF TLABEL. F1A13660
SXA WTXQ4,1 SET I/O COMMAND ADDRESS. F1A13670
AXT 4,2 MOVE TLABEL, MODECL, EFN, AND FIRST5 F1A13680
CAL FIRST5+1,2 INTO CURRENT OUTPUT BUFFER AHEAD OF F1A13690
WTXQ2 SLW **,2 CURRENT F-REGION. F1A13700
TIX *-2,2,1 F1A13710
WTXQ3 AXC **,2 GET TRUE NUMBER OF LAST WORD IN F-REGION. F1A13720
SXD *+1,1 SET TIX WITH ORIGIN OF CURRENT F-REGION F1A13730
TIX *+1,2,** (INCLUDING 4 DATA CELLS). COMPUTE LENGTH F1A13740
SXD WTXQ4,2 OF ENTIRE F-REGION AND SET I/O COMMAND. F1A13750
LXA XEQCTR,4 LOAD COUNT OF EXECUTABLE STATEMENTS F1A13760
TXI *+1,4,1 WRITTEN ON TAPE AND INCREMENT. F1A13770
SXA XEQCTR,4 F1A13780
TSX (TAPE),4 WRITE STATEMENT ON TAPE FOR PASS2. F1A13790
PZE WTXQ4,,(WBNP) F1A13800
PZE WTXQ5,,EXEQTP F1A13810
TRA PASS1 RETURN TO PASS1 SWITCH. F1A13820
REM F1A13830
WTXQ4 IORT **,,** I/O COMMAND TO WRITE EXEQUTABLE STATS. F1A13840
REM F1A13850
REM *************************************************************F1A13851
REM F1A13860
REM SUBROUTINE TO READ A RECORD FROM THE F1A13870
REM BCD INPUT TAPE INTO THE TEMPORARY F REGION. F1A13880
REM F1A13890
LDFT0 SXA LDFT4,4 SAVE LINKAGE. F1A13900
LDFT1 AXT -1,2 LOAD BUFFER SWITCH (+1 OR -1) F1A13910
TSX (TAPE),4 READ A RECORD FROM BCD INPUT TAPE. F1A13920
LDFTT PZE FTREG,2,(RDEP) F1A13930
PZE ,,INPUTP F1A13940
LAC LDFT1,2 FLIP BUFFER SWITCH. F1A13950
SXA LDFT1,2 F1A13960
CAL (SCHU)+INPUTP GET RESULT OF SCHX. F1A13970
TNZ *+3 WAS AN END-OF-FILE READ. F1A13980
SXD LDFT2,0 YES, SET EOF FLAG. F1A13990
LDFT2 TXI LDFR5,,-1 TAKE EOF EXIT. F1A14000
STA FTREG SET LAST+1 FOR TIX LOOP. F1A14010
SUB FTREG,2 COMPUTE WORD COUNT OF RECORD. F1A14020
PAX ,2 WERE LESS THAN 3 WORDS READ. F1A14030
TXL LDFT1,2,3 *YES, IGNORE IT, MOST LIKELY NOISE. F1A14040
SXA LDFT5,2 NO, SAVE WORD COUNT. F1A14050
PXD ,0 CLEAR AC. F1A14060
LDQ* FTREG GET FIRST CHARACTER OF F1A14070
LGL 6 CARD IN AC. F1A14080
LAS L(C) IS THIS A COMMENT CARD. F1A14090
TRA *+2 NOT A (C) COMMENTS CARD. F1A14100
TRA LDFT1 YES, IGNORE IT. F1A14110
ERA STAR DOES COLUMN 1 CONTAIN (*). F1A14120
TZE LDFT1 *YES, IGNORE IT, COMMENT OR MONITOR CARD. F1A14130
LDFT3 CAL* FTREG IS THIS CARD COMPLETELY BLANK. F1A14140
ERA BLANKS F1A14150
TNZ LDFT4 *NO, HAS AT LEAST A CONTINUATION PUNCH. F1A14160
TIX LDFT3,2,1 F1A14170
TRA LDFT1 *YES, IGNORE IT. F1A14180
LDFT4 AXT **,4 RESTORE LINKAGE. F1A14190
LDFT5 AXT **,2 RELOAD WORD COUNT. F1A14200
TRA 1,4 RETURN TO CALLER. F1A14210
REM F1A14220
REM *************************************************************F1A14221
REM F1A14230
REM LDFR0 / CALLS LDFT0, SR6DC1 F1A14240
REM F1A14250
REM LDFR0 ASSEMBLES A STATEMENT IN THE F-REGION. F1A14260
REM F1A14270
FROVR CAL ALL1 SET END OF STATEMENT MARKER. F1A14280
SLW -1,1 DIAGNOSTIC WILL NEED IT. F1A14290
ER1007 TSX DIAG,4 STATEMENT TOO LONG FOR F-REGION. F1A14300
REM F1A14310
LDFR0 LXA LDFT5,2 F1A14320
CAL* FTREG GET FIRST SIX CHARACTERS OF STATEMENT. F1A14330
ARS 6 ELIMINATE CONTINUATION MARK (IF ANY). F1A14340
SLW FIRST5 SAVE FIRST FIVE. F1A14350
LDQ BLANKS SHIFT EFN INTO MQ WITH TRAILING BLANKS. F1A14360
LGR 24 F1A14370
PAX ,1 LOAD COLUMN INTO INDEX. F1A14380
STZ MODECL CLEAR MODE INDICATOR. F1A14390
TXL LDFR1,1,9 IS COLUMN 1 NON-NUMERIC. F1A14400
ERA BLANK YES, IS IT A BLANK. F1A14410
TZE LDFR2 *YES. F1A14420
SXA MODECL,1 NO, SAVE IT AS A MODE INDICATOR. F1A14430
TRA LDFR2 ENTIRE EFN (IF ANY) IS IN MQ. F1A14440
LDFR1 LGR 6 SHIFT FIRST DIGIT OF EFN INTO MQ. F1A14450
LDFR2 STQ EFN SAVE EXTERNAL FORMULA NUMBER (EFN). F1A14460
LXD DCF,1 LOAD 2S COMPLEMENT OF LAST F-REGION USED. F1A14470
TXI *+1,2,-1 REDUCE FT INDEX TO SECOND WORD. F1A14480
CLA TLABEL WAS LAST STATEMENT EXECUTABLE. F1A14490
TMI LDFR3 *NO, DO NOT FLIP BUFFERS. F1A14500
TXH *+2,1,-FRGBF2-4 SWITCH BUFFERS. F1A14510
TXI *+2,1,FREGSZ+4 FLIP TO BUFFER 1. F1A14520
TXI *+1,1,-FREGSZ-4 FLIP TO BUFFER 2. F1A14530
SXD DCF,1 SET BUFFER ADDRESS. F1A14540
TXI *+1,1,-FREGSZ COMPUTE LAST ADDRESS OF BUFFER FOR F1A14550
SXD LDFR4,1 OVERFLOW TEST. F1A14560
LXD DCF,1 LOAD F-REGION ORIGIN (2S COMPLEMENT FORM).F1A14570
LDFR3 LDQ* FTREG MOVE FT-REGION TO F-REGION. F1A14580
STQ 0,1 F1A14590
TXI *+1,1,-1 UPDATE F-REGION ADDRESS. F1A14600
LDFR4 TXL FROVR,1,** *IS THE STATEMENT TOO LONG, YES. F1A14610
TIX LDFR3,2,1 NO, IS FT-REGION EXHAUSTED. F1A14620
TSX LDFT0,4 YES, RELOAD IT. F1A14630
CAL* FTREG IS THIS CARD A CONTINUATION F1A14640
ANA ENDMK OF THE STATEMENT. F1A14650
TZE LDFR5 *NO. F1A14660
ERA BLANK POSSIBLY, IS COLUMN 6 BLANK. F1A14670
TZE LDFR5 *YES. F1A14680
TXI LDFR3,2,-1 NO, THIS IS A CONTINUATION CARD. F1A14690
LDFR5 CAL BLANKS SCAN F-REGION BACKWARDS AND F1A14700
LDFR6 LAS -1,1 FIND THE LAST NON-BLANK WORD. F1A14710
TXI *+3,1,-1 NON-BLANK, SET INDEX TO ENDMARK PLUS ONE. F1A14720
TXI LDFR6,1,1 BLANK, REDUCE F-REGION INDEX AND CONTINUE.F1A14730
TXI *+1,1,-1 NON-BLANK, SET INDEX TO ENDMARK PLUS ONE. F1A14740
CAL ALL1 INSERT END-MARK (36 BINARY 1S). F1A14750
SLW -1,1 F1A14760
SXA WTXQ3,1 SAVE ADDRESS OF LAST NON-BLANK WORD. F1A14770
LDQ EFN GET EXTERNAL FORMULA NUMBER (IF ANY). F1A14780
TSX SR6DC1,1 CONVERT TO BINARY. F1A14790
SLW EFN SET TO BINARY EQUIVALENT. F1A14800
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A14810
REM F1A14820
REM CD000/ CALLS=C0190X,C0190,DIAG. F1A14830
REM CD000 SCANS FOR HOLLERITH AND ILLEGAL CHARACTERS. F1A14840
CLA MODECL TEST FOR ASTERICK IN CC 1 WHICH INDICATES F1A14850
SUB L(F) TEST FOR F IN CC 1 WHICH MEANS A FORTRAN 3 F1A14860
TNZ SCAN0 *FUNCTION LIST. IS NOT A LIST. F1A14870
REM NAMES FROM FUNCTION LIST ARE ENTERED IN CLOSUB TABLE. F1A14880
TSX C0190X,4 SET SCAN TO FIRST POSITION. F1A14890
FCARD0 TSX C0190,4 PLACE FIRST NON-BLANK CHARACTER OF NAME IN F1A14900
TSX C0160,2 AC AND THEN COLLECT NAME IN 1G CELL. F1A14910
TSX TESTA0,4 TEST NEXT CHARACTER FOR COMMA OR ENDMK. F1A14920
CLA 1G MOVE SUBROUTINE NAME TO INPUT CELL FOR TET F1A14930
STO G SUBROUTINE. F1A14940
TSX TET00,1 ENTER NAME IN CLOSUB TABLE. F1A14950
9 WHOSE IDENTIFICATION NUMBER IS 9. F1A14960
CLA 1H INSPECT CHARACTER FOLLOWING NAME FOR ENDMK.F1A14970
SUB ENDMK F1A14980
TNZ FCARD0 NOT ENDMK, CONITNUE COLLECTING NAMES. F1A14990
SSM SET FLAG FOR LDFR ROUTINE SO THAT F1A15000
STO TLABEL IT WILL NOT FLIP BUFFERS. F1A15010
TRA PASS1 GO TO NEXT SOURCE STATEMENT. F1A15020
REM F1A15030
REM *************************************************************F1A15040
REM F1A15041
REM SCAN0 / CALLS WTXQ0, CC000, DIAG AND (DIAG). F1A15042
REM F1A15043
REM SCANS AN ASSEMBLED STATEMENT IN ORDER TO DETERMINE IF F1A15044
REM THERE ARE ANY ILLEGAL CHARACTERS CONTIANED IN THE F1A15045
REM STATEMENT AND WHETHER THE STATEMENT IS ARITHMETIC F1A15050
REM OR NON-ARITHMETIC. F1A15051
REM F1A15052
REM AN ARITHMETIC STATEMENT IS OF THE FORM - F1A15053
REM F1A15054
REM ALPHA = BETA F1A15055
REM F1A15060
REM WHERE ALPHA IS 1) A NON-SUBSCRIPTED VARIABLE F1A15061
REM 2) A SUBSCRIPTED VARIABLE F1A15062
REM F1A15063
REM AND BETA IS 1) A CONSTANT F1A15064
REM 2) A NON-SUBSCRIPTED VARIABLE F1A15065
REM 3) A SUBSCRIPTED VARIABLE F1A15070
REM 4) AN EXPRESION OF THE FORM F1A15071
REM F1A15072
REM A+B-C*D/E**F+FUNCTION (G,H,I) F1A15073
REM F1A15074
REM WHERE A,B,C,D,E,F,G,H AND F1A15075
REM I ARE 1,2,3, AND 4 ABOVE. F1A15080
REM F1A15081
REM F1A15082
REM A HOLLERITH LITERAL MAY APPEAR IN AN ARITHMETIC F1A15083
REM STATEMENT. A HOLLERITH FIELD APPEARS IN NON-ARITHMETIC F1A15084
REM STATEMENTS. F1A15085
REM F1A15090
REM A HOLLERITH LITERAL IS DEFINED AS THE SEQUENCE - F1A15091
REM F1A15092
REM +NH.... (+NH....) F1A15093
REM -NH.... (-NH....) F1A15094
REM *NH.... (*NH....) F1A15095
REM F1A15100
REM A HOLLERITH FIELD IS DEFINED AS THE SEQUENCE - F1A15101
REM F1A15102
REM (NH.... F1A15103
REM /NH.... F1A15104
REM ,NH.... F1A15105
REM F1A15110
REM F1A15111
REM A NON-ARITHMETIC STATEMENT IS OF THE FORM - F1A15112
REM F1A15113
REM 1) X 5) X (Y=Y,Y) F1A15114
REM 2) X (Y) 6) X Y F1A15115
REM 3) X (Y,Y) 7) X Y,Y F1A15120
REM 4) X (Y),(Y) 8) X Y=Y,Y F1A15121
REM F1A15122
REM WHERE X IS A DECLARATION, DESCRIPTION, DIRECTIVE, F1A15123
REM OR QUESTION. F1A15124
REM F1A15125
REM AND Y IS THE SAME AS THE ABOVE BETA IN AN F1A15130
REM ARITHMETIC STATEMENT OR A WORD. F1A15131
REM F1A15132
REM F1A15133
SCAN0 TRA SCAN00 GO TO PATCH TO TEST FOR IF(. $F1A15140
STZ LITFG RESET HOLLERITH LITER FLAG. F1A15141
STZ HOLFG RESET HOLLERITH FIELD FLAG. F1A15142
STZ NOTAF RESET NON-ARITHMETIC FLAG. F1A15143
STZ EQSFG RESET EQUALS SIGN FLAG. F1A15144
LXD DCF,2 LOAD ORIGIN OF F-REGION. F1A15150
ZAC RESET PAREN COUNTER. F1A15151
SCAN1 LDQ 0,2 GET A WORD OF THE STATEMENT. F1A15160
AXT 6,4 INITIALIZE CHARACTER COUNT. F1A15161
SCAN2 CAQ SCANT,1,1 CHECK A CHARACTER. F1A15162
TRA CHSV1 STORE CURRENT CHARACTER $F1A15163
REM F1A15170
REM TRANSFER VECTOR. F1A15171
REM F1A15172
DUP 1,4 SPACE FOR ADDITIONAL BRANCHES. $F1A15173
PZE 23-26 $F1A15174
REM F1A15175
TRA PMS01 22 - CHARACTER IS * $F1A15179
ER0026 TSX DIAG,4 21 - CHARACTER IS $ F1A15180
ER0027 TSX DIAG,4 20 - CHARACTER IS + ZERO F1A15181
ER0028 TSX DIAG,4 17 - CHARACTER IS - ZERO F1A15182
ER0029 TSX DIAG,4 16 - CHARACTER IS RECORD MARK F1A15183
ER0030 TSX DIAG,4 15 - CHARACTER IS 8-4 PUNCH F1A15184
TSX OCTL12,4 14 - CHARACTER IS OCTAL 12. F1A15185
TRA END00 13 - CHARACTER IS ENDMARK F1A15190
TRA CHRX0 12 - CHARACTER IS X F1A15191
TRA CHRH0 11 - CHARACTER IS H F1A15192
TRA LPRN0 10 - CHARACTER IS ( $F1A15193
TRA RPRN0 07 - CHARACTER IS ) $F1A15194
TRA EQUS0 06 - CHARACTER IS = $F1A15195
TRA COMA0 05 - CHARACTER IS , $F1A15200
TRA PMS01 04 - CHARACTER IS / $F1A15201
TRA PMS01 03 - CHARACTER IS +- $F1A15202
TRA DIGT0 02 - CHARACTER IS NUMERIC $F1A15203
TRA LEGL0 01 - CHARACTER IS LEGAL $F1A15204
SCAN3 TIX SCAN2,4,1 00 - CHARACTER IS BLANK OR COUNT TEST. F1A15205
SCAN4 TXI SCAN1,2,-1 *WORD EXHAUSTED, GET ANOTHER. F1A15210
REM F1A15211
REM F1A15212
REM CHARACTER IS A NUMERIC. F1A15213
REM F1A15214
DIGT0 ZET HOLFG IS THIS POSSIBLY A HOLLERITH FIELD. F1A15220
TRA DIGT1 YES. N FOLLOWS (/ OR , F1A15221
NZT LITFG NO. IS THIS POSSIBLY A HOLLERITH LITERAL. F1A15222
TRA SCAN3 *NO. N DOES NOT FOLLOW +-* F1A15223
DIGT1 STQ C(MQ) YES. SAVE CONTENTS OF MQ. F1A15224
XCL SAVE AC IN MQ AND MOVE DIGIT TO F1A15225
ANA ENDMK LOW ORDER OF AC AND PRESERVE IT. F1A15230
SLW 2G SAVE DIGIT. F1A15231
CLA 1G GET PREVIOUS PARTIAL RESULT. F1A15232
ALS 2 MULTIPLY BY 4. F1A15233
ADD 1G ADD NEW DIGIT. F1A15234
ALS 1 MULTIPLY BY 2. F1A15235
ADD 2G ADD NEW DIGIT AGAIN. F1A15240
STO 1G SAVE PARTIAL RESULT. F1A15241
XCL RESTORE PAREN COUNT IN AC. F1A15242
LDQ C(MQ) RESTORE CHARACTERS IN MQ. F1A15243
TRA SCAN3 *RETURN TO SCAN. F1A15244
REM F1A15245
REM CHARACTER IS LEGAL AND INSIGNIFICANT. F1A15250
REM F1A15251
LEGL0 ANA 1BAR AVOID FIELD OVERFLOW, MASK DECREMENT. F1A15260
STZ HOLFG RESET HOLLERITH FIELD FLAG. F1A15261
STZ LITFG RESET HOLLERITH LITERAL FLAG. F1A15262
STZ 1G CLEAR CONVERSION CELL. F1A15263
TRA SCAN3 *RETURN TO SCAN. F1A15264
REM F1A15265
REM CHARACTER IS +-* OR = F1A15270
REM F1A15271
PMS00 STL LITFG SET POSSIBLE HOLLERITH LITERAL FLAG. F1A15272
STZ HOLFG RESET POSSIBLE HOLLERITH FIELD FLAG. F1A15273
STZ 1G CLEAR CONVERSION CELL. F1A15274
TRA SCAN3 *RETURN TO SCAN. F1A15275
REM F1A15280
REM CHARACTER IS /( OR , F1A15281
REM F1A15282
SLSH0 STL HOLFG SET POSSIBLE HOLLERITH FIELD FLAG. F1A15290
STZ LITFG RESET POSSIBLE HOLLERITH LITERAL FLAG. F1A15291
STZ 1G CLEAR CONVERSION CELL. F1A15292
TRA SCAN3 *RETURN TO SCAN. F1A15293
REM F1A15300
REM CHARACTER IS , F1A15301
REM F1A15302
COMA0 PDX ,1 LOAD PAREN COUNT. IS COMMA INSIDE PARENS. F1A15310
TXH SLSH0,1,0 *YES,IS SUBSCRIPT OR ARGUMENT SEPARATOR $F1A15311
COMA1 STL NOTAF NO. THIS MUST BE A NON-ARITHMETIC F1A15312
TRA LEGL0 *STATEMENT, SET FLAG AND CLEAR FLAGS. F1A15313
REM F1A15320
REM CHARACTER IS = F1A15321
REM F1A15322
EQUS0 PDX ,1 LOAD PAREN COUNT. IS EQUALS INSIDE PARENS.F1A15330
TXH COMA1,1,0 *YES, MUST BE I/O LIST. F1A15331
STL EQSFG NO. SET FLAG FOR POSSIBLE ARITHMETIC. F1A15332
TRA PMS00 *TREAT AS POSSIBLE HOLLERITH LITERAL F1A15333
REM DEFINITION. F1A15334
REM F1A15340
REM CHARACTER IS ) F1A15341
REM F1A15342
RPRN0 PDX ,1 LOAD PAREN COUNT. HAS COUNT GONE MINUS. F1A15350
TXL LEGL0,1,1200 *NO,CLEAR FLAGS $F1A15351
TRA ER0032 *YES. GO TO DIAGNOSTIC. F1A15352
REM F1A15360
REM CHARACTER IS ( F1A15361
REM F1A15362
LPRN0 TRA SLSH0 *TREAT AS POSSIBLE HOLLERITH FIELD DEF. F1A15363
REM F1A15370
REM CHARACTER IS H. F1A15371
REM F1A15372
CHRH0 ZET LITFG IS THIS POSSIBLY A HOLLERITH LITERAL. F1A15380
TRA CHRH1 YES. F1A15381
NZT HOLFG NO. IS THIS POSSIBLY A HOLLERITH FIELD. F1A15382
TRA LEGL0 *NO,MUST BE VARIABLE OR WORD $F1A15383
CHRH1 LXA 1G,1 YES. LOAD CHARACTER COUNT. F1A15384
TXL LEGL0,1,0 *IS COUNT 0.YES,NOT HOLLERITH $F1A15385
ZET HOLFG IS THIS A HOLLERITH FIELD. F1A15390
STL NOTAF YES. SET NON-ARITHMETIC FLAG. F1A15391
SLW C(MQ) SAVE CONTENTS OF AC. F1A15392
CHRH2 TIX CHRH3,4,1 *ANY CHARACTERS LEFT IN MQ, YES. F1A15393
TXI *+1,2,-1 NO. INCREMENT F-REGION INDEX. F1A15394
LDQ 0,2 GET ANOTHER WORD OF STATEMENT. F1A15395
AXT 6,4 INITIALIZE COUNT OF CHARACTERS IN MQ. F1A15400
CHRH3 SXA CHRH4,1 SAVE HOLLERITH CHARACTER COUNT. F1A15401
CAQ SCANT,1,1 CHECK A CHARACTER. F1A15402
TRA CHRH4,1 *BRANCH ON ANALYSIS OF CHARACTER. F1A15403
REM F1A15410
REM TRANSFER VECTOR FOR HOLLERITH SCAN. F1A15411
REM F1A15412
DUP 1,4 SPACE FOR ADDITIONAL BRANCHES. $F1A15420
PZE F1A15421
REM F1A15422
TRA CHRH4 CHARACTER IS * $F1A15429
TRA CHRH4 CHARACTER IS $ F1A15430
TRA ER0027 CHARACTER IS + ZERO F1A15431
TRA ER0028 CHARACTER IS - ZERO F1A15432
TRA ER0029 CHARACTER IS RECORD MARK F1A15433
TRA CHRH4 CHARACTER IS 8-4 PUNCH. F1A15434
TSX OCTL12,4 CHARACTER IS OCTAL 12 F1A15435
ER0075 TSX DIAG,4 CHARACTER IS ENDMARK F1A15440
TRA CHRH4 CHARACTER IS X F1A15441
TRA CHRH4 CHARACTER IS H F1A15442
TRA CHRH4 CHARACTER IS ( F1A15443
TRA CHRH4 CHARACTER IS ) F1A15444
TRA CHRH4 CHARACTER IS ' F1A15445
TRA CHRH4 CHARACTER IS , F1A15450
TRA CHRH4 CHARACTER IS / F1A15451
TRA CHRH4 CHARACTER IS +-* F1A15452
TRA CHRH4 CHARACTER IS NUMERIC F1A15453
TRA CHRH4 CHARACTER IS LEGAL F1A15454
CHRH4 AXT **,1 CHARACTER IS BLANK OR COUNT TEST. F1A15455
TIX CHRH2,1,1 *IS HOLLERITH FIELD EXHAUSTED, NO. F1A15460
STZ 1G YES. CLEAR CONVERSION CELL. F1A15461
STZ LITFG RESET HOLLERITH LITERAL FLAG. F1A15462
CAL C(MQ) RESTORE PAREN COUNT IN AC. F1A15463
TRA SCAN3 *RETURN TO NORMAL SCAN. F1A15464
REM F1A15470
REM CHARACTER IS X F1A15471
REM F1A15472
CHRX0 ZET HOLFG IS THIS POSSIBLY A BLANK SPECIFICATION. F1A15480
NZT 1G YES. IS THE COUNT NON-ZERO. F1A15481
TRA LEGL0 *NO,NOT BLANK FIELD SPECIFICATION $F1A15482
STZ 1G YES. CLEAR BLANK COUNT. F1A15483
STL NOTAF SET NON-ARITHMETIC FLAG. F1A15484
TRA SCAN3 *RETURN TO SCAN. F1A15485
REM F1A15490
REM CHARACTER IS ENDMARK F1A15491
REM F1A15492
END00 PDX ,1 LOAD PAREN COUNT. F1A15500
TXL END01,1,0 *DO PARENS BALANCE, YES. F1A15501
TXL *+2,1,1200 NO, TOO MANY LEFTS OR TOO MANY RIGHTS. F1A15502
ER0032 TSX DIAG,4 *TOO MANY RIGHT PARENS. F1A15510
ER0074 TSX DIAG,4 *TOO MANY LEFT PARENS. F1A15511
END01 NZT NOTAF IS THE NON-ARITHMETIC FLAG SET. F1A15520
NZT EQSFG NO. DOES STATEMENT LACK AN = SIGN. F1A15521
TRA CC000 *YES. GO TO DICTIONARY LOOK-UP. F1A15522
AXT ARITH,4 LOAD ARITHMETIC TRANSFER ADDRESS. F1A15530
PXA ,4 SET IN AC FOR WTXQ ROUTINE. F1A15531
TRA BGPCH *WRITE STATEMENT ON INTERMEDIATE $F1A15532
REM STORAGE FOR PASS TWO. F1A15533
REM F1A15540
REM F1A15541
REM TABLE FOR SCANNING A STATEMENT. F1A15542
REM F1A15543
REM 00 01 02 03 04 05 06 07 10 11 12 = 14 15 16 17 + F1A15550
SCANT OCT 02,02,02,02,02,02,02,02,02,02,14,06,15,01,01,01,03 F1A15551
REM F1A15552
REM A B C D E F G H I +0 . ) 35 36 37 -F1A15560
OCT 01,01,01,01,01,01,01,11,01,20,01,077777000007,01,01,01,03F1A15561
REM F1A15562
REM J K L M N O P Q R -0 $ * 55 56 57 BL / F1A15570
OCT 01,01,01,01,01,01,01,01,01,17,21,22,01,01,01,00,04 $F1A15571
REM F1A15572
REM S T U V W X Y Z RM , ( 75 76 ENDMARK F1A15580
OCT 01,01,01,01,01,12,01,01,16,05,000001000010,01,01,13 F1A15581
REM F1A15582
REM CLASSIFICATION FLAGS. F1A15590
REM F1A15591
LITFG PZE ** HOLLERITH LITERAL FLAG. F1A15600
HOLFG PZE ** HOLLERITH FIELD FLAG. F1A15601
EQSFG PZE ** EQUALS SIGN FLAG. F1A15602
NOTAF PZE ** NON-ARITHMETIC FLAG. F1A15603
C(MQ) PZE ** CELL FOR SAVING MQ OR AC. F1A15604
REM F1A15605
REM F1A15610
REM *************************************************************F1A15620
REM F1A15630
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A16290
REM F1A16300
REM CC000/ CALLS=CC500,C0190X,DIAG,C0190. F1A16310
REM CC000 CLASSIFIES STATEMENT AS TO WHICH NON-ARITHMETIC. F1A16320
CC000 STZ 2G SET DICTIONARY WORD TAG, AND F1A16330
LXA L(0),3 CHARACTER COUNT AND ENTRY COUNT. F1A16340
CC001 TSX C0190X,4 * RESET CHCTR AND FWA TO BEGIN SCAN. F1A16350
TSX CC500,4 * EXAMINE NEXT DICTIONARY CHARACTER. F1A16360
CAS ENDMK TEST FOR CONSECUTIVE ENDMARKS. F1A16370
TSX MRTN77,4 *CHARACTER GREATER THAN 77 OCTAL, IMPOSS. F1A16380
TRA ER0033 * ERROR, NOT FOUND IN DICTIONARY. F1A16390
TXI CC004,,0 BEGIN COMPARISON. F1A16400
CC002 TSX CC500,4 * EXAMINE NEXT DICTIONARY CHARACTER. F1A16410
CAS ENDMK TEST FOR END OF DIC ENTRY. F1A16420
TSX MRTN77,4 *CHARACTER GREATER THAN 77 OCTAL, IMPOSS. F1A16430
TRA WTXQ0 *IF END OF ENTRY, LOOK NO FURTHER. F1A16440
CC004 STO 1C+3 OTHERWISE, SAVE CHARACTER F1A16450
STQ 1C+1 AND REMAINDER OF DICTIONARY WORD. F1A16460
TSX C0190,4 * GO GET NEXT FORMULA CHARACTER, F1A16470
LDQ 1C+1 AND RESTORE DICTIONARY WORD. F1A16480
SUB 1C+3 IF CHARACTERS ARE EQUAL, F1A16490
TZE CC002 THEN GO COMPARE NEXT CHARACTERS. F1A16500
CC005 TSX CC500,4 * OTHERWISE, EXAMINE NEXT DIC CHAR. F1A16510
SUB ENDMK CONTINUE UNTIL AN ENDMARK IS F1A16520
TNZ CC005 FOUND, THEN F1A16530
TXI CC001,1,-1 COUNT ENTRY, AND BEGIN AGAIN. F1A16540
REM END OF PROGRAM CC000. F1A16550
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A16560
REM F1A16570
REM CC500,4/ F1A16580
REM CC500 BRINGS NEXT CHARACTER OF DICTIONARY INTO AC(30-35). F1A16590
CC500 PXD ,0 CLEAR THE AC. F1A16600
TIX CC502,2,1 IF NO DICTIONARY CHARACTERS F1A16610
LXD 2G,2 REMAIN IN THE MQ, THEN F1A16620
LDQ DIC,2 REFILL WITH NEXT DICTIONARY WORD. F1A16630
TXI CC501,2,-1 RESET THE F1A16640
CC501 SXD 2G,2 DICTIONARY WORD TAG, AND F1A16650
LXA L(6),2 SET THE CHARACTER COUNT = 6. F1A16660
CC502 LGL 6 SHIFT CHAR INTO AC(30-35), F1A16670
TRA 1,4 * AND RETURN TO CALLER. F1A16680
REM END OF PROGRAM CC500. F1A16690
REM F1A16700
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A16710
REM F1A16720
REM DIC/ DICTIONARY OF NON-ARITHMETIC STATEMENTS (USED BY CC500).F1A16730
DIC OCT 244677274663 DO-GOT F1A16740
OCT -67731267462 O-IF(S F1A16750
OCT 254562256266 ENSESW F1A16760
OCT 316323307731 ITCH-I F1A16770
OCT 267462254562 F(SENS F1A16780
OCT 254331273063 ELIGHT F1A16790
OCT -373126243165 -IFDIV F1A16800
OCT 312425233025 IDECHE F1A16810
OCT 234277312621 CK-IFA F1A16820
OCT 232364446443 CCUMUL F1A16830
OCT 216346514665 ATOROV F1A16840
OCT 255126434666 ERFLOW F1A16850
OCT -373126506446 -IFQUO F1A16860
OCT -233125456346 TIENTO F1A16870
OCT -252551264346 VERFLO F1A16880
OCT -267731267721 W-IF-A F1A16890
OCT -226231274577 SSIGN- F1A16900
OCT -226346477747 STOP-P F1A16910
OCT 216462257762 AUSE-S F1A16920
OCT 254562254331 ENSELI F1A16930
OCT 273063772431 GHT-DI F1A16940
OCT -42545623146 MENSIO F1A16950
OCT -57725506431 N-EQUI F1A16960
OCT -252143254523 VALENC F1A16970
OCT 257726512550 E-FREQ F1A16980
OCT -242545237077 UENCY- F1A16990
OCT 234645633145 CONTIN F1A17000
OCT -242577512521 UE-REA F1A17010
OCT 246321472577 DTAPE- F1A17020
OCT -112521243145 READIN F1A17030
OCT -76463632147 PUTTAP F1A17040
OCT 257751252124 E-READ F1A17050
OCT 245164447751 DRUM-R F1A17060
OCT 252124776651 EAD-WR F1A17070
OCT 316325632147 ITETAP F1A17080
OCT 257766513163 E-WRIT F1A17090
OCT 254664634764 EOUTPU F1A17100
OCT -236321472577 TTAPE- F1A17110
OCT -265131632524 WRITED F1A17120
OCT -116444774751 RUM-PR F1A17130
OCT 314563774764 INT-PU F1A17140
OCT -52330775125 NCH-RE F1A17150
OCT -263145247722 WIND-B F1A17160
OCT 212342624721 ACKSPA F1A17170
OCT 232577254524 CE-END F1A17180
OCT 263143257726 FILE-F F1A17190
OCT -65144216377 ORMAT- F1A17200
OCT -226422514664 SUBROU F1A17210
OCT -233145257723 TINE-C F1A17220
OCT -064444464577 OMMON- F1A17230
OCT -112563645145 RETURN F1A17240
OCT -372321434377 -CALL- F1A17250
OCT 254524772664 END-FU F1A17260
OCT -052363314645 NCTION F1A17270
OCT 777777777777 ------ END OF DICTIONARY MARKER. F1A17280
BSS 10 F1A17290
REM END OF DICTIONARY. F1A17300
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A17310
REM F1A17320
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A17330
REM F1A17340
REM CF000/ CALLS=SR6DC1,TET00. F1A17350
REM CF000 SETS EIFNO, NONEXC, FOR NON-EXECUTABLE STATEMENTS. F1A17360
CF000 LXD EIFNO,1 INCREASE INTERNAL F1A17370
TXI *+1,1,1 FORMULA NUMBER F1A17380
SXD EIFNO,1 BY ONE. F1A17390
CAL EFN EXAMINE EXTERNAL FORMULA NUMBER. F1A17400
TZE CFNEXC IF NON-ZERO, THEN F1A17410
STA EIFNO MAKE F1A17420
TSX TET00,1 * AN ENTRY F1A17430
PZE 0 IN TEIFNO. F1A17440
CFNEXC TSX TET00,1 * THEN MAKE AN ENTRY F1A17450
PZE 14 IN THE NONEXC TABLE, F1A17460
TRA* TLABEL * AND GO PROCESS THIS STATEMENT. F1A17470
REM END OF PROGRAM CF000. F1A17480
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A17490
REM F1A17500
REM T/ TRANSFER TABLE (USED BY CF000). F1A17510
T PZE C0100,,2 DO. F1A17520
PZE C0200,,4 GO TO. F1A17530
PZE C0400,,14 IF (SENSE SWITCH. F1A17540
PZE C0500,,13 IF (SENSE LIGHT. F1A17550
PZE C0600,,13 IF DIVIDE CHECK. F1A17560
PZE C0700,,21 IF ACCUMULATOR OVERFLOW. F1A17570
PZE C0700,,18 IF QUOTIENT OVERFLOW. F1A17580
PZE C0300,,0 IF. F1A17590
PZE C1000,,6 ASSIGN. F1A17600
PZE C1300,,4 STOP. F1A17610
PZE C0900,,5 PAUSE. F1A17620
PZE C1100,,10 SENSE LIGHT. F1A17630
MZE C1200,,9 DIMENSION. F1A17640
MZE C1500,,11 EQUIVALENCE. F1A17650
MZE C1400,,9 FREQUENCY. F1A17660
PZE C1600,,8 CONTINUE. F1A17670
PZE TSB,,8 READ TAPE. F1A17680
PZE TSH,,13 READ INPUT TAPE. F1A17690
PZE DRS,,8 READ DRUM. F1A17700
PZE CSH,,4 READ. F1A17710
PZE STB,,9 WRITE TAPE. F1A17720
PZE STH,,15 WRITE OUTPUT TAPE. F1A17730
PZE SDR,,9 WRITE DRUM. F1A17740
PZE SPH,,5 PRINT. F1A17750
PZE SCH,,5 PUNCH. F1A17760
PZE RWT,,6 REWIND. F1A17770
PZE BST,,9 BACKSPACE. F1A17780
PZE EFT,,7 END FILE. F1A17790
MZE FOR,,6 FORMAT. F1A17800
MZE C3000,,10 SUBROUTINE. F1A17810
MZE C3100,,6 COMMON. F1A17820
PZE C3200,,6 RETURN. F1A17830
PZE C3300,,4 CALL. F1A17840
MZE C3400,,3 END. F1A17850
MZE C3500,,8 FUNCTION. F1A17860
BSS 10 F1A17870
REM END OF TRANSFER TABLE. F1A17880
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A17890
REM F1A17900
REM END OF PASS1 CLASSIFICATION. F1A17910
REM F1A17920
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A17930
REM F1A17940
REM PASS 1/2-PROCESS NON-EXECUTABLE STATEMENTS= F1A17950
REM F1A17960
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A17970
REM F1A17980
REM C1200/ CALLS=C0190,C0160,TEST..,DIM.SR,DIAG,C0180X. F1A17990
REM C1200 PROCESSES DIMENSION STATEMENTS. F1A18000
C1200 TSX C0190,4 * PROCEED TO ASSEMBLE IN 1G F1A18010
TSX C0160,2 * THE VARIABLE SYMBOL. F1A18020
TSX TESTE0,4 * NEXT NB CHARACTER SHOULD BE LPAREN.F1A18030
TSX C12SUB,1 USE SUBROUTINE TO COLLECT SPECIFICATION. F1A18040
TRA C1200 NOT LAST SPECIFICATION, CONTINUE. F1A18050
TRA PASS1 * EXIT TO PASS1. F1A18060
REM SUBROUTINE TO COLLENT SPECIFICATIONS OF ARRAYS AND MAKE F1A18070
REM ENTRIES IN PROPER DIMENSION TABLE. F1A18080
REM ENTRY HAS VARIABLE NAME IN 1G, SCAN IS POSITIONED AFTER ( F1A18090
C12SUB CLA 1G PUT VARIABLE SYMBOL F1A18100
STO 1C IN 1C. F1A18110
STO E+2 ALSO IN E+2. THEN F1A18120
STZ 1C+2 F1A18130
STZ 1C+3 F1A18140
STZ 1C+4 F1A18150
REM F1A18160
TSX DIM1SR,4 * GO SEARCH DIM1 TABLE. F1A18170
TRA C1280 THEN IF NOT F1A18180
TRA C1299 FOUND, F1A18190
C1280 TSX DIM2SR,4 * GO SEARCH DIM2 TABLE. F1A18200
TRA C1281 THEN IF NOT F1A18210
TRA C1299 FOUND, F1A18220
C1281 TSX DIM3SR,4 * GO SEARCH DIM3 TABLE. F1A18230
TRA C1282 DO NOT CONTINUE IF F1A18240
ER0036 BSS 0 F1A18250
C1299 TSX DIAG,4 * VARIABLE PREVIOUSLY APPEARED. F1A18260
C1282 TSX C0180X,2 * FORM IN 1G THE BINARY OF D1. F1A18270
TSX TESTB0,4 TEST FOR COMMA OR CLOSE PARENTHESIS. F1A18280
TZE C1210 THEN F1A18290
CLA 1G PUT D1 F1A18300
ALS 18 IN DECR F1A18310
STO 1C+1 OF 1C+1. F1A18320
TSX C0180X,2 * FORM IN 1G THE BINARY OF D2. F1A18330
TSX TESTB0,4 TEST FOR COMMA OR CLOSE PARENTHESIS. F1A18340
TZE C1220 THEN F1A18350
CLA 1G PUT D2 F1A18360
STA 1C+1 IN ADDRESS OF 1C+1. F1A18370
TSX C0180X,2 * FORM IN 1G THE BINARY OF D3. F1A18380
SUB CLOS IF MORE THAN 3 DIMENSION, F1A18390
TZE *+2 THIS IS AN F1A18400
ER0037 BSS 0 F1A18410
TSX DIAG,4 * ERROR - GO TO THE DIAGNOSTIC. F1A18420
CLA 1G IF 3 DIMENSION, PUT D3 F1A18430
STO 1C+2 IN 1C+2, AND F1A18440
TSX DIM3IX,4 * GO MAKE DIM3 ENTRY. F1A18450
TRA DPDIM GO TEST FOR DP-CA F1A18460
C1210 CLA 1G IF 1 DIMENSION, PUT D1 F1A18470
STO 1C+1 IN 1C+1, AND F1A18480
TSX DIM1IX,4 * GO MAKE DIM1 ENTRY. THEN F1A18490
TRA DPDIM GO TEST FOR DP-CA F1A18500
C1220 CLA 1G IF 2 DIMENSION, PUT D2 IN F1A18510
STA 1C+1 ADDRESS PART OF 1C+1. AND F1A18520
TSX DIM2IX,4 * GO MAKE DIM2 ENTRY. THEN F1A18530
DPDIM CLA MODECL F1A18540
CAS L(D) F1A18550
TRA *+2 F1A18560
TRA *+3 F1A18570
SUB L(I) F1A18580
TNZ DPDIM2 F1A18590
CLA 1C+1 GET D1, D2 F1A18600
STA 1C+3 F1A18610
STD 1C+4 F1A18620
NZT 1C+4 F1A18630
TRA DPDIM3 ONE-DIMENSIONAL F1A18640
LDQ 1C+3 F1A18650
MPY 1C+4 F1A18660
STQ 1C+1 F1A18670
NZT 1C+2 F1A18680
TRA DPDIM1 TWO-DIMENSIONAL F1A18690
MPY 1C+2 F1A18700
STQ 1C+1 F1A18710
TRA DPDIM1 F1A18720
DPDIM3 ALS 18 F1A18730
STO 1C+1 F1A18740
DPDIM1 TSX DLIST1,4 ENTER IN LIST OF DP CA ARRAYS F1A18750
C1201 SYN * F1A18760
DPDIM2 TSX C0190,4 GET NEXT NON-BLANK CHARACTER F1A18770
TSX TESTA0,4 * TEST FOR COMMA OR ENDMARK. F1A18780
TNZ 1,1 RETURN TO +1 ON COMMA. F1A18790
TRA 2,1 RETURN TO +2 ON ENDMARK. F1A18800
REM END OF PROGRAM C1200. F1A18810
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A18820
REM F1A18830
REM C1400/ CALLS=C0190,C0180,TEST..,TET00. F1A18840
REM C1400 PROCESSES FREQUENCY STATEMENTS. F1A18850
C1400 TSX C0180X,2 * GO COLLECT BINARY EFN. NEXT F1A18860
TSX TESTE0,4 * CHARACTER SHOULD BE A LPAREN. F1A18870
CLS 1G CHANGE SIGN OF EFN F1A18880
STO 1G TO MINUS. F1A18890
TSX TET00,1 * GO MAKE AN ENTRY F1A18900
PZE 7 IN THE FRET TABLE. F1A18910
C1401 TSX C0180X,2 * COLLECT AND CONVERT CONSTANT. F1A18920
STO 1C SAVE THE NEXT CHARACTER. F1A18930
TSX TET00,1 * GO ENTER CONSTANT F1A18940
PZE 7 INTO TABLE FRET (TABLE7), AND F1A18950
CLA 1C RESTORE CHAR IN ACC, AND F1A18960
TSX TESTB0,4 * TEST FOR , OR ). F1A18970
TNZ C1401 IF RIGHT PARENTHESIS, THEN F1A18980
TSX C0190,4 * OBTAIN IN ACC NEXT NBCHAR, AND F1A18990
TSX TESTA0,4 * TEST FOR COMMA OR ENDMARK. F1A19000
TNZ C1400 IF ENDMARK, THIS STATEMENT IS DONE.F1A19010
TRA PASS1 * EXIT TO PASS1. F1A19020
REM END OF PROGRAM C1400. F1A19030
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A19040
REM F1A19050
REM C1500/ CALLS=C0190,TEST..,C0160,C0180,TET00. F1A19060
REM C1500 PROCESSES EQUIVALENCE STATEMENTS. F1A19070
C1500 TSX C0190,4 * OBTAIN NEXT NBCHAR IN ACC. F1A19080
TSX TESTE0,4 * CHARACTER SHOULD BE A LPAREN. F1A19090
C1501 CLA L(1) INITIALIZE 1C F1A19100
STO 1C+1 TO 1. F1A19110
TSX C0190,4 * OBTAIN NEXT NBCHAR IN ACC AND F1A19120
TSX C0160,2 * OBTAIN IN 1G THE SYMBOL V. F1A19130
LDQ 1G MOVE V F1A19140
STQ 1C INTO 1C. F1A19150
CAS OPEN EXAMINE CHARACTER LEFT IN THE AC, F1A19160
TXI C1503,,0 AND IF F1A19170
TXI C1502,,0 CHARACTER IS A LEFT PARENTHESIS, F1A19180
TXI C1503,,0 THEN F1A19190
C1502 TSX C0180X,2 * FORM IN 1G THE BINARY OF N. F1A19200
TSX TESTF0,4 * 1ST NON-NUMERIC SHOULD BE A RPAREN.F1A19210
CLA 1G PUT BIN EQUIV OF N F1A19220
STO 1C+1 IN 1C+1. F1A19230
TSX C0190,4 * OBTAIN NEXT NBCHAR IN AC, AND F1A19240
C1503 TSX TESTB0,4 * TEST FOR COMMA OR RPAREN. F1A19250
TZE C1504 IF COMMA, THEN F1A19260
TSX TET00,1 * GO TO PROGRAM TET TO ENTER SYMBOL F1A19270
PZE 8 AND N IN EQUIT (TABLE 8), AND F1A19280
TXI C1501,,0 RETURN TO CONTINUE PROCESSING X. F1A19290
C1504 CLS 1C+1 MAKE SIGN OF N MINUS SINCE F1A19300
STO 1C+1 THIS IS LAST ITEM. F1A19310
TSX TET00,1 * GO TO PROGRAM TET TO ENTER SYMBOL F1A19320
PZE 8 AND N IN EQUIT (TABLE 8), AND F1A19330
TSX C0190,4 * OBTAIN NEXT NBCHAR IN ACC, AND F1A19340
TSX TESTA0,4 * TEST FOR COMMA OR ENDMARK. F1A19350
TNZ C1500 IF ENDMARK, THEN F1A19360
TRA PASS1 * EXIT TO PASS1. F1A19370
REM END OF PROGRAM C1500. F1A19380
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A19390
REM F1A19400
REM C3000/ CALLS=DIAG,C0190,C0160,TEST..,SUBX00,TET00,TESTFX. F1A19410
REM C3000 PROCESSES SUBROUTINE AND FUNCTION STATEMENTS. F1A19420
C3500 CAL TXHOP SET OP-SWITCH F1A19430
STP C3003 TO NOP CASE. F1A19440
REM F1A19450
C3000 LXD EIFNO,4 EXAMINE INTERNAL FORMULA NO., AND F1A19460
TXL P1PCH,4,1 IF NOT THE 1ST STATEMENT, THEN $F1A19470
ER0038 TSX DIAG,4 * ERROR - GO TO THE DIAGNOSTIC. F1A19480
SXD CITCNT,4 DELETE (FPT) INSTRUCTIONS FROM CITS $F1A19490
SXD CLSBCN,0 SET CLOSUB P TO ZERO. F1A19500
TSX C0190,4 * IF 1ST CHARACTER OF NAME IS F1A19510
TSX C0160,2 * ASSEMBLE NAME IN 1G. F1A19520
TSX TESTC0,4 * NEXT CHAR SHD BE LPAREN OR ENDMARK.F1A19530
C3003 TXL *+3,,0 OP SWITCH (TXL/TXH). F1A19540
CLA 1G IF FUNCTION STATEMENT, F1A19550
STO FSNAME THEN SAVE NAME IN FSNAME. F1A19560
TSX TET00,1 * GO ENTER NAME F1A19570
PZE 11 IN SUBDEF TABLE. F1A19580
LXD EIFNO,4 PLACE F1A19590
PXD ,4 INTERNAL FORMULA NUMBER F1A19600
STO G IN G. F1A19610
TXI C3002,,0 TEST FOR END OF STATEMENT. F1A19620
C3001 ADD ENDMK IF NOT ENDMARK, RESTORE CHARACTER F1A19630
STO FIRSTC 1ST CHARACTER OF ARGUMENT. F1A19640
TSX C0160,2 * ASSEMBLE ARGUMENT IN 1G. F1A19650
TSX TESTB0,4 * NEXT CHAR SHD BE COMMA OR RPAREN. F1A19660
CLA 1G MOVE ARGUMENT F1A19670
STO G+1 INTO G+1. F1A19680
TSX TESTFX,1 * GO TEST FOR FIXED OR FLOATING PT. F1A19690
TXI C3004,,0 IF FLOATING PT., SKIP FORVAL ENTRY.F1A19700
TSX TET00,1 * IF FIXED POINT, GO MAKE ENTRY F1A19710
PZE 6 IN FORVAL TABLE. F1A19720
C3004 TSX TET00,1 * IN BOTH CASES, MAKE ENTRIES IN F1A19730
PZE 11 SUBDEF TABLE. F1A19740
CLA ARGCNT UPDATE F1A19750
ADD 2E18 ARGUMENT COUNT F1A19760
STO ARGCNT BY 1. AND F1A19770
C3002 TSX C0190,4 * EXAMINE NEXT NON-BLANK CHARACTER. F1A19780
SUB ENDMK IF NOT ENDMARK, THEN F1A19790
TNZ C3001 GO PROCESS NEXT ARGUMENT. F1A19800
TRA PASS1 * EXIT TO PASS1. F1A19810
REM END OF PROGRAM C3000. F1A19820
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A19830
REM F1A19840
REM C3100/ CALLS=C0190,DIAG,TEST..,C0160,TET00,TESTFX+1. F1A19850
REM C3100 PROCESSES COMMON STATEMENTS. F1A19860
C3100 TSX C0190,4 * GET FIRST NON-BLANK CHAR OF SYMBOL F1A19870
TSX C0160,2 * ASSEMBLE SYMBOL IN 1G, AND TEST F1A19880
STO CHSAVE SAVE PUNCTUATION FOR LATER TEST. F1A19890
TSX TET00,1 * GO ENTER THIS SYMBOL F1A19900
PZE 12 IN COMMON TABLE. F1A19910
CLA 2E18 SET AN IFN OF 1 INCASE THIS IS A F1A19920
STO G FIXED POINT VARIABLE, IN WHICH F1A19930
CAL 1G CASE COMMON IS A FORVAL DEFINITION.F1A19940
SLW G+1 F1A19950
ARS 30 ENTER ANY F1A19960
TSX TESTFX+1,1 * FIXED POINT F1A19970
TRA C3101 VARIABLES F1A19980
TSX TET00,1 * IN F1A19990
PZE 6 FORVAL TABLE. F1A20000
C3101 CLA CHSAVE GET PUNCTUATION CHARACTER. F1A20010
C3102 TSX TESTA0,4 * NEXT CHARACTER FOR COMMA OR ENDMK. F1A20020
TNZ C3100 NOT LAST SPECIFICATION, CONTINUE. F1A20030
TRA PASS1 FINISHED, RETURN TO CLASSIFICATION. F1A20040
REM END OF PROGRAM C3100. F1A20050
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A20060
REM F1A20070
REM C3400/ CALLS=C0190,TET00,TEST..,DIAG. F1A20080
REM C3400 PROCESSES END STATEMENTS. F1A20090
C3400 TSX C0190,4 * FIRST CHARACTER SHOULD BE F1A20100
TSX TESTC0,4 * LEFT PARENTHESIS OR ENDMK. F1A20110
TZE C3402 * EXIT IF ENDMK, OTHERWISE F1A20120
C3401 TSX C0190,4 * NEXT CHARACTER SHOULD BE F1A20130
CAS L(2) 0,1,2 --OTHERWISE, F1A20140
ER0040 TSX DIAG,4 * CALL DIAGNOSTIC. F1A20150
NOP MAKE F1A20160
STO G ENTRY F1A20170
TSX TET00,1 * IN TAPE TABLE F1A20180
PZE 19 ENDI. F1A20190
TSX C0190,4 * NEXT CHARACTER SHOULD BE F1A20200
TSX TESTB0,4 * COMMA OR RIGHT PARENTHESIS. F1A20210
TNZ C3401 WHEN RIGHT PARENTHESIS IS MET, F1A20220
TSX C0190,4 * NEXT CHARACTER SHOULD BE F1A20230
TSX TESTD0,4 * ENDMK. F1A20240
C3402 AXT 9,1 INITIALIZE CHARACTER SKIP COUNTER. F1A20250
TSX C0190X,4 RESET SCAN TO FIRST WORD OF STATEMENT. F1A20260
TSX C0190,4 SKIP UP TO THIRD PARAMETER. F1A20270
TIX *-1,1,1 F1A20280
SLW ONLINE SAVE IN ON-LINE FLAG CELL. F1A20290
SUB L(2) IS THE SETTING A TWO. F1A20300
TMI *+2 *NO, LEAVE IT THE WAY IT IS $F1A20310
STZ ONLINE NO ON-LINE PRINT REQUESTED. F1A20330
LXD LDFT2,4 LOAD EOF FLAG FOR INPUT TAPE. F1A20340
TXL PASS1,4,0 HAS AN END-OF-FILE BEEN SENSED. F1A20350
ER1008 TSX DIAG,4 NO, END CARD OUT OF SEQUENCE. F1A20360
REM END OF PROGRAM C3400. F1A20370
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A20380
REM F1A20390
REM FOR/ CALLS=TET00,C0190,TEST..,C0180,DIAG. F1A20400
REM FOR PROCESSES FORMAT STATEMENTS. F1A20410
FOR NZT EFN TEST FOR STATEMENT NUMBER F1A20420
ER1009 TSX DIAG,4 NONE, ERROR F1A20430
TRA FORCHK+2 BRANCH TO PATCH. $F1A20431
LXD FWA,2 LOAD CURRENT F-REGION INDEX. F1A20432
LDI RESIDU SAVE RESIDU. F1A20433
TSX C0190,4 GET NEXT CHARACTER. F1A20434
TSX TESTE0,4 TEST FOR OPEN PAREN. F1A20435
STI RESIDU RESTORE RESIDU. F1A20436
STZ 1G F1A20440
LXD BFCNT,4 PICK UP BUFFER COUNT F1A20450
CAL SET FIRST ENTRY IS 8) EIFNO. F1A20460
ORA EIFNO F1A20470
SLW TABORG,4 F1A20480
STL FRXT F1A20490
TNX FRWR,4,1 UPDATE COUNT, TEST FOR FULL BUFFER. F1A20500
STZ EFLAG INITIALIZE CLOSING PAREN FLAG. F1A20520
ZAC F1A20530
TNX FORMV,1,1 F1A20540
LDQ RESIDU FILL REMAINDER OF FIRST WORD F1A20550
CAL BLANKS IN RESIDU WITH BLANKS F1A20560
LGL 6 F1A20570
TIX *-1,1,1 F1A20580
XCL PUT FIRST WORD IN MQ F1A20590
ZAC F1A20600
TXI *+1,2,1 BACK UP SCAN FOR THIS WORD. F1A20610
BFCNT TXI *+2,0,BFSZ F1A20620
FORMV LDQ **,2 F1A20630
SXA FORT2,2 F1A20640
AXT 6,2 INIT FOR SIX CHARACTERS F1A20650
REM EACH CHARACTER PRODUCES A TRANSFER CODE IN IR(1) FOR F1A20660
REM THE APPROPRIATE ACTION ON LEGAL, ILLEGAL, NUMERIC OR F1A20670
REM POSSIBLE HOLLERITH CHARACTERS. SCAN ENDS ON ENDMARK. F1A20680
FORCHK CAQ FTBL,1,1 F1A20690
TRA TBLKP,1 BRANCH TO PATCH. $F1A20700
STL FORSW INITIALIZE FORSW TO 'ON' FOR COMMA PATCH.$F1A20701
LXA XCHCTR,1 LOAD CHARACTER COUNT FOR RESIDU. $F1A20710
TRA FOR+3 RETURN TO NON-PATCHED PORTION. $F1A20720
ER1002 BSS 0 F1A20730
FORERR TSX DIAG,4 CHAR IS ILLEGAL IN FORMAT F1A20740
FORSW PZE ** MISSING COMMA INDICATOR $F1A20750
STZ 1G CHARACTER IS LEGAL, ERASE PREVIOUS NUM. F1A20760
TBLK TIX FORCHK,2,1 CHARACTER IS BLANK F1A20770
STQ TABORG,4 PUT IT AWAY F1A20780
STL FRXT F1A20790
TNX FRWR,4,1 F1A20800
FORT2 AXT **,2 F1A20810
TXI FORMV,2,-1 *GET NEXT WORD FROM F-REGION. F1A20820
REM F1A2082A
CLSPR PDX ,1 LOAD PAREN COUNT. F1A2082B
TXH ER0032,1,-100 *ARE THERE TOO MANY RIGHT PARENS, YES. F1A2082C
TXH SLORCM,1,0 *NO, IS THIS THE CLOSING PAREN $F1A2082D
ZET EFLAG YES. HAS PAREN COUNT GONE TO ZERO BEFORE. F1A2082E
TRA ER0019 *YES. ENDMARK DOES NOT FOLLOW CLOSING ). F1A2082F
STL EFLAG NO. SET CLOSING PAREN FLAG. F1A2082G
ZAC RESET PAREN COUNT. F1A2082H
TRA TBLK-1 *RETURN TO SCAN. F1A2082I
REM F1A2082J
FOREND STQ TABORG,4 F1A20830
STL FRXT F1A20840
TNX FRWR,4,1 F1A20850
PDX 0,1 PAREN BALANCE KEPT IN DECR. OF AC BY CAQ. F1A20860
TXH END00,1,0 *DO PARENS BALANCE, NO. F1A20870
SUB L(5) WAS THE CLOSING RIGHT PAREN FOLLOWED F1A20871
TNZ ER0019 *BY THE ENDMARK, NO. F1A20872
SXD BFCNT,4 F1A20880
TRA PASS1 F1A20890
REM SUBROUTINE TO CONVERT BCI TO BINARY FOR POSSIBLE F1A20900
REM SPACING OVER HOLLERITH FIELDS. F1A20910
CVR STQ C(MQ) SAVE WORD IN PROCESS. F1A20920
XCL SAVE PAREN COUNT, MOVE CHAR. TO AC. F1A20930
ANA ENDMK ISOLATE CHARACTER, AND CONVERT F1A20940
SLW 2G F1A20950
CLA 1G F1A20960
ALS 2 F1A20970
ADD 1G F1A20980
ALS 1 F1A20990
ADD 2G F1A21000
STO 1G F1A21010
XCL RESTORE PAREN COUNT F1A21020
LDQ C(MQ) RESTORE WORD IN PROCESS. F1A21030
TRA TBLK F1A21040
REM SUBROUTINE TO SPACE OVER N HOLLERITH CHARACTERS. F1A21050
HF LXA 1G,1 F1A21060
STZ 1G RESET HOLLERITH CHARACTER COUNT. F1A21061
TXL FORERR,1,0 N MUST NOT BE ZERO F1A21070
TNX *+4,2,1 SKIP REMAINING CHARACTERS F1A21080
RQL 6 THIS WORD. F1A21090
TIX *-2,1,1 COUNT DOWN N F1A21100
TRA TBLK F1A21110
STQ TABORG,4 F1A21120
STL FRXT F1A21130
TNX FRWR,4,1 F1A21140
XEC FORT2 GET ANOTHER WORD. F1A21150
TIX *+1,2,1 F1A21160
XEC FORMV F1A21170
TNX *+6,1,6 IS IT ALL IN A HOLLERITH FIELD. F1A21180
STQ TABORG,4 YES, PUT IT ALL AYAY. F1A21190
STL FRXT F1A21200
TNX FRWR,4,1 F1A21210
TIX *-5,2,1 F1A21220
TRA FORERR HOLLERITH GOES BEYOND STATEMENT F1A21230
SXA FORT2,2 F1A21240
AXT 6,2 NO , SPACE OVER THE REST OF THE CHARS. F1A21250
RQL 6 F1A21260
TNX TBLK+1,2,1 F1A21270
TIX *-2,1,1 F1A21280
TRA FORCHK CHECK OUT REST OF WORD. F1A21290
REM SUBROUTINE TO DUMP TEMPORARY FORMAT BUFFER ONTO TAPE. F1A21300
FRWR ZET DGFLAG HAS THERE BEEN AN ERROR. F1A21310
TRA FRWRA *YES, RETURN TO CALLER. F1A21311
LXD INTETK+1,4 NO. LOAD COUNT OF WORDS ON TAPE. F1A21312
TXI *+1,4,BFSZ UPDATE WORD COUNT AND SAVE. F1A21320
SXD INTETK+1,4 COUNT OF WORDS ON TAPE. F1A21330
LXD FLBL,4 F1A21340
TXI *+1,4,1 F1A21350
SXD FLBL,4 COUNT OF HOW MANY DUMPS. F1A21360
TSX (TAPE),4 F1A21370
PZE FORIO,,(WBNC) F1A21380
PZE INTETK+2,,FRMTTP F1A21390
STL TETFLG SET BUFFER DUMP FLAG. F1A21400
FRWRA LXA FRXT,4 LOAD LOCATION OF TNX CALLER. F1A21410
TXI *+1,4,1 INCREMENT AND SET RETURN ADDRESS. F1A21420
SXA FRXT,4 F1A21421
AXT BFSZ,4 F1A21430
FRXT TRA ** F1A21440
FLBL PZE 10,,** ** TAPE BLOCK NUMBER F1A21450
FORIO IOCP FLBL,,1 F1A21460
IOCT TABORG-BFSZ,,BFSZ $F1A21470
REM F1A21471
EFLAG PZE ** INDICATOR FOR CLOSING PAREN. F1A21472
REM F1A21480
FTBL OCT 4,4,4,4,4,4,4,4,4,4,3,3,3,3,3,3,3,11,3,3,3,11,11,3,2,11 $F1A21481
OCT 3,1,077777000006,3,3,3,1,3,3,3,3,3,11,1,3,3,3,3,3,3,3,3 $F1A21490
OCT 0,10,3,3,3,3,3,7,3,3,3,10,000001000001,3,3,5 $F1A21500
REM F1A21510
REM END OF PROGRAM FOR. F1A21520
REM F1A21530
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A21540
REM F1A21550
REM END OF PROCESSORS FOR NON-EXECUTABLE STATEMENTS. F1A21560
REM F1A21570
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1A21580
REM F1A21590
REM PASS 1/3-PATCH AREA= F1A21600
BEGP1P SYN * BEGINNING OF PASS 1 PATCH SPACE. F1A21610
P1PCH PXD 0,4 AND SAVE FOR CLA 2 $F1A21611
STO CLAIFN $F1A21612
STD EIFNO $F1A21613
LXD CITCNT,4 DELETES (FPT) INSTRUCTIONS $F1A21614
TXI ER0038+1,4,12 BUT LEAVES IN SAVING OF LOCATION 2 $F1A21615
TRA AEFIO CHAR IS A, E, F, I, OR O. $F1A21616
TRA SLORCM CHAR IS , OR /. . $F1A21617
TRA ITISX CHAR IS X. $F1A21618
TRA CLSPR CHAR IS ). $F1A21619
TRA FOREND CHAR IS ENDMARK. $F1A2161A
TRA CVR CHAR IS NUMERIC. $F1A2161B
TRA FORERR CHAR IS ILLEGAL IN FORMAT. $F1A2161C
TRA HFPCH CHAR IS H. $F1A2161D
STZ 1G CHAR IS LEGAL, ERASE PREVIOUS NUMBER. $F1A2161E
TBLKP TRA TBLK CHAR IS BLANK. $F1A2161F
SLORCM STL FORSW TURN ON FORSW. $F1A2161G
TRA TBLK-1 $F1A2161H
AEFIO NZT FORSW IS FORSW ON. $F1A2161I
TRA FORERR NO --MISSING COMMA. $F1A2161J
STZ FORSW YES--TURN IT OFF $F1A2161K
TRA TBLK-1 $F1A2161L
ITISX NZT FORSW IS FORSW ON. $F1A2161M
TRA FORERR NO--MISSING COMMA. $F1A2161N
TRA TBLK-1 YES. LEAVE IT ON $F1A2161O
HFPCH NZT FORSW IS FORSW ON. $F1A2161P
TRA FORERR NO --MISSING COMMA. $F1A2161Q
TRA HF YES--LEAVE IT ON AND GO TO H PROG. $F1A2161R
P1PCH3 SYN * NEXT PATCH BEGINS HERE. $F1A2161S
SCAN00 STZ CHSV3 CLEAR CHARACTER CODE CELL $F1A21620
STZ 1G CLEAR CONVERSION CELL $F1A21630
STZ BUGSW1 INITIALIZE SWITCHES $F1A21640
STZ BUGSW2 $F1A21650
TRA SCAN0+1 $F1A21651
CHSV1 TXL CHSV2,1,0 STORE CHARACTER CODE UNLESS CHARACTER IS $F1A21652
TXH CHSV2,1,17 OPERATOR OR BLANK $F1A21653
TXH CHSV2-1,1,4 $F1A21654
TXH CHSV2,1,2 $F1A21655
SXA CHSV3,1 STORE CHARACTER CODE $F1A21656
CHSV2 TRA SCAN3,1 $F1A21657
CHSV3 PZE ** CHARACTER CODE CELL $F1A21658
PMS01 SXA PMS02+1,2 SAVE XR2 $F1A21660
LXA CHSV3,2 LOAD PREVIOUS CHARACTER CODE $F1A21670
TXH DBLER,2,18 DOUBLE OPERATOR ERROR $F1A21680
TXH DBLR,2,17 DOUBLE OPERATOR ERROR IF NO ** $F1A21690
TXH PMS02,2,8 $F1A21700
TXL PMS02,2,2 $F1A21710
TXL DBLER,2,4 DOUBLE OPERATOR ERROR $F1A21720
TXL PMS02,1,3 $F1A21730
TXH BINER,2,7 ERROR-BINARY OPERATOR $F1A21740
TXL BINER,2,6 USED AS UNARY $F1A21750
PMS02 SXA CHSV3,1 STORE CHARACTER CODE $F1A21760
AXT **,2 $F1A21770
TXH PMS00,1,17 TRANSFER TO PMS00 IF $F1A21780
TXL PMS00,1,3 OPERATOR IS +,-,* $F1A21790
TRA SLSH0 OPERATOR IS / $F1A21800
DBLR TXL DBLER,1,4 DOUBLE OPERATOR ERROR *-,*+,*1 $F1A21810
TXI *+1,1,1 OPERATOR IS **, $F1A21820
SXA CHSV3,1 CHARACTER CODE IS 19 $F1A21830
TXI PMS02+1,1,-1 $F1A21840
DBLER STL BUGSW1 DBL OPERATOR ERROR ONLY IF ARITHMETIC $F1A21842
TRA PMS02 STATEMENT $F1A21843
BINER STL BUGSW2 BINARY OP ERROR ONLY IF ARITHMETIC $F1A21850
TRA PMS02 STATEMENT $F1A21860
BGPCH ZET BUGSW1 WAS THERE A DOUBLE OP ERROR $F1A21870
ER0080 TSX DIAG,4 YES $F1A21880
ZET BUGSW2 NO,WAS THERE BINARY OP ERROR $F1A21890
ER0081 TSX DIAG,4 YES $F1A21895
TRA WTXQ1 NO $F1A21900
BUGSW1 PZE ** DOUBLE OP SWITCH $F1A21910
BUGSW2 PZE ** BINARY OP ERROR SWITCH $F1A21914
REM ADDITIONAL PATCH SPACE $F1A21915
DUP 1,102 $F1A21916
PZE $F1A21917
BSS 29 REMAINDER OF PASS 1 PATCH SPACE. $F1A99000
ENDP1P SYN * $F1A99010
REM $F1A99020
REM ************************************************************$F1A99030
REM $F1A99040
REM FT-REGION DEFINITION -TEMPORARY F-REGION. $F1A99050
REM $F1A99060
IORT FTBUF,,FTBFSZ FT BUFFER 1 I/O COMMAND. $F1A99070
FTREG PZE **,2 ADDRESS OF CURRENT FT-BUFFER. $F1A99080
IORT FTBUF+FTBFSZ,,FTBFSZ FT BUFFER 2 I/O COMMAND. $F1A99090
REM $F1A99100
BEGFTR SYN * ORIGIN OF FT-REGION. $F1A99110
REM $F1A99120
FTBUF BSS FTBFSZ BUFFER 1. $F1A99130
BSS FTBFSZ BUFFER 2. $F1A99140
REM $F1A99150
ENDFTR SYN * END OF FT-REGION. $F1A99160
REM $F1A99170
REM ************************************************************$F1A99180
REM $F1A99190
ENDF10 BSS 0 $F1A99200
ENDP1 BSS 0 $F1A99210
REM RECORD LIMIT FOR PASS ONE. $F1A99220
TCD -1 $F1A99225
TTL * SECTION ONE PASS TWO * RECORD 9F14 * F1B00000
LBL 9F14,THE WORKS F1B00010
REM F1B00030
ORG SYSCUR $F1B00040
BCI 1,9F1400 $F1B00050
ORG (LODR) $F1B00060
TXI PASS2I,,140 ENTRY POINT,,RECORD NUMBER F1B00070
REM F1B00080
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B00090
REM F1B00100
REM SECTION 1 / PASS2 = F1B00110
ABS F1B00120
ORGP2 ORG ORGP1 F1B00130
REM F1B00140
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B00150
REM F1B00160
REM PASS 2/1-COMMON= F1B00170
P2CON BSS 0 F1B00180
L(S) BCD 100000S S F1B00190
L(T) BCD 100000T T F1B00200
L(X) BCD 100000X X F1B00210
L(Z) BCD 100000Z Z F1B00220
BIT29 OCT 100 F1B00230
L(96) OCT 140 USED BY C0500. F1B00240
L(112) OCT 160 USED BY C0400. F1B00250
L(A() BCD 10000A( INTERNAL FLO-PT VARIABLE PREFIX. F1B00260
L(H() BCD 10000H( F1B00270
L(I() BCD 10000I( INTERNAL FXD-PT VARIABLE PREFIX. F1B00280
2E17 OCT 400000 TAG=4 F1B00290
ABTAG2 OCT 1000002 CONSTANT USED BY C3200. F1B00300
ABTAG1 PZE 4,0,1 ADD OF 1, TAG OF 4. F1B00310
M1BAR MZE 0,0,-1 MASK F1B00320
2E19 PZE 0,0,2 F1B00330
D2 PZE ,,2 CONSTANT USED BY IOT. F1B00340
2AND2 PZE 2,0,2 F1B00350
DEC3 PZE ,,3 F1B00360
2E20 PZE ,,4 F1B00370
DECMI4 MZE 0,0,4 F1B00380
DEC5 PZE ,,5 F1B00390
ABTAG3 OCT 2000004 CONSTANT USED BY C3200. F1B00400
BETAD2 OCT 3077775 3*2**18+(-3) -ARITHMETIC. F1B00410
D4A4 PZE 4,,4 F1B00420
FSIND PZE ,,16 F1B00430
DEC17 PZE ,,17 F1B00440
DEC18 PZE ,,18 F1B00450
MASK5 OCT 37777600 -ARITHMETIC. F1B00460
FNIND PZE ,,32 F1B00470
DEC35 PZE ,,35 F1B00480
NGTBIT OCT 000200000000 F1B00490
E( BCD 1100000 -ARITHMETIC. F1B00500
I( BCD 1200000 -ARITHMETIC. F1B00510
A( BCD 1300000 -ARITHMETIC. F1B00520
P( BCD 1400000 -ARITHMETIC. F1B00530
O( BCD 1600000 -ARITHMETIC. F1B00540
X( BCD 1700000 -ARITHMETIC. F1B00550
BETAD1 OCT 77775077775 (-3(*2**18+(-3) -ARITHMETIC. F1B00560
PROCTR DEC 15B5 CONSTANT USED BY IOT, ARITH. F1B00570
ADPLUS OCT 200000000000 ADDITION SIGN -ARITHMETIC. F1B00580
FLOVAR BCD 1A(0000 A( INTERNAL FLOATING PT. VARIABLE. F1B00590
FXFX BCD 1EXP(1 F1B00600
FLFX BCD 1EXP(2 F1B00610
FLFL BCD 1EXP(3 F1B00620
FIXVAR BCD 1I(0000 I( INTERNAL FIXED PT. VARIABLE. F1B00630
MINUS0 MZE 0 F1B00640
DECMI1 MZE ,,1 F1B00650
M1T MZE 8,,1 F1B00660
DECMI2 MZE ,,2 F1B00670
MI205 MZE ,,205 F1B00680
ADSPOP OCT 530000000000 $00000 F1B00690
DOLSGN BCI 1,$ CONSTANT USED BY C32000 F1B00700
ADSTAR OCT -140000000000 MULTIPLICATION SIGN -ARITHMETIC. F1B00710
STRSTR OCT -145400000000 EXPONENTIATION SIGN -ARITHMETIC. F1B00720
FAKEN3 OCT 017777777776 CONSTANT FOR DO STATEMENTS WITHOUT N3. F1B00730
MASK1 OCT -377777700000 -(2**20-U.*2**15 -ARITHMETIC. F1B00740
MASK4 OCT -377777777737 -ARITHMETIC. F1B00750
REM F1B00760
L(ADD) BCD 1ADD000 SYMBOLIC OPERATION CODE. F1B00770
L(ALS) BCD 1ALS000 SYMBOLIC OPERATION CODE. F1B00780
L(ANA) BCD 1ANA000 SYMBOLIC OPERATION CODE. F1B00790
L(ARS) BCD 1ARS000 F1B00800
L(BSS) BCD 1BSS000 SYMBOLIC OPERATION CODE. F1B00810
L(CAL) BCD 1CAL000 F1B00820
L(CHS) BCD 1CHS000 SYMBOLIC OPERATION CODE. F1B00830
L(CLA) BCD 1CLA000 SYMBOLIC OPERATION CODE. F1B00840
L(CLM) BCD 1CLM000 SYMBOLIC OPERATION CODE. F1B00850
L(CLS) BCD 1CLS000 SYMBOLIC OPERATION CODE. F1B00860
L(COM) BCD 1COM000 F1B00870
L(CPY) BCD 1CPY000 F1B00880
L(DCT) BCD 1DCT000 SYMBOLIC OPERATION CODE. F1B00890
L(DED) BCD 1DED000 F1B00900
L(DVP) BCD 1DVP000 SYMBOLIC OPERATION CODE. F1B00910
L(FAD) BCD 1FAD000 SYMBOLIC OPERATION CODE. F1B00920
L(FDP) BCD 1FDP000 SYMBOLIC OPERATION CODE. F1B00930
L(FMP) BCD 1FMP000 SYMBOLIC OPERATION CODE. F1B00940
L(FSB) BCD 1FSB000 SYMBOLIC OPERATION CODE. F1B00950
L(HPR) BCD 1HPR000 SYMBOLIC OPERATION CODE. F1B00960
L(LDA) BCD 1LDA000 F1B00970
L(LDQ) BCD 1LDQ000 SYMBOLIC OPERATION CODE. F1B00980
L(LLS) BCD 1LLS000 SYMBOLIC OPERATION CODE. F1B00990
L(LRS) BCD 1LRS000 SYMBOLIC OPERATION CODE. F1B01000
L(LXD) BCD 1LXD000 SYMBOLIC OPERATION CODE. F1B01010
L(MPY) BCD 1MPY000 SYMBOLIC OPERATION CODE. F1B01020
L(MSE) BCD 1MSE000 SYMBOLIC OPERATION CODE. F1B01030
L(ORA) BCD 1ORA000 SYMBOLIC OPERATION CODE. F1B01040
L(PSE) BCD 1PSE000 SYMBOLIC OPERATION CODE. F1B01050
L(PXA) BCD 1PXA000 F1B01060
L(PXD) BCD 1PXD000 F1B01070
L(PZE) BCD 1PZE000 F1B01080
L(QPR) BCD 1QPR000 CONSTANT USED BY C3200. F1B01090
L(QXD) BCD 1QXD000 CONSTANT USED BY C3200. F1B01100
L(SLW) BCD 1SLW000 F1B01110
L(STA) BCD 1STA000 SYMBOLIC OPERATION CODE. F1B01120
L(STO) BCD 1STO000 SYMBOLIC OPERATION CODE. F1B01130
L(STQ) BCD 1STQ000 SYMBOLIC OPERATION CODE. F1B01140
L(STR) BCD 1STR000 F1B01150
L(STZ) BCD 1STZ000 F1B01160
L(SUB) BCD 1SUB000 SYMBOLIC OPERATION CODE. F1B01170
L(SXD) BCD 1SXD000 SYMBOLIC OPERATION CODE. F1B01180
L(SXQ) BCD 1SXQ000 F1B01190
L(TIX) BCD 1TIX001 F1B01200
L(TNZ) BCD 1TNZ000 F1B01210
L(TRA) BCD 1TRA000 SYMBOLIC OPERATION CODE. F1B01220
L(TSX) BCD 1TSX000 SYMBOLIC OPERATION CODE. F1B01230
L(UFA) BCD 1UFA000 SYMBOLIC OPERATION CODE. F1B01240
L(XCA) BCD 1XCA000 F1B01250
P2VAR BSS 0 F1B01260
HOLCNT BCD 1H(0000 WORKING STORAGE USED BY C3300. F1B01270
RAT PZE 8,,** VARIABLE USED BY IOT. F1B01280
TL PZE 31*8,,** F1B01290
ENT BCD 1NTR000 P2VAR USED BY FLTR00. F1B01300
NZE BCD 1PZE000 P2VAR USED BY FLTR00. F1B01310
EJECT F1B01320
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B01330
REM F1B01340
REM READS A CONDENSED EXECUTABLE STATEMENT FROM TAPE, ASSIGNS F1B01350
REM AN IFN AND MAKES AN ENTRY IN TEIFNO IF AN EFN EXISTS. F1B01360
REM F1B01370
PASS2I TSX (TAPE),4 INITIALIZATION FOR PASS 2. F1B01380
PZE DCF-1,,(RBNP) LOAD F-REGION (BUFFER 1). F1B01390
PZE WTXQ5,,EXEQTP F1B01400
CAL DLIST1-1 INITIALIZE DLIST1 F1B01410
STA ACDP01 ADDRESS IN F1B01420
ADD L(1) ADDRESS COMPLETION F1B01430
STA ACDP07 ROUTINE. F1B01440
CLA FLCNIX-1 GET ADDRESS OF FLOCON TABLE. F1B01450
STA ENFC01 INITIALIZE SEARCH ROUTINE WITH F1B01460
STA ENFC05 ADDRESS OF FIRST LOCATION. F1B01470
CLA FLCNIX-2 GET ADDRESS OF FLOCON TABLE PLUS ONE. F1B01480
STA ENFC06 INITIALIZE ADDRESS IN SEARCH ROUTINE TO F1B01490
STA ENFC07 THE NEXT CORE ADDRESS. F1B01500
REM F1B01510
REM NORMAL RE-ENTRY TO GET THE NEXT EXECUTABLE STATEMENT. F1B01520
REM F1B01530
PASS2 LXA XEQCTR,4 LOAD COUNT OF EXECUTABLE STATEMENTS. F1B01540
TXL ENDTST,4,0 *HAVE ALL STATEMENTS BEEN PROCESSED, YES. F1B01550
TXI *+1,4,-1 REDUCE COUNT. F1B01560
SXA XEQCTR,4 SAVE DECREMENTED COUNT. F1B01570
RDXQ1 AXC 1,2 FLIP BUFFER SWITCH. F1B01580
TSX (TAPE),4 READ ANOTHER STATEMENT. F1B01590
PZE DCF,2,(RBNP) F1B01600
PZE WTXQ5,,EXEQTP F1B01610
SXA RDXQ1,2 RESET BUFFER SWITCH. F1B01620
LAC RDXQ1,2 FLIP TO CURRENT BUFFER. F1B01630
CLA DCF,2 GET LOAD ADDRESS OF I/O COMMAND. F1B01640
ADD L(4) COMPUTE ADDRESS OF STATEMENT. F1B01650
PAC ,2 GET 2S COMPLEMENT OF ORIGIN OF F-REGION F1B01660
SXD DCF,2 AND SAVE OTHER ROUTINES. F1B01670
STA DCF SAVE TRUE ADDRESS. F1B01680
AXT 4,2 MOVE CONTROL WORDS F1B01690
RDXQ2 CAL* DCF INTO CURRENT BUFFER. F1B01700
SLW TLABEL+4,2 F1B01710
TIX RDXQ2,2,1 F1B01720
LXD EIFNO,1 INCREMENT IFN (INTERNAL FORMULA NUMBER). F1B01730
TXI *+1,1,1 F1B01740
SXD EIFNO,1 SAVE NEW IFN. F1B01750
PXD ,1 STORE IFN IN DECREMENT FIELD OF 1C. F1B01760
STO 1C F1B01770
CAL EFN GET EFN FOR THIS STATEMENT (IF ANY). F1B01780
TZE RDXQ3 *NONE. F1B01790
STA EIFNO SET BINARY EQUIVALENT EFN IN EIFNO F1B01800
TSX TET00,1 IN ORDER TO MAKE ENTRY IN TEIFNO. F1B01810
PZE 0 F1B01820
RDXQ3 LXD TLABEL,2 LOAD SCAN POSITION. F1B01830
TSX C0190X,4 RESET SCAN. F1B01840
TXL *+4,2,-3 HAS THE MARKER RECORD BEEN READ. F1B01850
LOST1 TSX (TAPE),4 *YES, MACHINE ERROR. F1B01860
PZE RDXQ5,,(TPER) F1B01870
PZE RDXQ6,,EXEQTP F1B01880
TXL *+3,2,0 *START SCAN AT FIRST CHARACTER. F1B01890
TSX C0190,4 GET FIRST NON-DICTIONARY CHARACTER F1B01900
TIX *-1,2,1 OF STATEMENT. F1B01910
STZ LEFT+2 RESET LEFT SIDE SYMBOL. F1B01920
RDXQ4 TRA* TLABEL GO TO PROCESSOR FOR THIS STATEMENT. F1B01930
REM F1B01940
RDXQ5 BCI 1,REC CT A STATEMENT IS MISSING, F1B01950
RDXQ6 BCI 1,EXEQ SKIPPED A RECORD OR SOMETHING. F1B01960
REM *************************************************************F1B01970
REM F1B01980
REM TERMINAL ROUTINE FOR PASS 2 OF SECTION I. F1B01990
REM F1B02000
ENDTST TSX (TAPE),4 CHECK LAST READ ON THE F1B02010
PZE EXEQTP,,(CHKU) EXECUTABLE STATEMENT TAPE. F1B02020
LXA RDXQ1,2 LOAD THE BUFFER SWITCH. F1B02030
CAL* DCF,2 GET TLABEL WHICH SHOULD BE F1B02040
ERA ALL1 ALL ONES, THE END MARK. F1B02050
TNZ LOST1 *IS THIS THE END MARK, NO. F1B02060
CLOSP2 AXT 0,4 SET END OF SECTION ONE FLAG. F1B02070
ZET DGFLAG HAS THERE BEEN A DIAGNOSTIC. F1B02080
TRA DIAG *YES, GET DIAGNOSTIC FOR THE LAST TIME. F1B02090
TSX (TAPE),4 SKIP OVER DIAGNOSTIC ON SYSTEM TAPE. F1B02100
PZE FRSP,,(SKBP) F1B02110
PZE ,,SYSTAP F1B02120
NZT TETFLG ARE ANY BUFFERS DUMPED ON TAPE. F1B02130
TRA CLSP2A *NO, LEAVE DUMP TAPE ALONE. F1B02140
REM F1B02150
REM YES, HOWEVER, IF BUFFERS ARE SHOT-GUNNED F1B02160
REM ON TAPES, THEN THIS CLOSE OUT IS NOT F1B02170
TSX (TAPE),4 SUFFICIENT. F1B02180
PZE ,,(WEFP) WRITE END-OF-FILE. F1B02190
PZE EXEQF,,BUFTAP F1B02200
TSX (TAPE),4 REWIND TAPE. F1B02210
PZE REWD,,(SKBP) F1B02220
PZE ,,BUFTAP F1B02230
REM F1B02240
CLSP2A STZ CITA0 CLOSE OUT CIT BUFFER. F1B02250
TSX CIT00,4 F1B02260
CLA 1PL SET TO EXIT TO ONE PRIME. $F1B02270
TRA 1TOCS-1 $F1B02273
1PL BCI 1,9F1600 $F1B02277
REM *************************************************************F1B02280
REM F1B02290
REM BSS,2/ CALLS=CIT00. F1B02300
REM BSS COMPILES= IFN BSS 0. F1B02310
BSS TSX CIT00,4 * GO MAKE FOLLOWING CIT ENTRY= F1B02320
PZE SL,,L(BSS) LOC,,OP-DEC F1B02330
PZE L(0),,L(0) ADR,,RA-TAG F1B02340
TRA 1,2 * EXIT TO CALLER+1. F1B02350
REM END OF PROGRAM BSS. F1B02360
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B02370
REM F1B02380
REM LIB,4/ USES=CIT00. CALLS=TET00. F1B02390
REM LIB MAKES CLOSUB ENTRY BEFORE COMPILING CIT. F1B02400
LIB CAL* 2,4 PICKUP SUBROUTINE F1B02410
SLW G NAME, AND F1B02420
TSX TET00,1 * GO ENTER IN CLOSUB TABLE. F1B02430
PZE 9 * THEN GO MAKE CIT ENTRY. F1B02440
TRA CIT00 GO COMPILE TSX NAME,4 F1B02450
REM END OF PROGRAM LIB. F1B02460
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B02470
REM F1B02480
REM F1B02490
REM FLTR00,4/ CALLS=CIT00. F1B02500
REM FLTR00 COMPILES FLOW TRACING INFORMATION. F1B02510
FLTR00 SXD FLTR05,4 SAVE CALLING TAG. F1B02520
CLA EIFNO GET LAST INTERNAL AND EXTERNAL NOS.F1B02530
STA ENT LAST EFN TO DECREMENT F1B02540
ARS 18 OF NTR INSTRUCTION. F1B02550
STA NZE LAST IFN TO DECREMENT F1B02560
LXD ARGCTR,4 OF PZE INSTRUCTION. F1B02570
TXL FLTR01,4,0 IF THIS IS A FN FUNCTION, F1B02580
STZ 1C+2 THEN F1B02590
CLA 1BAR SET ADDRESS TO -1. F1B02600
TRA FLTR03 IF THIS IS F1B02610
FLTR01 LXD SBDFCN,4 A MAIN PROGRAM F1B02620
TXH FLTR02,4,0 (SBDFCN = 0), THEN F1B02630
STZ 1C+2 SET ADDRESS F1B02640
STZ 1C+3 TO +0. F1B02650
TRA FLTR04 IF THIS IS A F1B02660
FLTR02 CLA DOLSGN SUB-PROGRAM, THEN F1B02670
STO 1C+2 SET ADDRESS F1B02680
CLA D2 TO $+2. F1B02690
FLTR03 STO 1C+3 SET RELATIVE ADDRESS FOR CIT. F1B02700
FLTR04 TSX CIT00,4 GO MAKE FOLLOWING CIT ENTRY= F1B02710
PZE L(0),,ENT LOC,,OP-DEC F1B02720
PZE PROCTR,,D2 ADR,,RA-TAG F1B02730
TSX CIT00,4 * GO MAKE FOLLOWING CIT ENTRY= F1B02740
PZE L(0),,NZE LOC,,OP-DEC F1B02750
PZE 1C+2,,1C+3 ADR,,RA-TAG F1B02760
LXD FLTR05,4 RESTORE CALLING TAG. F1B02770
FLTR05 TXI CIT00,0,** * EXIT TO CIT00. F1B02780
REM END OF PROGRAM FLTR00. F1B02790
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B02800
REM F1B02810
REM GETIFN,4/ F1B02820
REM GETIFN PLACES THE INTERNAL FORMULA NUMBER IN AC AND IN 1C. F1B02830
GETIFN LXD EIFNO,1 PLACE THE INTERNAL FORMULA F1B02840
PXD ,1 NUMBER IN XR1, IN THE DECREMENT F1B02850
STO 1C OF THE AC, 1C, AND CW. F1B02860
TRA 1,4 * RETURN TO CALLER. F1B02870
REM END OF PROGRAM GETIFN. F1B02880
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B02890
REM F1B02900
REM JIF(GIF),4/ F1B02910
REM JIF JUMPS IFN, AND USES GIF. F1B02920
JIF CAL EIFNO INCREASE THE F1B02930
ADD 2E18 INTERNAL FORMULA NUMBER F1B02940
STD EIFNO BY 1. F1B02950
REM GIF GETS IFN, AND SETS SL AND TL. F1B02960
GIF CAL EIFNO PICKUP IFN, F1B02970
ANA 1BAR CLEAR SL, AND F1B02980
L(SL) SLW SL PLACE IFN IN THE DECREMENTS F1B02990
L(TL) STD TL OF SL AND TL. F1B03000
TRA 1,4 * EXIT TO CALLER. F1B03010
REM END OF PROGRAM JIF(GIF). F1B03020
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B03030
REM F1B03040
REM LXD,2/ CALLS=CIT00. F1B03050
REM LXD COMPILES= LXD 6)+4,4. F1B03060
LXD TSX CIT00,4 * GO MAKE FOLLOWING CIT ENTRY= F1B03070
PZE L(0),,L(LXD) LOC,,OP-DEC F1B03080
PZE O(,,D4A4 ADR,,RA-TAG F1B03090
TRA 1,2 * EXIT TO CALLER+1. F1B03100
REM END OF PROGRAM LXD. F1B03110
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B03120
REM F1B03130
REM RA000,4/ F1B03140
REM RA000 COMPUTES RELATIVE ADDRESS. F1B03150
RA000 SXA RAXR4,4 SAVE THE C(XR4) FOR RETURN. F1B03160
STZ EPS CLEAR EPSILON (WORKING STORAGE). F1B03170
CLA DIMSAV EXAMINE THE F1B03180
ED2 PAX E+4,4 DIMENSION COUNT, AND F1B03190
TXL ED1,4,2 IF 3 DIMENSION, F1B03200
ADD L(1) INCREASE IT 1. F1B03210
ED1 ADM ED2 THEN SET F1B03220
STA ED3 ED3 ADDRESS TO F1B03230
ED3 CLA **,4 EXAMINE SUCCESSIVE F1B03240
LDQ 2E18 SUBSCRIPT F1B03250
TZE ED4 VARIABLES, AND F1B03260
STQ EPS ACCORDINGLY SET F1B03270
LDQ L(0) EPSILON AND F1B03280
ED4 STQ EPS,4 EPSILON SUB I F1B03290
TIX ED3,4,1 TO 1 OR TO 0. WHEN DONE, F1B03300
CLA 2E18 IF 1 DIMENSION, PICKUP DECREMENT 1,F1B03310
LXA DIMSAV,4 AND GO SUBTRACT ADDEND 1. F1B03320
TXL 1D1,4,1 IF 2 OR 3 DIMENSION, THEN F1B03330
LDQ E+11 PICKUP ADDENDS 1 AND 2, F1B03340
STZ E+11 CLEAR E+11, AND F1B03350
SLQ E+11 RESTORE ADDEND 1 TO E+11. F1B03360
LGL 18 ADJUST AND PLACE F1B03370
STQ N2 ADDEND 2 IN N2. F1B03380
LDQ E+6 AND, IF 2 DIMENSION F1B03390
CLA EPS-1 PICKUP EPSILON SUB 1, F1B03400
TXL 2D1,4,2 AND GO SUBTRACT ADDEND 2. F1B03410
SUB E+12 IF 3 DIMENSION, SET GTAG F1B03420
STO GTAG TO EPSILON SUB 1 - ADDEND 3. F1B03430
LDQ E+8 PICKUP DIMENSIONS 1 AND 2, F1B03440
STZ E+8 CLEAR E+8, AND F1B03450
SLQ E+8 RESTORE DIMENSION 1 TO E+8. F1B03460
LGL 18 ADJUST, AND MULTIPLY F1B03470
MPY GTAG DIMENSION 2 TIMES GTAG. F1B03480
ALS 17 THEN ADD F1B03490
ADD EPS-2 EPSILON SUB 2 F1B03500
LDQ E+8 TO THE PRODUCT, AND F1B03510
2D1 SUB N2 SUBTRACT ADDEND 2. F1B03520
STO GTAG MULTIPLY F1B03530
MPY GTAG THE RESULT F1B03540
ALS 17 TIMES F1B03550
ADD EPS,4 DIMENSION 1, AND ADD IN EPSILON F1B03560
ADD EPS SUB I AND EPSILON. F1B03570
1D1 SUB E+11 SUBTRACT ADDEND 1, F1B03580
TRA 1D1P $F1B03590
CAL E IN THE DECREMENT OF GTAG, F1B03600
ARS 24 WITH I-TAUTAG F1B03610
STA GTAG IN THE ADDRESS. F1B03620
RAXR4 AXT ..,4 RESTORE THE C(XR4), AND F1B03630
TRA 1,4 * EXIT TO CALLER. F1B03640
REM END OF PROGRAM RA000. F1B03650
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B03660
REM F1B03670
REM SS000,4/ CALLS=C0190,DIAG,SR6DC1,DIM.SR,TBSR00,TET00,TESTFX. F1B03680
REM SS000 SCANS SUBSCRIPT COMBINATIONS AND MAKES TABLE ENTRIES. F1B03690
SS000 SXD SXR2,2 SAVE C(XR2), F1B03700
SXD SXR1,1 SAVE C(XR1), F1B03710
SXD SXR4,4 SAVE C(XR4), AND F1B03720
STZ ERASE SET DIMCTR = 0. F1B03730
LXA L(6),4 INITIALIZE F1B03740
SXD SBS2,4 FOR EACH SUBSCRIPT MEMBER. F1B03750
CAL TXHOP PICK UP TXH OP, AND F1B03760
STP SBC6 SET OP F1B03770
STP SBC8 SWITCHES. F1B03780
CAL TXLOP PICK UP TXL OP, AND F1B03790
STP SBC4 SET OP SWITCH. F1B03800
SS001 LXA L(6),3 SET FOR 6 CHARACTERS OF MULTIPLIER.F1B03810
STZ SYMBOL CLEAR WORKING STORAGE. F1B03820
TSX C0190,4 * GET FIRST NON BLANK CHAR IN THE AC.F1B03830
CAS L(9) COMPARE IT WITH 9. F1B03840
TXI SS0045,,0 RETURN TO EXPLICIT CODING. F1B03850
NOP IF NUMERIC, F1B03860
STO FIRSTC SAVE RIGHT-ADJUSTED DIGIT, AND F1B03870
SS0012 ALS 36,2 LEFT-ADJUST DIGIT TO F1B03880
ORS SYMBOL BUILD SYMBOL. F1B03890
TXI SS0013,2,6 UPDATE SHIFT DECREMENT, AND F1B03900
SS0013 TXI SS0014,1,-1 UPDATE COUNT OF CHARS COLLECTED. F1B03910
SS0014 TSX C0190,4 * GET NEXT NB CHARACTER IN THE AC. F1B03920
AXT CTEST-ENDMK,4 SET XR4 = NO. OF PUNCTUATION MARKS.F1B03930
SS0015 CAS CTEST,4 TEST THIS CHARACTER AGAINST F1B03940
TXI SS0016,,0 ALL PUNCTUATION. F1B03950
TRA SUBTR,4 IF EQUALITY IS FOUND, TRANSFER. F1B03960
SS0016 TIX SS0015,4,1 IF NOT FOUND TO BE PUNCTUATION, F1B03970
CAS L(9) TEST FOR NUMERIC. F1B03980
TXI SS0017,,0 AND IF F1B03990
NOP FOUND TO BE NUMERIC, F1B04000
TXH SS0012,1,0 CONTINUE BUILDING SYMBOL. BUT IF F1B04010
TXI STOP49,,0 SEVENTH CHARACTER, GO TO DIAGNOSTICF1B04020
SS0017 TSX TESTFX+1,1 * GO TEST FOR FIXED POINT VARIABLE. F1B04030
ER0005 BSS 0 F1B04040
SSERR TSX DIAG,4 * NOT FIXED POINT --GO TO DIAGNOSTIC.F1B04050
LGL 30 RESTORE FIXED POINT VARIABLE F1B04060
SLW RESIDU TO RESIDU, AND F1B04070
LXA XCHCTR,4 RESET CHARACTER COUNTER F1B04080
TXI SS0018,4,1 TO BEGIN PROCESSING F1B04090
SS0018 SXA XCHCTR,4 SUBSCRIPT MULTIPLIER. F1B04100
SBX CLS SBC6 TEST FOR F1B04110
TMI SBX1 PREVIOUS MULTIPLIER. F1B04120
ER0006 BSS 0 F1B04130
TSX DIAG,4 * DOUBLE MULTIPLIER FOR SUBSCRIPT. F1B04140
SBX1 STO SBC6 RESET MULTIPLIER SWITCH. F1B04150
CLA FIRSTC TEST F1B04160
SUB TEN MULTIPLIER F1B04170
TMI SBX2 FOR CONSTANT. F1B04180
ER0007 BSS 0 F1B04190
TSX DIAG,4 * SUBS-MULTIPLIER NOT A CONSTANT. F1B04200
SBX2 CAL SYMBOL ADJUST MULTIPLIER F1B04210
ARS 42,2 TO LOW ORDER POSITION. F1B04220
LXD SBS2,4 GET STORING TAG, F1B04230
SLW E+9,4 AND STORE MULTIPLIER. F1B04240
STZ E+15,4 SET ADDEND = 0. F1B04250
SS003 LXA L(6),3 SET FOR 6 CHARS OF VARIABLE/ADDEND.F1B04260
STZ SYMBOL CLEAR WORKING STORAGE. F1B04270
SS004 TSX C0190,4 * GO GET NEXT NB CHARACTER IN THE AC.F1B04280
SS0045 AXT CTEST-ENDMK,4 COMPARE CHARACTER F1B04290
SS005 CAS CTEST,4 TO ALL F1B04300
TXI SS006,,0 PUNCTUATION. F1B04310
TRA SUBTR,4 IF EQUALITY IS FOUND, TRANSFER. F1B04320
SS006 TIX SS005,4,1 IF NOT FOUND TO BE PUNCTUATION, F1B04330
TXL SS008,1,5 IF 1ST CHARACTER OF VARIABLE OR F1B04340
STO FIRSTC ADDEND, SAVE FOR LATER TESTS. F1B04350
SS008 ALS 36,2 POSITION EACH CHARACTER. BUT F1B04360
SS009 TXL STOP49,1,0 * ON 7TH CHARACTER, GO TO STOP. F1B04370
ORS SYMBOL BUILD SYMBOL. F1B04380
TXI SS007,2,6 UPDATE EFFECTIVE ADDRESS OF SHIFT. F1B04390
SS007 TXI SS004,1,-1 UPDATE FOR ANOTHER CHAR COLLECTED. F1B04400
ER0008 BSS 0 F1B04410
STOP49 TSX DIAG,4 * GO TO DIAGNOSTIC ON 7TH CHARACTER. F1B04420
REM SUBTR/ CONTROL TRANSFERS FOR SUBSCRIPT SCAN= F1B04430
TXI ISC,,0 EMK (ILLEGAL IN LIST SUBSCRIPT). F1B04440
ER0009 BSS 0 F1B04450
ISC TSX DIAG,4 * ( (ILLEGAL IN LIST SUBSCRIPT). F1B04460
TXI SBC,,0 , F1B04470
TXI SBR,,0 ) F1B04480
TXI ISC,,0 = (ILLEGAL IN LIST SUBSCRIPT). F1B04490
SBS2 TXI SBM,0,** - ,,SUBSCRIPT ELEMENT COUNTER. F1B04500
TXI ISC,,0 / (ILLEGAL IN LIST SUBSCRIPT). F1B04510
SXR1 TXI ISC,0,** . (ILLEGAL IN LIST SUBSCRIPT). F1B04520
SXR2 TXI SBP,0,** + F1B04530
SXR4 TXI SBX,0,** * F1B04540
SUBTR BSS 0 INDEXING ADDRESS FOR ABOVE LIST. F1B04550
SBM SSM MINUS ADDEND. F1B04560
SBP CLM PLUS ADDEND. F1B04570
LXD SBS2,4 GET STORING TAG, AND F1B04580
STO E+15,4 STORE SIGN OF ADDEND. F1B04590
CLS SBC8 TEST SWITCH F1B04600
TMI SBP1 FOR PREVIOUS ADDEND. F1B04610
ER0010 BSS 0 F1B04620
TSX DIAG,4 * DOUBLE ADDEND FOR SUBSCRIPT. F1B04630
SBP1 STO SBC8 RESET ADDEND SWITCH. F1B04640
TSX TESTFX,1 * GO TO TEST FOR FIXED POINT. F1B04650
TRA SSERR * NOT FIXED POINT --GO TO DIAGNOSTIC.F1B04660
LXD SBS2,4 GET STORING TAG, AND F1B04670
CLS SBC6 TEST SWITCH F1B04680
TPL SBP2 FOR PREVIOUS MULTIPLIER. F1B04690
CLA L(1) IF NONE, F1B04700
STO E+9,4 SET MULTIPLIER F1B04710
TXI SBP4,,0 TO 1, AND CONTINUE. F1B04720
SBC1 CLS SBC6 RESET MULTIPLIER F1B04730
SBP2 STO SBC6 OP SWITCH. F1B04740
SBP4 CAL SYMBOL IF VARIABLE SUBSCRIPT, F1B04750
TXH SBP41,2,36 ADD BLANKS F1B04760
PXD ,0 F1B04770
LDQ BLANKS IF LESS F1B04780
LGL 42,2 THAN 6 F1B04790
ORA SYMBOL CHARACTERS, AND F1B04800
SBP41 SLW E+10,4 PLACE IN E-REGION. F1B04810
TSX TESTFX,1 * GO TO TEST FOR FIXED POINT. F1B04820
TRA SSERR * NOT FIXED POINT --GO TO DIAGNOSTIC.F1B04830
CLA SBC8 IF THERE IS AN ADDEND, F1B04840
TMI SS003 GO COLLECT, OTHERWISE F1B04850
TXI SBC7,,0 GO UPDATE STORING TAG. F1B04860
SBR CLS SBC4 SET SWITCH F1B04870
STO SBC4 FOR CLOSING PARENTHESIS. F1B04880
SBC CAL ERASE UPDATE F1B04890
ADD L(1) DIMENSION COUNTER F1B04900
STA ERASE BY 1. F1B04910
LXD SBS2,4 GET STORING TAG. F1B04920
SBC6 TXH SBC1,,0 SWITCH - IF NO MULTIPLIER, AND F1B04930
SBC8 TXH SBC2,,0 SWITCH - IF NO ADDEND, THEN F1B04940
CLA L(1) SET F1B04950
STO E+9,4 MULTIPLIER = 1. F1B04960
STZ E+15,4 SET ADDEND = 0. F1B04970
CLA FIRSTC TEST FOR F1B04980
SUB TEN CONSTANT OR VARIABLE. F1B04990
TPL SBP4 IF CONSTANT, THEN F1B05000
STZ E+10,4 SET VARIABLE = 0. F1B05010
SBC9 CAL SYMBOL ADJUST F1B05020
ARS 42,2 CONSTANT F1B05030
ORS E+15,4 TO LOW ORDER POSITION. F1B05040
SBC7 TNX SBC3,4,2 UPDATE STORING TAG F1B05050
SXD SBS2,4 BY -2, AND SAVE. F1B05060
SBC4 TXL SS001,,0 SWITCH - REPEAT FOR NEXT SUB-COMB. F1B05070
TXI SA000,,0 F1B05080
SBC2 CLS SBC8 RESET ADDEND F1B05090
STO SBC8 OP SWITCH. F1B05100
CLS TEN TEST F1B05110
ADD FIRSTC ADDEND F1B05120
TMI SBC9 FOR CONSTANT. F1B05130
ER0011 BSS 0 F1B05140
TSX DIAG,4 * SUBSCRIPT ADDEND NOT A CONSTANT. F1B05150
SBC3 CLS SBC4 AFTER SCANNING 3 SUBSCRIPTS, F1B05160
TMI SA000 GO MAKE TABLE ENTRIES AND GET TAG. F1B05170
ER0012 BSS 0 F1B05180
TSX DIAG,4 * GO TO DIAG - NO ) AFTER 3RD SUBS. F1B05190
REM CSA000= ENTRY POINT USED BY C0200 (GO TO ROUTINE). F1B05200
CSA000 SXD SXR4,4 SAVE C(XR4) FOR RETURN TO C0200. F1B05210
SA000 CLA ERASE SAVE F1B05220
STO DIMSAV THE CONTENTS OF DIMCTR. F1B05230
ALS 33 POSITION AND F1B05240
STO E STORE I TAG. F1B05250
CLA E+11 MOVE SUBSCRIPT ADDENDS F1B05260
STO E+12 INTO POSITION F1B05270
CLA E+9 FOR FOLLOWING F1B05280
STO E+11 PROGRAM. F1B05290
CLA L(2) EXAMINE DIMCTR F1B05300
CAS ERASE TO DETERMINE F1B05310
TXI 1D0000,,0 WHETHER DIMENSION OF F1B05320
TXI 2D0000,,0 VARIABLE IS 1,2, OR 3. F1B05330
LXA L(6),4 PREPARE TO PICK UP 3 COEFFICIENTS. F1B05340
3D0001 LDQ E+9,4 CONVERT THEM FROM BCD TO BINARY F1B05350
TSX SR6DC1,1 * IN E+3,5,7, AND F1B05360
STO E+9,4 STORE BACK IN E+3,5,7. F1B05370
TIX 3D0001,4,2 WHEN DONE, PREPARE F1B05380
LXA L(3),4 TO PICK UP 3 ADDENDS. F1B05390
3D0002 CLA E+14,4 CONVERT ADDENDS (BCD TO BINARY)= F1B05400
SLW G STRIP OFF F1B05410
LDQ G SIGN, F1B05420
TSX SR6DC1,1 * CONVERT ADDENDS IN E+11,12,13, F1B05430
LDQ E+14,4 PUT SIGN IN S-BIT OF MQ, AND F1B05440
TQP 3D0040 IF PLUS--SKIP NEXT, F1B05450
ORA 2E17 IF MINUS--OR SIGN INTO BIT 18, F1B05460
3D0040 STO E+14,4 AND STORE BACK INTO E+11,12,13. F1B05470
TIX 3D0002,4,1 WHEN DONE, F1B05480
TSX DIM3SR,4 * GO SEARCH DIM3 TABLE. F1B05490
ER0013 BSS 0 F1B05500
TSX DIAG,4 * --ERROR...NOT FOUND. F1B05510
3D0060 CLA E+3 REFORMATIZE E-STRING = F1B05520
ALS 18 PACK TOGETHER COEFFICIENTS 1 AND 2 F1B05530
ADD E+5 AND STORE THEM F1B05540
STO E+3 IN E+3. F1B05550
CLA E+4 MOVE SUBSCRIPT 1 F1B05560
STO E+5 TO E+5. F1B05570
CLA E+7 AND MOVE F1B05580
ALS 18 COEFFICIENT 3 F1B05590
STO E+4 INTO E+4. F1B05600
CLA E+8 MOVE SUBSCRIPT 3 INTO E+7, F1B05610
STO E+7 NEXT TO SUBSCRIPT 2 IN E+6. F1B05620
CLA ERASE1 MOVE DIMENSIONS 1 AND 2 F1B05630
STO E+8 INTO E+8. F1B05640
CAL E+11 PACK TOGETHER F1B05650
ALS 18 ADDENDS 1 AND 2 F1B05660
ORA E+12 AND F1B05670
SLW E+11 STORE THEM IN E+11. F1B05680
CAL E+13 MOVE F1B05690
ALS 18 ADDEND 3 F1B05700
SLW E+12 INTO E+12. F1B05710
TSX TAU3IX,4 * GO SEARCH TAU3 TABLE. F1B05720
ALS 24 POSITION TAU3 TAG, AND F1B05730
ORS E PLACE TAU3 TAG IN TAG WORD. F1B05740
CAL E+7 COMBINE F1B05750
ORA E+6 SUBSCRIPTS 3,2, AND 1, F1B05760
3D0340 ORA E+5 AND IF THEY ARE ALL ZERO, F1B05770
3D0350 TZE NOTAG --DONT ENTER FORTAG. F1B05780
FTG000 CAL EIFNO ENTER FORTAG= F1B05790
ANA MASK1 BRING UP ALPHA (INTFORMNO) F1B05800
SLW G AND STORE IN G. F1B05810
CAL E BRING UP TAUTAG FOR I, F1B05820
ARS 24 ADJUST, AND F1B05830
ORS G PLACE IN G WITH ALPHA. THEN F1B05840
NZT ACFTG IS THIS ARITHMETIC FORTAG. (23)F1B05850
TSX CFTAG,2 NO, MAKE TABLE ENTRY. (23)F1B05860
TXI SAEXIT,,0 GO TO EXIT. F1B05870
2D0000 LXA L(4),4 IF 2 DIM, PICKUP AND F1B05880
2D0001 LDQ E+7,4 CONVERT COEFFICIENTS F1B05890
TSX SR6DC1,1 * (BCD TO BINARY), F1B05900
STO E+7,4 AND STORE BACK IN E+3 AND E+5. F1B05910
TIX 2D0001,4,2 WHEN DONE, F1B05920
LXA L(2),4 PREPARE TO F1B05930
2D0002 CLA E+13,4 PICKUP THE TWO ADDENDS. F1B05940
SLW G STRIP OFF F1B05950
LDQ G THEIR SIGNS, F1B05960
TSX SR6DC1,1 * CONVERT THEM FROM BCD TO BINARY, F1B05970
LDQ E+13,4 PUT SIGN IN S-BIT OF MQ, AND F1B05980
TQP 2D0040 IF PLUS--SKIP NEXT, F1B05990
ORA 2E17 IF MINUS--OR SIGN INTO BIT 18, F1B06000
2D0040 STO E+13,4 AND STORE BACK IN E+11 AND E+12. F1B06010
TIX 2D0002,4,1 WHEN DONE, F1B06020
TSX DIM2SR,4 * GO SEARCH DIM2 TABLE. F1B06030
ER0014 TSX DIAG,4 * --ERROR...NOT FOUND. F1B06040
2D0060 CLA E+3 REFORMATIZE E-STRING = F1B06050
ALS 18 PACK TOGETHER F1B06060
ADD E+5 COEFFICIENTS 1 AND 2, F1B06070
STO E+3 AND STORE THEM IN E+3. F1B06080
CLA E+6 MOVE SUBSCRIPT 2 INTO E+5 F1B06090
STO E+5 (NEXT TO SUBSCRIPT 1 IN E+4). F1B06100
CLA ERASE1 OBTAIN F1B06110
ANA MASK1 DIMENSION 1, AND MOVE IT F1B06120
STO E+6 INTO E+6. F1B06130
CAL E+11 PACK TOGETHER F1B06140
ALS 18 ADDENDS 1 AND 2, F1B06150
ORA E+12 AND STORE THEM F1B06160
SLW E+11 IN E+11. F1B06170
TSX TAU2IX,4 * GO SEARCH TAU2 TABLE. F1B06180
ALS 24 POSITION TAU2 TAG, AND F1B06190
ORS E PLACE TAU2 TAG IN TAG WORD. F1B06200
CAL E+4 COMBINE SUBSCRIPTS 1 AND 2, AND F1B06210
TXI 3D0340,,0 GO TO FORTAG SECTION. F1B06220
1D0000 LDQ E+3 IF 1 DIM, PICKUP AND CONVERT COEF. F1B06230
TSX SR6DC1,1 * (BCD TO BINARY), AND F1B06240
ALS 18 THEN ADJUST THEM, F1B06250
STO E+3 AND STORE THEM BACK IN E+3. F1B06260
CLA E+11 PICKUP ADDEND, F1B06270
SLW G STRIP OFF SIGN, F1B06280
LDQ G CONVERT ADDEND F1B06290
TSX SR6DC1,1 * (BCD TO BINARY), AND THEN F1B06300
LDQ E+11 PUT SIGN IN S-BIT OF MQ, AND F1B06310
TQP 1D0001 IF PLUS--SKIP NEXT, F1B06320
ORA 2E17 IF MINUS--OR SIGN INTO BIT 18. F1B06330
1D0001 ALS 18 THEN ADJUST AND STORE F1B06340
SLW E+11 BACK INTO E+11. F1B06350
TSX TAU1IX,4 * GO SEARCH TAU1 TABLE. F1B06360
ALS 24 POSITION TAU1 TAG, AND F1B06370
ORS E PLACE TAU1 TAG IN TAG WORD. F1B06380
CAL E+4 TAKE SUBSCRIPT, AND F1B06390
TXI 3D0350,,0 GO TO FORTAG SECTION. F1B06400
NOTAG CAL 2E18 PLACE SIGMA1 F1B06410
ALS 5 TAG IN F1B06420
ORS E TAGWORD. F1B06430
SAEXIT LXD SXR1,1 RESTORE THE C(XR1), F1B06440
LXD SXR2,2 RESTORE THE C(XR2), F1B06450
LXD SXR4,4 RESTORE THE C(XR4), AND F1B06460
TRA 1,4 * EXIT TO MAIN ROUTINE. F1B06470
REM END OF PROGRAM SS000. F1B06480
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B06490
REM F1B06500
REM SXD,2/ CALLS=CIT00. F1B06510
REM SXD COMPILES= IFN SXD 6)+4,4. F1B06520
SXD TSX CIT00,4 * GO MAKE FOLLOWING CIT ENTRY= F1B06530
PZE SL,,L(SXD) LOC,,OP-DEC F1B06540
PZE O(,,D4A4 ADR,,RA-TAG F1B06550
TRA 1,2 * EXIT TO CALLER+1. F1B06560
REM END OF PROGRAM SXD. F1B06570
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B06580
REM F1B06590
REM CHSIFN/ CALLS=TET00. F1B06600
REM CHSIFN MAKES MINUS EIFNO ENTRY AND REENTERS PASS2. F1B06610
CHSIFN CAL EFN IF THIS STATEMENT HAS F1B06620
TZE PASS2 * AN EXTERNAL STATEMENT NUMBER, F1B06630
CAL MINUS0 THEN MAKE A F1B06640
ORS EIFNO NEGATIVE ENTRY F1B06650
TSX TET00,1 * IN THE TAPE TABLE F1B06660
PZE 0 TEIFNO. F1B06670
CAL EIFNO THEN RESET THE SIGN OF EIFNO, F1B06680
STO EIFNO AND REENTER PASS2. F1B06690
TRA PASS2 F1B06700
REM END OF PROGRAM CHSIFN. F1B06710
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B06720
REM F1B06730
REM END OF PASS2 COMMON. F1B06740
REM F1B06750
REM C0100/ CALLS=TEST..,C0180,C0160,C0150,TET00. F1B06760
REM C0100 PROCESSES DO STATEMENTS. F1B06770
C0100 TSX C0180X,2 * FORM BINARY EQUIV OF BETA IN 1G. F1B06780
STO 2G SAVE THE 1ST CHAR OF SUBSCRIPT. F1B06790
CLA 1G TAKE CONVERTED RESULT FOR BETA F1B06800
STA 1C AND STORE IN ADDR OF 1C. F1B06810
CLA 2G 1C IS NOW COMPLETE EXCEPT FOR TAG. F1B06820
TSX C0160,2 * OBTAIN IN 1G THE SUBSCRIPT. F1B06830
LDQ 1G MOVE SUBSCRIPT F1B06840
STQ 1C+1 TO 1C+1. F1B06850
ERA EQUAL IS PUNCTUATION AN EQUALS SIGN. F1B06860
TZE *+2 *YES. F1B06861
ER2003 TSX DIAG,4 NO. GO TO DIAGNOSTIC. F1B06862
LGL 6 SHIFT FIRST CHARACTER INTO AC. F1B06870
TSX TESTFX+1,1 TEST FOR FIXED POINT NAME. F1B06880
TRA ER2001 ERROR, NAME IS NOT FIXED POINT. F1B06890
TSX C0150,2 * OBTAIN IN 1G THE PROPER N1. F1B06900
TSX TESTG0,4 TEST FOR COMMA BETWEEN N1 AND N2. F1B06910
CLA 1G STORE N1 F1B06920
STO 1C+2 IN 1C+2. F1B06930
CAL I OBTAIN I IN LOGICAL ACC AND F1B06940
ARS 18 STORE IN POS 18 OF 1C F1B06950
ORS 1C 0 IF NUMERIC, OR 1 IF NON-NUMERIC. F1B06960
TSX C0150,2 * OBTAIN IN 1G THE PROPER N2. F1B06970
TSX TESTA0,4 * TEST THE AC FOR COMMA OR ENDMARK. F1B06980
TNZ C0113 IF ENDMARK, THEN F1B06990
LDQ FAKEN3 F1B07000
STQ RESIDU AND PLACE IN RESIDU. F1B07010
C0113 CLA 1G STORE N2 F1B07020
STO 1C+3 IN 1C+3. F1B07030
CAL I OBTAIN I IN LOG ACC AND F1B07040
ARS 19 STORE IN POS 19 OF 1C F1B07050
ORS 1C 0 IF NUMERIC, OR 1 IF NON-NUMERIC. F1B07060
TSX C0150,2 * OBTAIN IN 1G THE PROPER N3. F1B07070
TSX TESTD0,4 * THE AC SHOULD CONTAIN AN ENDMARK. F1B07080
CLA 1G STORE N3 F1B07090
STO 1C+4 IN 1C+4. F1B07100
CAL I OBTAIN I IN LOG ACC AND F1B07110
ARS 20 STORE IN POS 20 OF 1C F1B07120
ORS 1C 0 IF NUMERIC, OR 1 IF NON-NUMERIC. F1B07130
TSX TET00,1 * GO TO TET PROGRAM TO ENTER F1B07140
PZE 1 1C,1C+1,..1C+4 IN TDO TABLE 1. F1B07150
TRA PASS2 * EXIT TO PASS2. F1B07160
REM END OF PROGRAM C0100. F1B07170
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B07180
REM F1B07190
REM C0150,2/ CALLS=C0190,C0180,C0160. CALLER=C0100. F1B07200
REM C0150 INSPECTS 1ST NB CHAR STARTING IN MQ. IF NUMERIC, SETS IF1B07210
REM = 0, AND CONVERTS SUCCESSIVE NUMERICS TO BINARY. IF NON- F1B07220
REM NUMERIC, SETS I = -0, AND PACKS INTO 1G SUCCESSIVE CHARACTERSF1B07230
REM UNTIL A ,()= OR ENDMK IS MET, AND LEFT IN THE AC. F1B07240
C0150 SXD C015X,2 SAVE THE C(XR2). F1B07250
TSX C0190,4 * TEST 1ST NON-BLANK CHARACTER F1B07260
CAS L(9) FOR NUMERIC OR NON-NUMERIC. F1B07270
C015X TXI C0151,0,** IF NON-NUMERIC, TRANSFER. F1B07280
NOP IF NUMERIC, THEN F1B07290
TSX C0180,2 * GO CONVERT TO BINARY. F1B07300
STO 2G SAVE NEXT NON-NUMERIC CHARACTER. F1B07310
CLA L(0) PREPARE TO SET I TO +0. F1B07320
TXI C0152,,0 GO SET I FOR NUMERIC. F1B07330
C0151 TSX TESTFX+1,1 TEST FOR FIXED POINT VARIABLE. F1B07340
ER2001 TSX DIAG,4 ERROR, NOT FIXED POINT BEGINNING. F1B07350
TSX C0160,2 ASSEMBLE NON-NUMERICS IN 1G. F1B07360
STO 2G SAVE PUNCTUATION MARK, AND F1B07370
CLS L(0) PREPARE TO SET I TO -0. F1B07380
C0152 STO I SET I = +0, OR -0. F1B07390
CLA 2G PICKUP NEXT CHARACTER, F1B07400
LXD C015X,2 RESTORE THE C(XR2), AND F1B07410
TRA 1,2 * RETURN TO CALLER. F1B07420
REM END OF PROGRAM C0150. F1B07430
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B07440
REM F1B07450
REM C0200/ CALLS=CIT00,SS000,TEST..,C0190,C0180,TET00,C0160, F1B07460
REM C0200 PROCESSES GO TO STATEMENTS. F1B07470
C0200 CLA 1C PLACE F1B07480
STO 1C+2 IFN IN 1C+2. F1B07490
TSX C0190,4 * OBTAIN IN ACC NEXT NB CHARACTER F1B07500
CAS L(9) AND COMPARE IT WITH 9. F1B07510
TXI C0205,,0 IF NON-NUMERIC, COMPARE WITH (. F1B07520
NOP IF NUMERIC, THEN F1B07530
TSX C0180,2 * OBTAIN IN 1G THE BINARY EQUV BETA. F1B07540
TSX TESTD0,4 * THE AC SHOULD CONTAIN AN ENDMARK. F1B07550
CLA 1G STORE BETA IN 1C+1 TO CONSTRUCT F1B07560
STO 1C+1 THE 2ND WORD OF TIFGO TABLE ENTRY. F1B07570
TXI C0202,,0 GO TO ENTER 1C,1C+1 INTO TIFGO. F1B07580
C0205 CAS OPEN TEST CHARACTER FOR ALPHABETIC. F1B07590
TXI C0210,,0 IF NOT ALPHABETIC, THEN F1B07600
TXI C0212,,0 THIS IS TYPE ..... GO TO ( ),I F1B07610
C0210 TSX C0160,2 * TYPE= GO TO N,(),SO OBTAIN IN 1G N F1B07620
TSX TESTG0,4 * WHICH SHOULD BE FOLLOWED BY COMMA. F1B07630
CLA 1G SAVE THE SYMBOL N IN 1C+3 F1B07640
STO 1C+3 FOR COMPILED INSTRUCTION. F1B07650
TSX C0190,4 * OBTAIN IN ACC NEXT NB CHARACTER, F1B07660
TSX TESTE0,4 * WHICH SHOULD BE A LPAREN. F1B07670
CLA L(1) PREPARE TO SET ADDRESS PART OF 1C F1B07680
TRA C0213 TO 1 TO INDICATE CLASS OF TRANSFER.F1B07690
C0212 CLA L(2) PREPARE TO SET ADDR OF 1C TO 2. F1B07700
C0213 STA 1C STORE 1 OR 2 IN ADDR OF 1C. F1B07710
LXD CTRAD,2 OBTAIN 250-(NO. TRAD ENTRIES), AND F1B07720
PXD ,2 PLACE IN THE DECREMENT OF THE AC F1B07730
STO 1C+1 AND STORE IN 1C+1. F1B07740
C0215 TSX C0180X,2 * OBTAIN BINARY TRA ADDRESS IN 1G. F1B07750
STO 2G SAVE CHAR IN ACC. F1B07760
TSX TET00,1 * GO TO ENTER 1G F1B07770
PZE 3 INTO TRAD TABLE (TABLE 3). F1B07780
LXD CTRAD,2 REDUCE COUNTER F1B07790
TIX C0216,2,1 CTRAD F1B07800
C0216 SXD CTRAD,2 BY 1. F1B07810
CLA 2G RESTORE CHAR TO ACC. F1B07820
TSX TESTB0,4 * TEST FOR COMMA OR RPAREN. F1B07830
TNZ C0215 IF RIGHT PARENTHESIS, THEN F1B07840
LXD CTRAD,4 OBTAIN 250 MINUS NO. TRAD ENTRIES F1B07850
SXA 1C+1,4 IN ADDR OF 1C+1. F1B07860
CLA 1C OBTAIN 1C IN ACC F1B07870
LBT AND TEST LOW ORDER BIT. F1B07880
TRA C0220 THIS IS A TYPE GO TO (),I FORMULA. F1B07890
TSX C0190,4 * OBTAIN NEXT NB CHAR AND F1B07900
TSX TESTD0,4 * TEST FOR ENDMK. F1B07910
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B07920
PZE 1C+2,,L(TRA) LOC,,OP-DEC F1B07930
PZE 1C+3,,L(0) ADR,,RA-TAG F1B07940
TRA C0202 GO TO ENTER 1C,1C+1 INTO TIFGO. F1B07950
C0220 TSX C0190,4 * EXAMINE NEXT NB CHARACTER, F1B07960
TSX TESTG0,4 * WHICH SHOULD BE A COMMA. F1B07970
TSX C0190,4 * OBTAIN IN ACC NEXT NB CHAR, AND F1B07980
TSX TESTFX+1,1 TEST FOR FIXED OR FLOATING POINT. F1B07990
TRA ER0055 FLOATING POINT RETURN IS ERROR. F1B08000
TSX C0160,2 * OBTAIN IN 1G THE FXD-PT. VARIABLE, F1B08010
TSX TESTD0,4 * WHICH SHOULD BE FOLLOWED BY ENDMK. F1B08020
CLA L(1) PREPARE PROPER FORM OF SUBSCRIPT F1B08030
STO E+3 COMBINATION AS F1B08040
STO ERASE INPUT TO SUBSCRIPT ANALYSIS= F1B08050
CLA 1G E+3 = 1ST COEFFICIENT, F1B08060
STO E+4 E+4 = 1ST SUBSCRIPT VARIABLE, F1B08070
STZ E+9 E+9 = ADDEND OF SUBSCRIPT, F1B08080
TSX CSA000,4 * DIMCTR = DIMENSION OF VARIABLE. F1B08090
CLA E OUTPUT FROM CSA IS FOUND IN F1B08100
ARS 24 E = I--TAUTAG (GENERAL TAG) 1-11. F1B08110
STO 2G ADJUST AND SAVE FOR COMP. INSTR. F1B08120
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B08130
PZE 1C+2,,L(TRA) LOC,,OP-DEC F1B08140
PZE L(0),,2G ADR,,RA-TAG F1B08150
REM C0200= ENTRY POINT USED BY C0400,C1000. F1B08160
C0202 TSX TET00,1 * GO TO TET TO ENTER 1C AND 1C+1 F1B08170
PZE 2 INTO TIFGO TABLE (TABLE 2). F1B08180
CTRAD TXI PASS2,0,TRADMX * EXIT TO PROCESS NEXT STATEMENT. F1B08190
REM END OF PROGRAM C0200. F1B08200
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B08210
REM F1B08220
REM C0300/ CALLS= ARITH,C0190,C0390,TEST..,DIAG,C0180,TET00. F1B08230
REM C0300 PROCESSES IF STATEMENTS. F1B08240
C0300 CAL MINUS0 SET SIGN OF F1B08250
ORS 1C 1C TO MINUS. F1B08260
TSX C0190,4 * OBTAIN IN AC THE 1ST NB CHAR (I). F1B08270
LDQ L(X) REPLACE THE CHARACTER I F1B08280
TSX C0390,4 * WITH THE CHARACTER X. F1B08290
LDQ TEN REPLACE THE CHARACTER F F1B08300
TSX C0390,4 * WITH THE CHARACTER 001010. F1B08310
TSX TESTE0,4 * IF NOT LPAREN -- THEN ERROR. F1B08320
LDQ EQUAL REPLACE THE CHARACTER LPAREN F1B08330
TSX C0390,4 * WITH THE CHARACTER EQUAL. F1B08340
LXA L(1),2 SET XR2 FOR COUNTING PARENTHESES. F1B08350
LDQ IFSYM2 SET LEFT+2 TO INTERNAL QUASI-ARITHMETIC IF F1B08360
STQ LEFT+2 SYMBOL FOR DIAGNOSTIC IN CASE OF NEXT CALL.F1B08370
TRA *+2 THEN F1B08380
C0302 TSX C0190,4 * MAKE SURE THAT NEXT NB CHARACTER F1B08390
CAS ENDMK IS NOT AN ENDMARK. F1B08400
TSX MRTN77,4 *CHARACTER GREATER THAN 77 OCTAL, IMPOSS. F1B08410
ER0034 TSX DIAG,4 * PROGRAM ERROR, GO TO DIAGNOSTIC. F1B08420
CAS OPEN IF IT IS A LPAREN, F1B08430
TXI C0303,,0 THEN ADD 1 TO PAREN COUNT, AND F1B08440
TXI C0302,2,1 GO EXAMINE NEXT CHARACTER. F1B08450
C0303 SUB CLOS IF IT IS A RPAREN, F1B08460
TNZ C0302 THEN TEST PAREN COUNT, AND IF IT F1B08470
TIX C0302,2,1 CAN NOT BE REDUCED,MATE IS FOUND. F1B08480
LDQ ENDMK SO REPLACE THE CHARACTER RPAREN F1B08490
TSX C0390,4 * WITH THE CHARACTER ENDMK. F1B08500
TSX C0180,2 * OBTAIN BINARY BETA1. F1B08510
TSX TESTG0,4 * THIS SHOULD BE FOLLOWED BY A COMMA.F1B08520
CLA 1G MOVE BETA1 F1B08530
STA 1C TO ADDRESS OF 1C. F1B08540
TSX C0180X,2 * OBTAIN BINARY BETA2. F1B08550
TSX TESTG0,4 * THIS SHOULD BE FOLLOWED BY A COMMA.F1B08560
CLA 1G MOVE BETA2 F1B08570
ALS 18 TO DECR PART F1B08580
STO 1C+1 OF 1C+1. F1B08590
TSX C0180X,2 * OBTAIN BINARY BETA3. F1B08600
TSX TESTD0,4 * THIS SHOULD BE FOLLOWED BY ENDMARK.F1B08610
CLA 1G MOVE BETA3 F1B08620
STA 1C+1 TO ADDRESS OF 1C+1. F1B08630
TXI ARITH,,0 EXIT TO ARITHMETIC. F1B08640
REM END OF PROGRAM C0300. F1B08650
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B08660
REM F1B08670
REM C0400/ CALLS=C0180X,TEST..,CIT00,C0200. F1B08680
REM C0400 PROCESSES IF (SENSE SWITCH STATEMENTS. F1B08690
C0400 CLA L(112) FOR SENSE SWITCH F1B08700
STO 1H SET 1H TO 112, AND PREPARE TO F1B08710
CLA L(PSE) SET 2H TO PSE. F1B08720
C0401 STO 2H SET 2H FOR SENSE SWITCH OR LIGHT. F1B08740
TSX C0180X,2 * OBTAIN BINARY SENSE SWITCH OR LITE.F1B08750
TSX TESTF0,4 * THIS SHOULD BE FOLLOWED BY RPAREN. F1B08760
REM ENTRY FROM C0501 (IF SENSE LIGHT) ROUTINE (30)F1B08769
CLA L(3) STORE 3 F1B08770
STA 1C IN ADDRESS OF 1C. F1B08780
CLA 1G ADD THE PROPER INCREMENT TO THE F1B08790
ADD 1H NUMBER OF SENSE SWITCH OR LIGHT, F1B08800
ALS 18 AND ADJUST TO THE DECREMENT. F1B08810
REM C0402= ENTRY POINT USED BY C0600. F1B08820
C0402 STO 1C+3 SET 1C+3 FOR CIT ENTRY. F1B08830
LXD EIFNO,4 PLACE THE CURRENT INTERNAL FORMULA F1B08840
PXD ,4 NUMBER IN THE DECREMENT OF F1B08850
STO 1C+2 1C+2 FOR FUTURE CIT ENTRY. F1B08860
TSX C0180X,2 * OBTAIN BINARY BETA1. F1B08870
TSX TESTG0,4 * WHICH SHOULD BE FOLLOWED BY COMMA. F1B08880
CLA 1G BRING UP, F1B08890
ALS 18 ADJUST AND F1B08900
STO 1C+1 STORE BETA1 IN DECR OF 1C+1. F1B08910
TSX C0180X,2 * OBTAIN BINARY BETA2. F1B08920
TSX TESTD0,4 * WHICH SHOULD BE FOLLOWED BY ENDMK. F1B08930
CLA 1G BRING UP AND F1B08940
STA 1C+1 STORE BETA2 IN ADDR OF 1C+1. F1B08950
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B08960
PZE 1C+2,,2H LOC,,OP-DEC F1B08970
PZE L(0),,1C+3 ADR,,RA-TAG F1B08980
TXI C0202,,0 MAKE TIFGO ENTRY, AND RETURN TO CA.F1B08990
REM END OF PROGRAM C0400. F1B09000
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B09010
REM F1B09020
REM C0500/ USES=C0400. F1B09030
REM C0500 PROCESSES IF (SENSE LIGHT STATEMENTS. F1B09040
C0500 CLA L(96) STORE 96 IN F1B09050
STO 1H 1H AND F1B09060
CLA L(MSE) OBTAIN (MSE000) IN ACC. F1B09070
TRA C0501 CHECK LIGHT NUMBER (30)F1B09080
REM END OF PROGRAM C0500. F1B09090
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B09100
REM F1B09110
REM C0600/ USES=C0400. F1B09120
REM C0600 PROCESSES IF DIVIDE CHECK STATEMENTS. F1B09130
C0600 CLA L(DCT) STORE (DCT000) F1B09140
STO 2H IN 2H F1B09150
CLA L(4) AND PICK UP 4 TO SET 1C. F1B09160
REM C0601= ENTRY POINT USED BY C0700. F1B09170
C0601 STA 1C SET 1C FOR FUTURE TIFGO ENTRY. F1B09180
PXD ,0 CLEAR THE AC, F1B09190
TRA C0402 * AND CONTINUE BY USING PROGRAM C04. F1B09200
REM END OF PROGRAM C0600. F1B09210
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B09220
REM F1B09230
REM C0700/ USES C0600. CALLS=CIT00,JIF. F1B09240
REM C0700 PROCESSES IF AC (OR MQ) OVERFLOW STATEMENTS. F1B09250
C0700 TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B09260
PZE 1C,,L(CAL) LOC,,OP-DEC F1B09270
PZE P(,,MI205 ADR,,RA-TAG F1B09280
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B09290
PZE L(0),,L(STZ) LOC,,OP-DEC F1B09300
PZE P(,,MI205 ADR,,RA-TAG F1B09310
TSX JIF,4 * GO JUMP IFN, AND F1B09320
STO 1C SET 1C. F1B09330
CLA L(TNZ) PREPARE TO COMPILE= F1B09340
STO 2H IFN TNZ BETA1. F1B09350
CLA L(5) PICKUP 5 TO SET 1C, AND F1B09360
TRA C0601 * CONTINUE BY USING PROGRAM C06. F1B09370
REM END OF PROGRAM C0700. F1B09380
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B09390
REM F1B09400
REM C0900/ CALLS=C0190,CIT00,DIAG. F1B09410
REM C0900 PROCESSES PAUSE STATEMENTS. F1B09420
C0900 LXD C090X,2 SET XR2 FOR EXIT TO RDXQ. F1B09430
REM C0901= ENTRY POINT USED BY C1300. F1B09440
C0901 STZ 1G CLEAR 1G. F1B09450
C0902 TSX C0190,4 * TEST NEXT NON-BLANK CHARACTER F1B09460
CAS ENDMK FOR END OF STATEMENT MARK. F1B09470
TSX MRTN77,4 *CHARACTER GREATER THAN 77 OCTAL, IMPOSS. F1B09480
C090X TXI C0903,,-PASS2+1 IF NOT END OF STATEMENT, THEN F1B09490
CAS L(7) TEST WHETHER DIGIT EXCEEDS 7, F1B09500
ER1005 TSX DIAG,4 * IF SO, GO CALL DIAGNOSTIC. F1B09510
NOP IF NOT, F1B09520
ADD 1G ADD 1G TO DIGIT, F1B09530
ALS 3 MULTIPLY BY 8, F1B09540
STO 1G AND STORE BACK IN 1G. F1B09550
TXI C0902,,0 CONTINUE UNTIL END OF SEGMENT. F1B09560
C0903 CLA 1G THEN PLACE OCTAL ALPHA F1B09570
ALS 15 IN THE DECREMENT F1B09580
ANA 1BAR ONLY F1B09590
STO 1C+1 OF 1C+1,WITH ZEROS ELSEWHERE. F1B09600
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B09610
PZE 1C,,L(HPR) LOC,,OP-DEC F1B09620
PZE L(0),,1C+1 ADR,,RA-TAG F1B09630
TRA 1,2 * EXIT TO CA000, OR TO C1300. F1B09640
REM END OF PROGRAM C0900. F1B09650
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B09660
REM F1B09670
REM C1000/ USES=C0200. CALLS=GETIFN,C0190,C0180,DIAG,C0160,TEST..F1B09680
REM CIT00. F1B09690
REM C1000 PROCESSES ASSIGN STATEMENTS. F1B09700
C1000 TSX GETIFN,4 * GET INTERNAL FORMULA NUMBER IN 1C F1B09710
STO 1C+2 AND 1C+2,WITH ZEROS ELSEWHERE. F1B09720
CLA L(6) STORE 6 IN F1B09730
STA 1C ADDRESS OF 1C. F1B09740
TSX C0180X,2 * FORM IN 1G THE BINARY OF ALPHA. F1B09750
SUB L(T) IF NEXT CHARACTER IS NOT T, THEN F1B09760
TZE *+2 THIS IS AN F1B09770
ER0035 TSX DIAG,4 * ERROR - GO TO THE DIAGNOSTIC. F1B09780
TSX C0190,4 * EXAMINE NEXT NON-BLANK CHARACTER F1B09790
SUB L(O) AND IF IT IS NOT O, THEN F1B09800
TNZ *-3 ERROR, GO TO DIAGNOSTIC. F1B09810
CLA 1G PUT BIN EQUIV OF ALPHA F1B09820
STO 1C+1 IN ADDRESS OF 1C+1. F1B09830
TSX C0190,4 * PROCEED TO ASSEMBLE IN 1G F1B09840
TSX TESTFX+1,1 TEST FOR FIXED OR FLOATING POINT. F1B09850
TRA ER0055 FLOATING POINT RETURN IS ERROR. F1B09860
TSX C0160,2 * THE SYMBOL N. F1B09870
TSX TESTD0,4 * THE NEXT NB CHAR SHOULD BE ENDMK. F1B09880
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B09890
PZE 1C+2,,L(CLA) LOC,,OP-DEC F1B09900
PZE L(0),,L(0) ADR,,RA-TAG F1B09910
TSX CIT00,4 * STORE SECOND COMPILED INSTRUCTION= F1B09920
PZE L(0),,L(STO) LOC,,OP-DEC F1B09930
PZE 1G,,L(0) ADR,,RA-TAG F1B09940
TRA C0202 * CONTINUE BY USING PROGRAM C02. F1B09950
REM END OF PROGRAM C1000. F1B09960
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B09970
REM F1B09980
REM C1100/ CALLS=C0180X,TEST..,CIT00. F1B09990
REM C1100 PROCESSES SENSE LIGHT STATEMENTS. F1B10000
C1100 TSX C0180X,2 * FORM IN 1G THE BINARY OF SLN. F1B10010
TSX TESTD0,4 * THE NEXT NB CHARACTER SHD BE ENDMK.F1B10020
CLA 1G STORE SENSE LIGHT NUMBER F1B10030
ADD L(96) PLUS 96 F1B10040
ALS 18 IN DECR F1B10050
STO 1G OF 1G. F1B10060
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B10070
PZE 1C,,L(PSE) LOC,,OP-DEC F1B10080
PZE L(0),,1G ADR,,RA-TAG F1B10090
TRA PASS2 * EXIT TO PASS2. F1B10100
REM END OF PROGRAM C1100. F1B10110
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B10120
REM F1B10130
REM C1300/ CALLS=C0901,TET00,CIT00. F1B10140
REM C1300 PROCESSES STOP STATEMENTS. F1B10150
C1300 TSX TET00,1 * GO MAKE EIFNO ENTRY F1B10160
PZE 15 IN TSTOP TABLE. F1B10170
TSX C0901,2 * USE C0900 TO BEGIN PROCESSING. F1B10180
TSX CIT00,4 * GO MAKE FOLLOWING CIT ENTRY= F1B10190
PZE L(0),,L(TRA) LOC,,OP-DEC F1B10200
PZE 1C,,L(0) ADR,,RA-TAG F1B10210
TRA PASS2 * EXIT TO PASS2. F1B10220
REM END OF PROGRAM C1300. F1B10230
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B10240
REM F1B10250
REM C1600/ CALLS=C0190,TEST..,GIF,BSS. F1B10260
REM C1600 PROCESSES CONTINUE STATEMENTS. F1B10270
C1600 TSX C0190,4 * OBTAIN NEXT NBCHAR IN ACC. F1B10280
TSX TESTD0,4 * CHARACTER SHOULD BE AN ENDMARK. F1B10290
TSX GIF,4 * GET INTERNAL FORMULA NUMBER, AND F1B10300
TSX BSS,2 * GO COMPILE= IFN BSS 0. F1B10310
TRA PASS2 * EXIT TO PASS2. F1B10320
REM END OF PROGRAM C1600. F1B10330
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B10340
REM F1B10350
REM C3200/ CALLS=C0190,TEST..,JIFGIF,DIAG,CIT00. F1B10360
REM C3200 PROCESSES RETURN STATEMENTS. F1B10370
C3200 TSX C0190,4 * EXAMINE NEXT NON-BLANK CHARACTER, F1B10380
TSX TESTD0,4 * WHICH SHOULD BE AN ENDMARK. F1B10390
TSX JIF,4 * SET SL TO ALPHA+1. F1B10400
TSX TET00,1 ENTER THIS IFN IN TSTOPS TABLE. F1B10410
PZE 15 F1B10420
LXD SBDFCN,4 IS THIS RETURN IN A SUBPROGRAM. F1B10430
TXH *+2,4,0 * YES. F1B10440
ER0039 TSX DIAG,4 * ERROR - GO TO THE DIAGNOSTIC. F1B10450
CLA FSNAME UNLESS FUNCTION NAME IS ZERO, F1B10460
TZE C3201 THEN F1B10470
REM DOUBLE PRECISION - COMPLEX ARITHMETIC PATCH. F1B10480
CLA MODECL GET SPECIAL MODE INDICATOR, IF ANY. F1B10490
STZ MODECL CLEAR INDICATOR. F1B10500
NZT FSNAME TEST WHETHER WITHIN A FUNCTION SUBPROGRAM. F1B10510
TRA C3201 SUBROUTINE TYPE SUBPROGRAM F1B10520
CAS L(B) TEST FOR BOOLEAN F1B10530
TRA C3204 NOT BOOLEAN, EXIT F1B10540
TRA *+2 BOOLEAN F1B10550
TRA C3204 NOT BOOLEAN, EXIT F1B10560
TSX CIT00,4 COMPILE F1B10570
PZE 1C,,L(CAL) CAL FSNAME F1B10580
PZE FSNAME,,L(0) F1B10590
TRA C3201-1 F1B10600
C3204 CAS L(D) TEST FOR DOUBLE PRECISION. F1B10610
TRA *+2 F1B10620
TRA C3203 YES F1B10630
SUB L(I) TEST FOR COMPLEX ARITHMETIC. F1B10640
TNZ C3202 NEITHER. F1B10650
C3203 CLA 1C SET UP AND F1B10660
STO CW COMPILE F1B10670
CORR03 CAL FSNAME F1B10680
SLW CW+2 F1B10690
SLW E+2 F1B10700
LGR 30 F1B10710
LAS L(H) F1B10720
LAS L(O) F1B10730
TRA *+3 FLOATING F1B10740
TRA *+2 DITTO F1B10750
TRA C3202 FIXED TREATED SAME AS NORMAL FORTRAN F1B10760
STZ CW+3 F1B10770
CLS 2E18 F1B10780
STO DPCW F1B10790
TSX CPDCLA,2 COMPILE SEQUENCE FOR DP AND CA CLA F1B10800
TRA C3201-1 F1B10810
REM F1B10820
C3202 TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B10830
PZE 1C,,L(CLA) LOC,,OP-DEC F1B10840
PZE FSNAME,,L(0) ADR,,RA-TAG F1B10850
STZ 1C CLEAR 1C, AND F1B10860
C3201 TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B10870
PZE 1C,,L(LXD) LOC,,OP-DEC F1B10880
PZE DOLSGN,,L(1) ADR,,RA-TAG F1B10890
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B10900
PZE L(0),,L(LXD) LOC,,OP-DEC F1B10910
PZE DOLSGN,,ABTAG2 ADR,,RA-TAG F1B10920
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B10930
PZE L(0),,L(QXD) LOC,,OP-DEC F1B10940
PZE DOLSGN,,ABTAG3 ADR,,RA-TAG F1B10950
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B10960
PZE SL,,L(QPR) LOC,,OP-DEC F1B10970
PZE L(0),,ARGCNT ADR,,RA-TAG F1B10980
TSX CIT00,4 * GO MAKE THE FOLLOWING CIT ENTRY= F1B10990
PZE L(0),,L(TRA) LOC,,OP-DEC F1B11000
PZE SL,,L(0) ADR,,RA-TAG F1B11010
TRA PASS2 * EXIT TO PASS2. F1B11020
REM END OF PROGRAM C3200. F1B11030
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B11040
REM F1B11050
REM C3300/ CALLS=C0390,C0190X,C0190,TEST..,ARITH,SUBX00,TET00, F1B11060
REM GIF,SXD,LIB. F1B11070
REM C3300 PROCESSES CALL STATEMENTS. F1B11080
C3300 TSX C0190,4 * IF 1ST CHARACTER OF NAME IS F1B11090
TSX C0160,2 * COLLECT THE REST OF THE NAME, WHICHF1B11100
TSX TESTC0,4 * SHD BE FOLLOWED BY LPAREN OR ENDMK.F1B11110
TRA C3302 CHECK DIMENSION TABLE ENTRIES (29)F1B11120
TSX C0190X,4 * PSEUDO-ARITHMETIC FORMULA (Z10=). F1B11130
TSX C0190,4 * PICKUP THE CHARACTER C, F1B11140
LDQ L(Z) AND F1B11150
TSX C0390,4 * REPLACE C WITH Z. F1B11160
LDQ TEN AND F1B11170
TSX C0390,4 * REPLACE A WITH TEN. F1B11180
LDQ EQUAL AND F1B11190
TSX C0390,4 * REPLACE FIRST L WITH =. F1B11200
LDQ 12Z AND F1B11210
TSX C0390,4 * REPLACE SECOND L WITH +. F1B11220
TXI ARITH,,0 THEN EXIT TO ARITHMETIC. F1B11230
C3301 TSX GIF,4 * GET CURRENT IFN AND F1B11240
TSX SXD,2 * COMPILE SXD 6)+4,4. F1B11250
TSX LIB,4 * GO ENTER NAME IN CLOSUB, COMPILE= F1B11260
PZE L(0),,L(TSX) LOC,,OP-DEC F1B11270
PZE 1G,,L(4) ADR,,RA-TAG F1B11280
TSX FLTR00,4 COMPILE FLOW TRACE CITS IF ACTIVATED. F1B11290
PZE L(0),,L(LXD) THEN COMPILE LXD 6(+4,4 F1B11300
PZE O(,,D4A4 F1B11310
TRA PASS2 * EXIT TO PASS2. F1B11320
REM END OF PROGRAM C3300. F1B11330
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B11340
REM F1B11350
REM F1B11360
REM F1B11370
REM END OF CONTROL STATEMENT PROCESSORS. F1B11380
REM F1B11390
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B11400
REM F1B11410
REM PASS 2/3-PROCESS INPUT-OUTPUT STATEMENTS= F1B11420
REM F1B11430
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B11440
REM F1B11450
REM READ INPUT TAPE N F1B11460
REM TSH / ENTRY FROM CLASSIFICATION. F1B11470
TSH TSX UNIT,4 * GO PROCESS UNIT DESIGNATION. F1B11480
AXT (TSH),4 PICKUP FIRST TSX ADDRESS. F1B11490
REM HI / ENTRY FROM CSH. F1B11500
HI TSX INPUT,2 * GO PROCESS CALLING SEQUENCE. F1B11510
TSX FMTDSG,1 * GO PROCESS FORMAT DESIGNATION. F1B11520
AXT (RTN),4 PICKUP FINAL TSX ADDRESS. F1B11530
TRA SCAN * EXIT TO SCAN LIST. F1B11540
REM EXIT TSH. F1B11550
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B11560
REM F1B11570
REM READ F1B11580
REM CSH / ENTRY FROM CLASSIFICATION. F1B11590
CSH TSX GIF,4 * GO SET SYMBOLIC LOCATION. F1B11600
AXT (CSH),4 PICKUP FIRST TSX ADDRESS. F1B11610
TRA HI * CONTINUE ABOVE. F1B11620
REM EXIT CSH. F1B11630
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B11640
REM F1B11650
REM WRITE OUTPUT TAPE N F1B11660
REM STH / ENTRY FROM CLASSIFICATION. F1B11670
STH TSX UNIT,4 * GO PROCESS UNIT DESIGNATION. F1B11680
AXT (STH),4 PICKUP FIRST TSX ADDRESS. F1B11690
REM HO / ENTRY FROM SPH, SCH. F1B11700
HO TSX OUTPUT,2 * GO PROCESS CALLING SEQUENCE. F1B11710
TSX FMTDSG,1 * GO PROCESS FORMAT DESIGNATION. F1B11720
AXT (FIL),4 PICKUP FINAL TSX ADDRESS. F1B11730
TRA SCAN * EXIT TO SCAN LIST. F1B11740
REM EXIT STH. F1B11750
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B11760
REM F1B11770
REM PRINT F1B11780
REM SPH / ENTRY FROM CLASSIFICATION. F1B11790
SPH TSX GIF,4 * GO SET SYMBOLIC LOCATION. F1B11800
AXT (SPH),4 PICKUP FIRST TSX ADDRESS. F1B11810
TRA HO * CONTINUE ABOVE. F1B11820
REM EXIT SPH. F1B11830
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B11840
REM F1B11850
REM PUNCH F1B11860
REM SCH / ENTRY FROM CLASSIFICATION. F1B11870
SCH TSX GIF,4 * GO SET SYMBOLIC LOCATION. F1B11880
AXT (SCH),4 PICKUP FIRST TSX ADDRESS. F1B11890
TRA HO * CONTINUE ABOVE. F1B11900
REM EXIT SCH. F1B11910
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B11920
REM F1B11930
REM WRITE TAPE N F1B11940
REM STB / ENTRY FROM CLASSIFICATION. F1B11950
STB TSX UNIT,4 * GO PROCESS UNIT DESIGNATION. F1B11960
AXT (STB),4 PICKUP FIRST TSX ADDRESS. F1B11970
TSX OUTPUT,2 * GO PROCESS CALLING SEQUENCE. F1B11980
AXT (WLR),4 PICKUP FINAL TSX ADDRESS. F1B11990
TRA SCAN * EXIT TO SCAN LIST. F1B12000
REM EXIT STB. F1B12010
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12020
REM F1B12030
REM READ TAPE N F1B12040
REM TSB / ENTRY FROM CLASSIFICATION. F1B12050
TSB TSX UNIT,4 * GO PROCESS UNIT DESIGNATION. F1B12060
AXT (TSB),4 PICKUP FIRST TSX ADDRESS. F1B12070
TSX INPUT,2 * GO PROCESS CALLING SEQUENCE. F1B12080
AXT (RLR),4 PICKUP FINAL TSX ADDRESS. F1B12090
TRA SCAN * EXIT TO SCAN LIST. F1B12100
REM EXIT TSB. F1B12110
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12120
REM F1B12130
REM BACKSPACE N F1B12140
REM BST / ENTRY FROM CLASSIFICATION. F1B12150
BST TSX UNIT,4 * GO PROCESS UNIT DESIGNATION. F1B12160
AXT (BST),4 PICKUP FIRST TSX ADDRESS. F1B12170
REM TP / ENTRY FROM EFT,RWT. F1B12180
TP TSX TAPE,2 * GO PROCESS CALLING SEQUENCE. F1B12190
TRA FINI * EXIT TO FINISH. F1B12200
REM EXIT BST. F1B12210
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12220
REM F1B12230
REM ENDFILE N F1B12240
REM EFT / ENTRY FROM CLASSIFICATION. F1B12250
EFT TSX UNIT,4 * GO PROCESS UNIT DESIGNATION. F1B12260
AXT (EFT),4 PICKUP FIRST TSX ADDRESS. F1B12270
TRA TP * CONTINUE ABOVE. F1B12280
REM EXIT EFT. F1B12290
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12300
REM F1B12310
REM REWIND N F1B12320
REM RWT / ENTRY FROM CLASSIFICATION. F1B12330
RWT TSX UNIT,4 * GO PROCESS UNIT DESIGNATION. F1B12340
AXT (RWT),4 PICKUP FIRST TSX ADDRESS. F1B12350
TRA TP * CONTINUE ABOVE. F1B12360
REM EXIT RWT. F1B12370
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12380
REM F1B12390
REM WRITE DRUM N,J F1B12400
REM SDR / ENTRY FROM CLASSIFICATION. F1B12410
SDR TSX UNIT,4 * GO PROCESS UNIT DESIGNATION. F1B12420
AXT (SDR),4 PICKUP FIRST TSX ADDRESS. F1B12430
AXT 5,1 PICKUP FORVAR DESIGNATION. F1B12440
REM DR / ENTRY FROM DRS. F1B12450
DR CAL TRA PICKUP DRUM-SWITCH DESIGNATION. F1B12460
TSX DRUM,2 * GO PROCESS CALLING SEQUENCE. F1B12470
CAL NOP SET DRUM SWITCH F1B12480
STD DSW IN UNIT. F1B12490
STD ER2002 F1B12500
TSX UNIT,4 * GO PROCESS DRUM ADDRESS. F1B12510
CAL *-1 RESET DRUM SWITCH F1B12520
STD DSW IN UNIT. F1B12530
STD ER2002 F1B12540
TSX CIT00,4 * GO COMPILE LDA. F1B12550
PZE L(0),,L(LDA) LOC,,OP-DEC F1B12560
PZE L(0),,L(0) ADR,,RA-TAG F1B12570
TRA LIST * EXIT TO SCAN LIST. F1B12580
REM EXIT SDR. F1B12590
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12600
REM F1B12610
REM READ DRUM N,J F1B12620
REM DRS / ENTRY FROM CLASSIFICATION. F1B12630
DRS TSX UNIT,4 * GO PROCESS UNIT DESIGNATION. F1B12640
AXT (DRS),4 PICKUP FIRST TSX ADDRESS. F1B12650
AXT 6,1 PICKUP FORVAL DESIGNATION. F1B12660
TRA DR * CONTINUE ABOVE. F1B12670
REM EXIT DRS. F1B12680
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12690
REM SCAN / ENTRY FROM TSH, STH, STB, TSB. F1B12700
SCAN SXA END,4 SET FINAL TSX ADDRESS. F1B12710
TSX LXD,2 * GO COMPILE LXD 6)+4,4. F1B12720
REM LIST / ENTRY FROM SDR. SWITCH SET DURING BEG SCAN. F1B12730
LIST NOP ENDSW SWITCH (LIST / NO LIST). F1B12740
REM RSC / ENTRY FROM SPC. F1B12750
RSC TSX JIF,4 * JUMP IFN AND SET SYMBOLIC LOC. F1B12760
AXT TLDOS,4 RESET TEMPORARY F1B12770
SXA TLINE,4 TABLE LINE COUNTER. F1B12780
STZ DOLEV CLEAR DO LEVEL COUNTER. F1B12790
TRA LSCP GO TO PATCH. $F1B12800
REM LSC / ENTRY FROM SPC. F1B12810
LSC AXT LISTR,4 PREPARE FOR LIST SCAN. F1B12820
REM CXS / ENTRY FROM EQS, BEG. F1B12830
CXS SXA CEXIT,4 SET CONTROL TRANSFER. F1B12840
REM NXS / ENTRY FROM LPR, SPC, CMA. F1B12850
NXS AXT 6,2 RESET SYMBOL CHARACTER COUNT F1B12860
SXD CSJ,2 AND SHIFT COUNT. F1B12870
STZ CHR-6 CLEAR SYMBOL BUFFER. F1B12880
STZ SYM CLEAR SYMBOL WORKING STORAGE. F1B12890
REM NXC / ENTRY FROM CMA. F1B12900
NXC TSX C0190,4 * EXAMINE NEXT NON-BLANK F1B12910
AXT CTEST-ENDMK,4 CHARACTER. F1B12920
LAS CTEST,4 IF CONTROL F1B12930
TRA *+2 PUNCTUATION, THEN F1B12940
CEXIT TRA ..,4 * TAKE INDICATED TRANSFER. F1B12950
TIX *-3,4,1 OTHERWISE, F1B12960
LXD CSJ,4 SAVE EACH F1B12970
STO CHR,4 CHARACTER F1B12980
TIX *+4,4,1 SEPARATELY, F1B12990
TXL *+2,2,36 AND UNLESS THERE ARE F1B13000
ER0041 TSX DIAG,4 * MORE THAN SIX CHARACTERS, F1B13010
TXI *+2,4,-1 ALSO F1B13020
ALS 36,2 PACK F1B13030
SXD CSJ,4 CHARACTERS F1B13040
ORS SYM INTO F1B13050
TXI NXC,2,6 ONE WORD. F1B13060
REM END SCAN. F1B13070
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B13080
REM LISTR/ CONTROL TRANSFERS FOR LIST SCAN = F1B13090
TRA EMK * ENDMARK F1B13100
TRA LPR * ( F1B13110
TRA CMA * , F1B13120
TRA RPR * ) F1B13130
TRA EQSP * = (TEST FOR LEGALITY). $F1B13140
TRA *+4 - (ILLEGAL CHARACTER IN I/O LIST). F1B13150
TRA *+3 / (ILLEGAL CHARACTER IN I/O LIST). F1B13160
TRA *+2 . (ILLEGAL CHARACTER IN I/O LIST). F1B13170
TRA *+1 + (ILLEGAL CHARACTER IN I/O LIST). F1B13180
ER0042 TSX DIAG,4 * * (ILLEGAL CHARACTER IN I/O LIST). F1B13190
LISTR BSS 0 INDEXING ADDRESS FOR ABOVE LIST. F1B13200
REM END LISTR. F1B13210
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B13220
REM LPR / ENTRY FROM LIST SCAN ON LEFT PARENTHESIS. F1B13230
LPR CAL SYM TEST FOR SUBSCRIPT OR DO NEST. F1B13240
TZE LPRDO IF SUBSCRIPT, THEN F1B13250
TSX TYP,4 * IF VARIABLE SYMBOL CONTAINS LESS F1B13260
TRA *+2 THAN 6 CHARACTERS, ADD A BLANK. F1B13270
ER0043 TSX DIAG,4 * ON CONSTANT RETURN, GO TO DIAG. F1B13280
CAL SYM MOVE SYMBOL F1B13290
SLW E+2 FOR SUBSCRIPT PROCESSOR. F1B13300
SLW SA SET SYMBOLIC ADDRESS. F1B13310
TSX SS000,4 * GO SCAN AND PROCESS SUBSCRIPT. F1B13320
TSX RA000,4 * GO COMPUTE RELATIVE ADDRESS. F1B13330
LPR1 TSX C0190,4 * EXAMINE NEXT NON-BLANK CHARACTER. F1B13340
CAS CLOS AND IF IT IS F1B13350
TRA *+2 EITHER A COMMA, F1B13360
TRA RPR * OR AN ENDMARK, $F1B13370
TSX TESTA0,4 * THEN F1B13380
TRA CMA2 * EXIT TO CMA. F1B13390
PZE (NOT USED) $F1B13400
PZE (NOT USED) $F1B13410
PZE (NOT USED) $F1B13420
REM EQSP / TEST WHETHER = LEGAL IN THIS CONTEXT. $F1B13430
EQSP LXA DOLEV,4 USE OF = IS ILLEGAL IF NO LIST $F1B13440
TXL ER0063,4,0 ELEMENT HAS BEEN COLLECTED SINCE $F1B13450
TRA EQS * LAST LEFT PARENTHESIS. $F1B13460
PZE (NOT USED) $F1B13465
REM LPRDO / PROCESS DO NEST. F1B13470
LPRDO CAL DOLEV IF DOLEV F1B13480
TZE *+4 IS NOT ZERO, THEN F1B13490
ZET SL TEST FOR NULL DO. F1B13500
TSX BSS,2 * COMPILE BSS TO ESTABLISH POSITION. F1B13510
TSX JIF,4 * JUMP IFN, AND SET SYMBOLIC LOC. F1B13520
LXD DOLEV,4 INCREASE THE C(DOLEV D) F1B13530
TXI *+1,4,1 BY 1, AND F1B13540
PXD ,4 SET THE C(DOLEV A) F1B13550
SLW DOLEV TO ZERO. F1B13560
CAL TLINE NOTE AT F1B13570
STA *+5 THIS LEVEL F1B13580
STO DOLEV,4 THE LOCATION IN TLDO F1B13590
ADD L(5) OF THIS DO F1B13600
STA TLINE AND INCREASE TLINE COUNT. F1B13610
CLS TL MOVE -(0(IFN)0(248)) INTO THE F1B13620
STO .. LOCATION WORD OF CURRENT TEMP DO. F1B13630
TSX JIF,4 * GO JUMP IFN, AND SET SL AND TL. F1B13640
LXD DOLEV,4 IF 3 OR FEWER LEVELS IN LIST DO, F1B13650
TXL NXS,4,3 * RETURN TO LIST SCAN. F1B13660
ER0044 TSX DIAG,4 * OTHERWISE, GO TO DIAGNOSTIC. F1B13670
REM END LPR. F1B13680
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B13690
REM EQS / ENTRY FROM LIST SCAN ON EQUAL SIGN. F1B13700
EQS LXD DOLEV,4 TEST THE LEGALITY OF EQUAL SIGN, F1B13710
TXH *+2,4,0 AND GO TO DIAG ON THE ATTEMPT TO F1B13720
ER0045 TSX DIAG,4 * SPECIFY SUBSCRIPT RANGE WITHOUT (. F1B13730
CAL DOLEV,4 INITIALIZE SPECIFICATION F1B13740
STA SPC2 OF GENERATED DO F1B13750
STA SPC5 AT CURRENT LEVEL. F1B13760
ADD L(1) PREPARE TO ENTER FORMULA NUMBERS F1B13770
STA EQS1 IN LOCATION WORD, SUBSCRIPT IN F1B13780
ADD L(4) SYMBOL WORD, AND SUBSCRIPT SPECS F1B13790
STA SPC3 IN TEMPDO ENTRY. F1B13800
AXT 3,4 PREPARE TO COUNT THE F1B13810
SXA NSJ,4 NUMBER OF SPECIFICATIONS. F1B13820
CAL SYM OBTAIN SUBSCRIPT F1B13830
TXH EQS1,2,36 FOR THIS DO, AND F1B13840
PXD ,0 STORE IN PROPER F1B13850
LDQ BLANKS LINE OF TEMPORARY F1B13860
LGL 42,2 .. F1B13870
ORA SYM LIST DO TABLE. F1B13880
EQS1 SLW .. (SUBSCRIPT SYMBOL WORD) F1B13890
PXD ,0 CLEAR AC. F1B13900
LDQ SYM GET SUBSCRIPT SYMBOL. F1B13910
LGL 6 SHIFT FIRST CHARACTER INTO AC. F1B13920
TSX TESTFX+1,1 TEST FOR FIXED POINT BEGINNING. F1B13930
TRA ER2001 *GO TO DIAGNOSTIC, NAME IS FLOATING POINT. F1B13940
AXT SPCTR,4 SET CONTROL TRANSFER FOR F1B13950
TRA CXS * SPECIFICATION SCAN. F1B13960
REM EXIT EQS. F1B13970
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B13980
REM SPCTR / CONTROL TRANSFERS FOR SPECIFICATION SCAN = F1B13990
ER0046 TSX DIAG,4 * 77(ILLEGAL IN CONTROL FOR LIST DO).F1B14000
TRA *+8 ( (ILLEGAL IN CONTROL FOR LIST DO).F1B14010
TRA SPC1 * , F1B14020
TRA SPC * ) F1B14030
TRA *+5 = (ILLEGAL IN CONTROL FOR LIST DO).F1B14040
TRA *+4 - (ILLEGAL IN CONTROL FOR LIST DO).F1B14050
TRA *+3 / (ILLEGAL IN CONTROL FOR LIST DO).F1B14060
TRA *+2 . (ILLEGAL IN CONTROL FOR LIST DO).F1B14070
TRA *+1 + (ILLEGAL IN CONTROL FOR LIST DO).F1B14080
ER0047 TSX DIAG,4 * * (ILLEGAL IN CONTROL FOR LIST DO).F1B14090
SPCTR BSS 0 INDEXING ADDRESS FOR ABOVE LIST. F1B14100
REM END SPCTR. F1B14110
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B14120
REM SPC / ENTRY FROM SPECIFICATION SCAN ON RIGHT PARENTHESIS. F1B14130
SPC CAL SPC4 PREPARE FOR END OF SPECIFICATION. F1B14140
STO SPC4 SET SPC4 OP-SWITCH TO NOP CASE. F1B14150
REM SPC1 / ENTRY FROM SPECIFICATION SCAN ON COMMA. F1B14160
SPC1 TSX TYP,4 * GO TEST TYPE OF SUBSCRIPT SPEC. F1B14170
TRA *+3 IF FIXED POINT CONSTANT, F1B14180
NSJ AXT ..,4 PICKUP SPECIFICATION COUNT, F1B14190
TRA SPC3 AND GO ENTER CONSTANT IN TABLE. F1B14200
LXA NSJ,4 OTHERWISE, PICKUP SPEC COUNT, F1B14210
CAL CHR-6 TEST VARIABLE NAME FOR FIXED POINT F1B14220
TSX TESTFX+1,1 BEGINNING. F1B14230
TRA ER2001 *BEGINS WITH FLOATING CHARACTER. F1B14240
CAL 2E17 AND IF VARIABLE, NOTE BY F1B14250
ARS 3,4 PLACING BIT IN TAG FIELD F1B14260
SPC2 ORS .. OF TABLE ENTRY. F1B14270
CAL SYM PICKUP VARIABLE SYMBOL AND F1B14280
SPC3 SLW ..,4 ENTER N SUB J IN TABLE. F1B14290
TNX *+5,4,1 REDUCE J. F1B14300
SXA NSJ,4 SAVE SPEC COUNT, AND F1B14310
SPC4 TXL NXS,,0 EXIT TO SCAN, IF SWITCH IS TXL. F1B14320
CAL L(1) SET N SUB 3 = 1 IF NOT F1B14330
TRA *-5 OTHERWISE SPECIFIED. F1B14340
CLS SPC4 RESTORE SPC4 EXIT. F1B14350
STO SPC4 (3 SPECS HAVE BEEN TREATED) F1B14360
LXD EIFNO,4 ALSO PICKUP IFN FOR BETA IN F1B14370
REM SPC5 / ENTRY FROM RPR. F1B14380
SPC5 SXA ..,4 TEMPDO TABLE. F1B14390
LXA DOLEV,4 IF DOLEV ADDRESS F1B14400
TXL *+4,4,0 IS NON-ZERO, F1B14410
ZET SL COMPILE BSS 0 F1B14420
TSX BSS,2 * TO ESTABLISH POSITION. F1B14430
TSX JIF,4 * JUMP IFN AND SET SL AND TL. F1B14440
LXD DOLEV,4 DECREASE DOLEV D BY 1 TO F1B14450
TXI *+1,4,-1 INDICATE A TREATED LEVEL. F1B14460
NOP 0 IF NOT ZERO, THEN $F1B14470
SXD DOLEV,4 ALL LEVELS ARE NOT TREATED. $F1B14480
TXH LSC,4,0 * RETURN TO SCAN NEXT LEVEL. F1B14490
LXA TLINE,2 IF LEVEL IS ZERO, THEN F1B14500
SXA *+3,2 ENTER GENERATED F1B14510
TXI *+1,2,-TLDOS DO STATEMENTS F1B14520
AXT 5,4 INTO TDO TABLE. F1B14530
CAL ..,2 (MOVE EACH F1B14540
SLW 1C+5,4 TEMPDO TABLE ENTRY F1B14550
TNX *+2,2,1 INTO 1C...1C+4, F1B14560
TIX *-3,4,1 AND WHEN DONE, F1B14570
LXA 1C,4 IF THIS IS NOT F1B14580
TXL *+3,4,0 A NULL DO STATEMENT, THEN F1B14590
TSX TET00,1 * GO MAKE AN ENTRY IN TDO TABLE.) F1B14600
PZE 1 WHEN THE WHOLE DO NEST F1B14610
TXH *-9,2,1 HAS BEEN ENTERED, F1B14620
TRA RSC * EXIT TO LIST SCAN. F1B14630
REM END SPC. F1B14640
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B14650
REM RPR / ENTRY FROM LIST SCAN ON RIGHT PARENTHESIS. F1B14660
RPR LXD DOLEV,4 TEST LEGALITY OF PUNCTUATION. F1B14670
TXH *+2,4,0 IF THERE ARE TOO MANY ) IN LIST, F1B14680
ER0048 TSX DIAG,4 * GO TO DIAGNOSTIC. F1B14690
CAL DOLEV,4 NULLIFY DO NEST F1B14700
STA SPC5 AT CURRENT LEVEL. F1B14710
TXL *+4,2,6 IF THERE WERE ANY CHARACTERS $F1B14720
AXT *+3,4 COLLECTED IN SCAN, THEN SET F1B14730
SXA CMASW,4 SWITCH IN CMA FOR RETURN, F1B14740
TRA CMA1 * AND EXIT TO CMA. F1B14750
REM *+1 / REENTRY POINT FROM CMA. F1B14760
AXT NXS,4 RESET F1B14770
SXA CMASW,4 CMASWITCH, F1B14780
AXT 0,4 PICKUP ZERO, F1B14790
TRA SPC5 * AND EXIT TO SPC. F1B14800
REM END RPR. F1B14810
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B14820
REM CMA / ENTRY FROM LIST SCAN OF COMMA. F1B14830
CMA TXL NXC,2,6 * RETURN TO SCAN IF NOTHING FOUND. F1B14840
REM CMA1 / ENTRY FROM RPR AND EMK. F1B14850
CMA1 TSX TYP,4 * GO TEST TYPE OF VARIABLE. F1B14860
TRA *+2 IF CONSTANT, THEN F1B14870
ER0049 TSX DIAG,4 * GO TO DIAGNOSTIC. F1B14880
CAL SYM MOVE SYMBOL F1B14890
SLW SA INTO SYMBOLIC ADDRESS. AND F1B14900
REM CMA2 / ENTRY FROM LPR. F1B14910
CMA2 LXA DOLEV,4 INCREASE DOLEV A F1B14920
TXI *+1,4,1 BY 1, F1B14930
SXA DOLEV,4 AND THEN F1B14940
CAL GTAG SET GENERALIZED TAG. F1B14950
SLW RA (RELATIVE ADDRESS) F1B14960
TZE *+5 IF THIS VARIABLE HAS A SUBSCRIPT, F1B14970
CAL EPS AND IF SUBSCRIPT F1B14980
TNZ CMASW2 IS A CONSTANT, F1B14990
SXA RA,0 THEN SET RELATIVE ADDRESS TO ZERO. F1B15000
TRA CMASW2 THEN GO COMPILE. F1B15010
CAL SA IF THIS VARIABLE F1B15020
SLW E+2 DOES NOT HAVE A SUBSCRIPT, THEN F1B15030
TSX DIM1SR,4 * GO SEARCH DIM1 TABLE. F1B15040
TRA *+3 IF FOUND, THEN F1B15050
CLA ERASE1 PICKUP 1ST DIMENSION F1B15060
TRA DVS AND GO TEST SIZE. OTHERWISE, F1B15070
TSX DIM2SR,4 * GO SEARCH DIM2 TABLE. F1B15080
TRA *+8 AND IF FOUND, F1B15090
LDQ ERASE1 PICKUP 1ST AND 2ND DIMENSIONS F1B15100
STZ N2 AND MULTIPLY F1B15110
SLQ N2 THEM F1B15120
LGL 18 TOGETHER. F1B15130
MPY N2 THEN GO TEST F1B15140
ARS 1 THEIR PRODUCT. OTHERWISE, F1B15150
TRA DVS GO SEARCH F1B15160
TSX DIM3SR,4 * DIM3 TABLE. F1B15170
TRA NODIM AND IF FOUND, F1B15180
LDQ ERASE1 PICKUP F1B15190
STZ N2 1ST DIMENSION, F1B15200
SLQ N2 2ND DIMENSION, F1B15210
LGL 18 AND 3RD DIMENSION. F1B15220
MPY N2 MULTIPLY F1B15230
LRS 18 THEM TOGETHER F1B15240
MPY ERASE2 AND IF F1B15250
LLS 17 THEIR F1B15260
DVS SUB L(1) PRODUCT IS F1B15270
TZE NODIM GREATER THAN 1, THEN F1B15280
CMASW1 NOP DRMIO CONTINUE BELOW, IF DRUM. F1B15290
PAX ,4 OTHERWISE, F1B15300
TXI *+1,4,1 SET F1B15310
SXD RA,4 DIMENSION ARGUMENT, F1B15320
AXT (SLO),4 AND PICKUP (SLO), F1B15330
IOSW1 NOP *+2 OR F1B15340
AXT (SLI),4 (SLI), F1B15350
SXA *+4,4 TO SET TSX ADDRESS. F1B15360
TSX SXD,2 * GO COMPILE SXD 6)+4,4. F1B15370
TSX LIB,4 * ENTER CLOSUB AND COMPILE TSX ..,4. F1B15380
PZE L(0),,L(TSX) LOC,,OP-DEC F1B15390
PZE ..,,L(4) ADR,,RA-TAG F1B15400
TSX CIT00,4 * GO COMPILE ARRAY ARGUMENT. F1B15410
PZE L(0),,L(PZE) LOC,,OP-DEC F1B15420
PZE SA,,2E18 ADR,,RA-TAG F1B15430
TSX CIT00,4 * GO COMPILE DIMENSION ARGUMENT. F1B15440
PZE L(0),,L(PZE) LOC,,OP-DEC F1B15450
PZE L(0),,RA ADR,,RA-TAG F1B15460
TSX LXD,2 * GO COMPILE LXD 6)+4,4. F1B15470
TRA RESET THEN GO RESET SL AND GTAG. F1B15480
REM DRMIO / DRUM INPUT /OUTPUT. F1B15490
DRMIO ALS 18 PLACE DIMENSION-1 IN F1B15500
STO G DECREMENT OF G, AND F1B15510
TSX FXCNIX,4 * GO ENTER IN FIXCON, AND GET TAG. F1B15520
ALS 18 PLACE TAG IN F1B15530
STD RAT DECREMENT OF RAT. THEN F1B15540
TSX CIT00,4 * GO COMPILE LXD 2)+..,TAG. F1B15550
PZE L(0),,L(LXD) LOC,,OP-DEC F1B15560
PZE I(,,RAT ADR,,RA-TAG F1B15570
TSX CIT00,4 * GO COMPILE CPY SYMBOL,TAG F1B15580
PZE L(0),,L(CPY) LOC,,OP-DEC F1B15590
PZE SA,,L(8) ADR,,RA-TAG F1B15600
TSX CIT00,4 * GO COMPILE TIX *-1,TAG. F1B15610
PZE L(0),,L(TIX) LOC,,OP-DEC F1B15620
PZE PROCTR,,M1T ADR,,RA-TAG F1B15630
TSX CIT00,4 * GO COMPILE DED TAG. F1B15640
PZE L(0),,L(DED) LOC,,OP-DEC F1B15650
PZE L(0),,L(8) ADR,,RA-TAG F1B15660
DRMFIN TSX CIT00,4 * GO COMPILE CPY SYMBOL. F1B15670
PZE L(0),,L(CPY) LOC,,OP-DEC F1B15680
PZE SA,,RA ADR,,RA-TAG F1B15690
TRA RESET THEN GO RESET SL AND GTAG. F1B15700
REM NODIM / FOR SUBSCRIPTED VARIABLES OR SIMPLE VARIABLES. F1B15710
NODIM TSX IFFIX,1 * GO TEST TYPE OF VARIABLE, F1B15720
TRA *+3 AND IF FIXED POINT, F1B15730
TSX TET00,1 * GO ENTER VARIABLE IN EITHER F1B15740
INOUT PZE .. FORVAL OR FORVAR TABLE. F1B15750
CMASW2 NOP DRMFIN CONTINUE ABOVE IF DRUM. F1B15760
IOSW2 NOP CMAO CONTINUE BELOW IF OUTPUT. F1B15770
TSX CIT00,4 * GO COMPILE STR. F1B15780
PZE SL,,L(STR) LOC,,OP-DEC F1B15790
PZE L(0),,L(0) ADR,,RA-TAG F1B15800
TSX CIT00,4 * GO COMPILE STQ SYMBOL,TAG. F1B15810
PZE L(0),,L(STQ) LOC,,OP-DEC F1B15820
PZE SA,,RA ADR,,RA-TAG F1B15830
TRA RESET THEN GO RESET SL AND GTAG. F1B15840
CMAO TSX CIT00,4 * GO COMPILE LDQ SYMBOL,TAG. F1B15850
PZE SL,,L(LDQ) LOC,,OP-DEC F1B15860
PZE SA,,RA ADR,,RA-TAG F1B15870
TSX CIT00,4 * GO COMPILE STR. F1B15880
PZE L(0),,L(STR) LOC,,OP-DEC F1B15890
PZE L(0),,L(0) ADR,,RA-TAG F1B15900
RESET STZ SL CLEAR SYMBOLIC LOCATION. F1B15910
STZ GTAG CLEAR GENERALIZED TAG. F1B15920
CMASW TRA NXS * EXIT TO RPR OR SCAN. F1B15930
REM END CMA. F1B15940
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B15950
REM EMK / ENTRY FROM LIST SCAN ON ENDMARK. F1B15960
EMK TXH CMA1,2,6 * IF NO CHARACTERS REMAIN, THEN F1B15970
LXD DOLEV,4 CHECK PARENTHESIS COUNT, AND F1B15980
TXL *+2,4,0 IF TOO MANY LEFT PARENTHESIS, F1B15990
ER0050 TSX DIAG,4 * GO TO DIAGNOSTIC. F1B16000
REM ENDSW / ENTRY FROM SCAN ON NO LIST. F1B16010
ENDSW NOP FINI CONTINUE BELOW IF DRUM OR NO LIST. F1B16020
TSX SXD,2 * GO COMPILE SXD 6)+4,4. F1B16030
TSX LIB,4 * ENTER CLOSUB AND COMPILE TSX ..,4. F1B16040
PZE L(0),,L(TSX) LOC,,OP-DEC F1B16050
END PZE ..,,L(4) ADR,,RA-TAG F1B16060
REM FINI / ENTRY FROM BST. F1B16070
FINI TSX LXD,2 * GO COMPILE LXD 6)+4,4. F1B16080
CAL NOP RESET SWITCH F1B16090
STD LIST FOR LIST SCAN. F1B16100
TRA CHSIFN * EXIT TO REENTER PASS2. F1B16110
REM END EMK. F1B16120
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B16130
REM BEG,4 / BEGINNING SCAN. F1B16140
BEG SXA CMB,4 SAVE XR4. F1B16150
AXT BEGTR,4 SET CONTROL TRANSFER. F1B16160
TRA CXS * GO BEGIN SCAN. F1B16170
REM BEGTR / CONTROL TRANSFERS FOR BEGINNING SCAN = F1B16180
TRA NLS * ENDMARK (NO LIST SCAN) F1B16190
TRA *+8 ( (ILLEGAL CHARACTER IN I/O SETUP).F1B16200
TRA CMB * , F1B16210
TRA *+6 ) (ILLEGAL CHARACTER IN I/O SETUP).F1B16220
TRA *+5 = (ILLEGAL CHARACTER IN I/O SETUP).F1B16230
TRA *+4 - (ILLEGAL CHARACTER IN I/O SETUP).F1B16240
TRA *+3 / (ILLEGAL CHARACTER IN I/O SETUP).F1B16250
TRA *+2 . (ILLEGAL CHARACTER IN I/O SETUP).F1B16260
TRA *+1 + (ILLEGAL CHARACTER IN I/O SETUP).F1B16270
ER0051 TSX DIAG,4 * * (ILLEGAL CHARACTER IN I/O SETUP).F1B16280
BEGTR BSS 0 INDEXING ADDRESS FOR ABOVE LIST. F1B16290
REM END BEGTR. F1B16300
NLS CAL TRA IF ENDMARK IS MET, F1B16310
STD LIST SET SWITCH TO SKIP LIST SCAN. F1B16320
REM CMB / ENTRY FROM BEGINNING SCAN ON COMMA. F1B16330
CMB AXT ..,4 RESTORE XR4. F1B16340
REM TYP,4 / ENTRY FROM LPR, SPC, CMA. F1B16350
TYP CLA CHR-6 TEST FIRST CHARACTER F1B16360
SUB 12Z FOR VARIABLE F1B16370
TMI *+7 OR CONSTANT. F1B16380
TXH *+5,2,36 IF VARIABLE, F1B16390
PXD ,0 F1B16400
LDQ BLANKS ADD BLANKS F1B16410
LGL 42,2 IF SYMBOL CONTAINS F1B16420
ORS SYM LESS THAN 6 CHARACTERS, AND F1B16430
TRA 1,4 * TAKE VARIABLE EXIT TO CALLER. F1B16440
AXT 5,2 IF CONSTANT, F1B16450
CLA CHR-1,2 THEN F1B16460
SBN STO BIN CONVERT F1B16470
CSJ TXL BEX,2,.. BCD F1B16480
ALS 2 DIGITS F1B16490
ADD BIN TO THEIR F1B16500
ALS 1 BINARY F1B16510
STO BIN EQUIVALENT. F1B16520
CLA CHR,2 IF A NON-NUMERIC F1B16530
CAS L(9) CHARACTER IS MET, F1B16540
ER1003 TSX DIAG,4 * GO TO DIAGNOSTIC. F1B16550
NOP WHEN ALL F1B16560
ADD BIN DIGITS HAVE BEEN F1B16570
TXI SBN,2,-1 CONVERTED, F1B16580
BEX TRA 2,4 * TAKE CONSTANT EXIT TO CALLER. F1B16590
REM END BEG. F1B16600
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B16610
REM FORMAT,1 / PROCESS FORMAT DESIGNATION. F1B16620
FMTDSG TSX BEG,4 * GO SCAN FORMAT DESIGNATION. F1B16630
TRA FMTVAR IT IS A VARIABLE F1B16640
TNZ *+2 IT IS A CONSTANT F1B16650
ER0054 TSX DIAG,4 * GO TO DIAGNOSTIC IF MISSING OR ZERO F1B16660
STA SET IF F1B16670
SXA *+3,1 CONSTANT, F1B16680
TSX TET00,1 * GO ENTER IN F1B16690
PZE 17 FMTEFN TABLE. F1B16700
AXT ..,1 THEN F1B16710
AXT SET,4 PICKUP 8).. F1B16720
TRA FMTARG AND GO COMPILE FORMAT ARGUMENT. F1B16730
FMTVAR CAL SYM IF VARIABLE, F1B16740
SLW E+2 THEN F1B16750
TSX DIM1SR,4 * GO SEARCH F1B16760
TRA *+2 DIMENSION F1B16770
TRA FMTARG-1 TABLES, F1B16780
TSX DIM2SR,4 * AND IF F1B16790
TRA *+2 NO DIMENSION F1B16800
TRA FMTARG-1 HAS BEEN ASSIGNED TO F1B16810
TSX DIM3SR,4 * THIS FORMAT, THEN F1B16820
ER0053 TSX DIAG,4 * GO TO DIAGNOSTIC. F1B16830
AXT SYM,4 OTHERWISE, PICKUP VARIABLE AND F1B16840
FMTARG SXA FMTSA,4 SET FORMAT SYMBOLIC ADDRESS. F1B16850
TSX CIT00,4 * GO COMPILE FORMAT ARGUMENT. F1B16860
PZE L(0),,L(PZE) LOC,,OP-DEC F1B16870
FMTSA PZE ..,,L(0) ADR,,RA-TAG F1B16880
TRA 1,1 * EXIT TO CALLER. F1B16890
REM END FORMAT. F1B16900
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B16910
REM IFFIX,1 / TEST VARIABLE FOR FIXED OR FLOATING POINT. F1B16920
IFFIX CAL EIFNO PREPARE FOR F1B16930
STZ G FORVAR (5) F1B16940
STD G OR, F1B16950
CAL SYM FORVAL (6) F1B16960
SLW G+1 ENTRY. F1B16970
CAL CHR-6 PICKUP 1ST CHARACTER OF VARIABLE F1B16980
TRA TESTFX+1 * AND GO TEST FOR FIXED OR FLOATING. F1B16990
REM END IFFIX. F1B17000
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B17010
REM INPUT,2 / PROCESS CALLING SEQUENCE. ENTRY FROM TSH, TSB. F1B17020
INPUT AXT 6,1 PICKUP FORVAL DESIGNATION. F1B17030
CAL NOP PICKUP I/O SWITCH DESIGNATION. F1B17040
TRA *+3 CONTINUE BELOW. F1B17050
REM OUTPUT,2 / ENTRY FROM STH, STB. F1B17060
OUTPUT AXT 5,1 PICKUP FORVAR DESIGNATION. F1B17070
CAL TRA PICKUP I/O SWITCH DESIGNATION. F1B17080
STD IOSW1 SET I/O F1B17090
STD IOSW2 SWITCHES. F1B17100
CAL NOP PICKUP DRUM SWITCH DESIGNATION. F1B17110
REM DRUM,2 / ENTRY FROM SDR. F1B17120
DRUM SXA INOUT,1 SET FOR FORVAR/FORVAL ENTRY. F1B17130
STD CMASW1 SET F1B17140
STD CMASW2 DRUM F1B17150
STD ENDSW SWITCHES. F1B17160
REM TAPE,2 / ENTRY FROM BST. F1B17170
TAPE SXA TYPE,4 SET FIRST TSX ADDRESS. F1B17180
SXA *+2,2 SAVE XR2. F1B17190
TSX SXD,2 * GO COMPILE SXD 6)+4,4. F1B17200
AXT ..,2 RESTORE XR2. F1B17210
TSX LIB,4 * GO ENTER TYPE IN CLOSUB AND CIT. F1B17220
PZE L(0),,L(TSX) LOC,,OP-DEC F1B17230
TYPE PZE ..,,L(4) ADR,,RA-TAG F1B17240
STZ SL RESET SYMBOLIC LOCATION. F1B17250
TRA 1,2 * EXIT TO CALLER. F1B17260
REM END INPUT. F1B17270
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B17280
REM UNIT,4 / PROCESS UNIT AND DRUM ADDRESS DESIGNATION. F1B17290
UNIT SXA UNITX,4 SAVE XR4. F1B17300
TSX BEG,4 * GO BEGIN SCAN. F1B17310
TRA UNITV *VARIABLE UNIT DESIGNATION. F1B17320
TNZ *+2 IS UNIT DESIGNATION NON-ZERO. F1B17330
ER2002 TSX DIAG,4 *NO, EITHER ZERO OR MISSING. F1B17340
ALS 18 THEN F1B17350
STO G MAKE F1B17360
TSX FXCNIX,4 * FIXCON ENTRY F1B17370
ALS 18 AND F1B17380
STO RA SET RELATIVE ADDRESS, F1B17390
CAL I( AND SYMBOLIC ADDRESS F1B17400
SLW SYM FOR FIXCON TABLE. F1B17410
TRA DSW CONTINUE BELOW. F1B17420
UNITV TSX IFFIX,1 *IF VARIABLE IS FLOATING POINT, F1B17430
ER0055 TSX DIAG,4 * GO TO DIAGNOSTIC. F1B17440
TSX TET00,1 * ENTER FIXED POINT VARIABLE F1B17450
PZE 5 IN FORVAR. F1B17460
STZ RA RESET RELATIVE ADDRESS TO ZERO. F1B17470
DSW TSX GIF,4 * GO SET SYMBOLIC LOCATION, IF NEC. F1B17480
TSX CIT00,4 * GO COMPILE CAL. F1B17490
PZE SL,,L(CAL) LOC,,OP-DEC F1B17500
PZE SYM,,RA ADR,,RA-TAG F1B17510
STZ SL RESET SYMBOLIC LOCATION. F1B17520
UNITX AXT ..,4 RESTORE XR4. F1B17530
TRA 1,4 * EXIT TO CALLER. F1B17540
REM END UNIT. F1B17550
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B17560
REM I/OCON / CONSTANTS USED BY INPUT/OUTPUT TRANSLATOR = F1B17570
IOCON BSS 0 I/O CONSTANTS. F1B17580
(BST) BCI 1,(BST) I/O CONSTANT. F1B17590
(CSH) BCI 1,(CSH) I/O CONSTANT. F1B17600
(DRS) BCI 1,(DRS) I/O CONSTANT. F1B17610
(EFT) BCI 1,(EFT) I/O CONSTANT. F1B17620
(FIL) BCI 1,(FIL) I/O CONSTANT. F1B17630
(RLR) BCI 1,(RLR) I/O CONSTANT. F1B17640
(RTN) BCI 1,(RTN) I/O CONSTANT. F1B17650
(RWT) BCI 1,(RWT) I/O CONSTANT. F1B17660
(SCH) BCI 1,(SCH) I/O CONSTANT. F1B17670
(SDR) BCI 1,(SDR) I/O CONSTANT. F1B17680
(SLI) BCI 1,(SLI) I/O CONSTANT. F1B17690
(SLO) BCI 1,(SLO) I/O CONSTANT. F1B17700
(SPH) BCI 1,(SPH) I/O CONSTANT. F1B17710
(STB) BCI 1,(STB) I/O CONSTANT. F1B17720
(STH) BCI 1,(STH) I/O CONSTANT. F1B17730
(TSB) BCI 1,(TSB) I/O CONSTANT. F1B17740
(TSH) BCI 1,(TSH) I/O CONSTANT. F1B17750
(WLR) BCI 1,(WLR) I/O CONSTANT. F1B17760
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B17770
REM F1B17780
REM END OF I/O STATEMENT PROCESSORS. F1B17790
REM F1B17800
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B17810
EJECT F1B17820
REM PASS 2/4-PROCESS ARITHMETIC FORMULAS= F1B17830
REM F1B17840
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B17850
REM F1B17860
REM F1B17870
REM F1B17880
REM STATE B CONSISTS OF TWO PARTS....SCAN AND LEVEL ANALYSIS. F1B17890
REM THE SCAN IS LEFT TO RIGHT OVER THE SOURCE STATEMENT WHICH IS F1B17900
REM IN THE F REGION OF COMMON AND IS IN BCD. F1B17910
REM EACH FIXED POINT CONSTANT, FLOATING POINT CONSTANT, AND BCD F1B17920
REM ( HOLLERITH) ARGUMENT IN CALL NAME STATEMENTS ARE ENTERED IN F1B17930
REM TABLES AND GIVEN AN INTERNAL VARIABLE NAME. F1B17940
REM LEVEL ANALYSIS IS PREFORMED FOR EACH ELEMENT OF THE STATEMENTF1B17950
REM WHERE AN ELEMENT IS DEFINED AS A VARIABLE, FUNCTION NAME OR (F1B17960
REM AND THE OPERATOR WHICH PRECEDES IT. F1B17970
ARITH SLF TURN ALL LITES OFF. F1B17980
TRA ARITH1 CHECK MODE $F1B17990
STO SIG1IX-2 F1B18000
STZ ARGCTR CLEAR F1B18010
STZ CHSAVE X F1B18020
STZ 3LBAR X F1B18030
STZ NBAR X F1B18040
STZ CBAR X F1B18050
STZ ABAR X F1B18060
STZ FSTYPE X F1B18070
LXD 1BAR,4 SET NBAR=-1 F1B18080
SXD NBAR,4 X F1B18090
CAL E( SET ARERAS ' E( F1B18100
SLW ARERAS X F1B18110
TSX C0190X,4 SET FWA ' -F AND CHCTR ' 0 F1B18120
CAL TXHOP SET SWITCHES FOR LEFT SCAN. F1B18130
STP MS093 X F1B18140
STP MS310 X F1B18150
STP MS321 X F1B18160
MS010 CAL ADPLUS SET OP TO ADDITION F1B18170
MS030 SLW E+1 X F1B18180
STZ FNBITS CLEAR FUNCTION NAME INDICATOR F1B18190
STZ G CLEAR RECEIVING CELL. F1B18200
CLS L(0) SET E = -0 F1B18210
STO E X F1B18220
LXA L(6),2 SET IR2 FOR SIX CHARS. F1B18230
MS040 CAL CHSAVE CHAR IN CHSAVE, IF ANY, TO AC. F1B18240
TNZ MS041 X F1B18250
TSX C0190,4 CHSAVE EMPTY, GET NEXT CHAR. F1B18260
MS041 CAS L(9) IS CHAR. NUMERIC. F1B18270
TRA MS050 N/, TAKE TRA F1B18280
MS4007 TXH CM4100,0,0 F1B18290
LXA MODECL,4 GET SPECIAL MODE INDICATION. F1B18300
TXH MS0415,4,18 TEST FOR HIGHER THAN B. F1B18310
TXL MS0415,4,17 TEST FOR LOWER THAN B. F1B18320
NXTOCT CAS L(8) BOOLEAN MODE, CONSTANT MUST BE OCTAL. F1B18330
TRA ER1005 9 IS ERROR F1B18340
TRA ER1005 8 IS ERROR F1B18350
STO CHSAVE F1B18360
CAL G GET PREVIOUS OCTAL SUM. F1B18370
CAS MAXIMA TEST FOR MORE THAN 12 DIGITS. F1B18380
OCTERR TSX DIAG,4 YES, GO TO DIAGNOSTIC F1B18390
NOP F1B18400
ALS 3 MULTIPLY BY 8 AND F1B18410
ADD CHSAVE ADD CURRENT DIGIT. F1B18420
SLW G SAVE RESULT. F1B18430
TSX C0190,4 GET NEXT NON-BLANK CHARACTER. F1B18440
CAS L(9) TEST FOR NUMERIC F1B18450
TRA NOTOCT NO, PREPARE TO ENTER IN TABLE. F1B18460
TRA ER1005 9 IS ERROR. F1B18470
TRA NXTOCT OCTAL, CONTINUE. F1B18480
NOTOCT STO CHSAVE SAVE FOR RESUMPTION OF SCAN. F1B18490
TSX FLCNIX,4 ENTER CONSTANT IN FLOCON TABLE. F1B18500
ORA FLOVAR PREFACE POSITION WITH FLOCON LABEL. F1B18510
SLW E+2 F1B18520
TRA LATXH NOW GO TO LEVEL ANALYSIS WITH INTERNAL NAMEF1B18530
MS0415 TSX ROYCNV,4 X F1B18540
TRA HOLL RETURN 1, THIS WAS HOLLERITH. F1B18550
TRA LATXH THIS WAS FIXED OR FLOATING CONSTANT. F1B18560
REM DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B18570
MS050 CAS OPEN IS 1ST CHAR. ( F1B18580
TRA MS0501 NO F1B18590
TRA ICNV2 YES F1B18600
TRA MS0501 NO F1B18610
ICNV2 CAL MODECL TEST FOR I IN CC ONE WHICH MEANS COMPLEX F1B18620
SUB L(I) ARITHMETIC MODE. POSSIBILITY THAT WHAT F1B18630
TZE ICNV3 FOLLOWS IS A COMPLEX CONSTANT. F1B18640
ICNV6 CAL OPEN NOT A COMPLEX CONSTANT, RESTORE ( AND F1B18650
MS0501 LXA TEN,4 PREPARE TO TEST FOR PUNCTUATION. F1B18660
REM F1B18670
MS051 CAS CTEST,4 F1B18680
TRA MS052 X F1B18690
TRA MS090 CHAR IS SOME PUNCTUATION. F1B18700
MS052 TIX MS051,4,1 X F1B18710
MS060 ALS 36,2 POSITION CHAR FOR BUILDING SYMBOL. F1B18720
ORS G ADD CHAR TO THOSE IN G. F1B18730
TXI MS061,2,6 UPDATE POSITIONING TAG. F1B18740
MS061 TSX C0190,4 GET NEXT CHAR. F1B18750
MS070 LXA TEN,4 PREPARE TO TEST FOR PUNCTUATION. F1B18760
MS071 CAS CTEST,4 X F1B18770
TRA MS072 X F1B18780
TRA MS091 CHAR IS SOME PUNCTUATION. F1B18790
MS072 TIX MS071,4,1 X F1B18800
TXL MS060,2,18 IF THIS IS CHAR 1, 2 /R 3 GO BUILD G. F1B18810
CAS L(F) IS THIS AN F ENDING FUNCTION NAME. F1B18820
TRA MS073 X F1B18830
TRA MS080 MAYBE, GO LOOK AT NEXT CHAR. F1B18840
MS073 TXL MS060,2,36 TEST FOR UNDER 7 CHARS. F1B18850
MS074 TSX DIAG,4 BUILD G, 7TH CHAR IS ERROR. F1B18860
ER0056 SYN MS074 F1B18870
MS080 TSX C0190,4 GET NEXT CHAR. F1B18880
CAS OPEN TEST FOR (. F1B18890
TRA MS081 X F1B18900
TRA MS092 YES, THIS IS A FUNCTION NAME. F1B18910
MS081 STO FIRSTC NO, SAVE CURRENT CHAR. F1B18920
CAL L(F) ADD F TO CONTENTS OF G. F1B18930
ALS 36,2 X F1B18940
ORS G X F1B18950
TXH MS074,2,36 TEST FOR 7TH CHAR, YES IS ERROR. F1B18960
CLA FIRSTC RESTORE CURRENT CHAR. F1B18970
TXI MS070,2,6 UPDATE POSITIONING TAG. F1B18980
MS090 STZ CHSAVE CLEAR F1B18990
TRA TRBLKA,4 F1B19000
MS091 SLW CHSAVE OP IS IN NEXT ELEMENT, SAVE. F1B19010
PXD ,0 F1B19020
LDQ BLANKS COMPLETE VARIABLE NAMES LESS THAN SIX CHAR-F1B19030
LGL 42,2 ACTERS WITH BCD BLANKS. F1B19040
ORS G X F1B19050
LDQ G MOVE G TO E+2 AND TO G+1. F1B19060
STQ E+2 X F1B19070
STQ G+1 X F1B19080
TRA TRBLKB,4 NOW BRANCH TO INDIVIDUAL ROUTINE F1B19090
MS092 PXD ,0 CLEAR F1B19100
LDQ BLANKS ADD BLANKS TO SUBROUTINE NAME IN G. F1B19110
LGL 42,2 X F1B19120
ORA G X F1B19130
SLW G X F1B19140
SLW E+2 MOVE FUNCTION NAME TO E+2. F1B19150
STZ CHSAVE CLEAR OUT FIRST CHAR OF FUNCTION NAME. F1B19160
MS093 PZE MS335,,0 TXH FOR LEFT SIDE, TXL FOR RIGHT SIDE. F1B19170
LXD BK,4 THIS IS ARITH FUNCTION STATEMENT. F1B19180
TXL *+8,4,0 TEST FOR FIRST ENTRY AND IF SO SKIP SEARCH.F1B19190
SXD *+6,4 SET EXIT TEST FROM SEARCH LOOP. F1B19200
LXA L(0),2 SET FOR FORWARD SEARCH. F1B19210
LAS FORSUB,2 COMPARE NAME OF CURRENT FORTRAN FUNCTION F1B19220
TXI *+3,2,-2 TO ALL NAMES PREVIOUSLY ENTERED IN FORSUB F1B19230
ER0057 TSX DIAG,4 TABLE. IF FOUND THIS IS AN ERROR, GO TO F1B19240
TXI *+1,2,-2 DIAGNOSTIC. F1B19250
TXH *-4,2,** F1B19260
SLW FORSUB,4 ENTER FUNCTION NAME IN FORSUB TABLE. F1B19270
CAL EIFNO ENTER INTERNAL FORMULA NO IN FORSUB. F1B19280
ANA MASK1 X F1B19290
STO FORSUB+1,4 X F1B19300
TXI FS010,4,-2 UPDATE COUNT OF ENTRIES IN FORSUB. F1B19310
FS010 SXD BK,4 X F1B19320
TXH FS020,4,-2*FRSBSZ TEST FOR FORSUB OVERFLOW. F1B19330
ER0058 TSX DIAG,4 TABLE EXCEEDED, GO TO DIAGNOSTIC ROUTINE. F1B19340
FS020 TSX C0190,4 GET FIRST CHAR OF ARGUMENT. F1B19350
CAS EQUAL TEST FOR EQUAL. F1B19360
TRA FS030 X F1B19370
TRA MS322 GO MOVE FROM E, E+1, E+2 TO LEFT, LEFT+1,+2F1B19380
FS030 CAS L(9) TEST FOR ILLEGAL ARGUMENT. F1B19390
TRA FS040 LEGAL, CONTINUE F1B19400
MS9002 TXH CM4200,0,0 F1B19410
ER0059 TSX DIAG,4 BEGINS NUMERIC, ERROR. F1B19420
FS040 TSX C0160,2 COLLECT ARGUMENT NAME IN 1G. F1B19430
TSX TESTB0,4 TEST CHAR FOLLOWING ARG FOR , OR) F1B19440
LXD ARGCTR,2 GET COUNT OF ARGUMENTS F1B19450
LDQ 1G ENTER ARGUMENT NAME IN ARGREG TABLE. F1B19460
STQ ARGREG,2 X F1B19470
TXI FS050,2,-1 UPDATE COUNT OF ARGUMENTS. F1B19480
FS050 SXD ARGCTR,2 F1B19490
TXH FS020,2,-RGRGSZ TEST FOR ARGREG TABLE OVERFLOW. F1B19500
ER0060 TSX DIAG,4 YES, ERROR. F1B19510
MS200 LXA MODECL,4 GET SPECIAL MODE INDICATION. F1B19520
TXH MS2001,4,18 TEST FOR GREATER THAN B. F1B19530
TXL MS2001,4,17 TEST FOR LESS THAN B F1B19540
TRA ER1005 BOOLEAN MEANS ERROR, GO TO DIAGNOSTIC. F1B19550
MS2001 TSX DECPNT,4 CONVERT BCD NUMBER TO BINARY F1B19560
ER0061 TSX DIAG,4 HOLLERITH RETURN, ERROR. F1B19570
TRA LATXH FLOATING POINT CONSTANT RETURN. F1B19580
MS210 SLN 1 TURN , LITE ON. F1B19590
LXD 3LBAR,1 PREFORM LEVEL ANALYSIS FOR , F1B19600
LXD ABAR,4 F1B19610
CLS ALPHA-4,4 F1B19620
STO LAMBDA,1 F1B19630
TRA CMPCH $F1B19640
SLW LAMBDA+1,1 F1B19650
CLA NBAR F1B19660
ARS 18 F1B19670
STO LAMBDA+2,1 F1B19680
TXI MS211,1,-3 F1B19690
MS211 SXD 3LBAR,1 F1B19700
LXD NBAR,1 F1B19710
SXD CBAR,1 F1B19720
TXI MS212,1,-1 F1B19730
MS212 SXD NBAR,1 F1B19740
TXI MS213,4,3 F1B19750
MS213 SXD ABAR,4 F1B19760
TRA MS010 F1B19770
MS220 LXD ABAR,4 PREFORM LEVEL ANALYSIS FOR ) F1B19780
CLA ALPHA-4,4 F1B19790
PAX ,1 F1B19800
SXD CBAR,1 F1B19810
TXI MS221,4,4 F1B19820
MS221 SXD ABAR,4 F1B19830
TRA MS020 F1B19840
MS230 LXD ABAR,4 PREFORM LEVEL ANALYSIS FOE ENDMK. F1B19850
TXI MS231,4,3 F1B19860
MS231 TXL MS232,4,0 FINISHED, HAS LEVEL BEEN REDUCED TO ZERO, F1B19870
ER0062 BSS 0 F1B19880
TSX DIAG,4 NO, ERROR. F1B19890
MS232 LXD ARGCTR,4 WAS THIS AN ARITH FUNCTION STATEMENT F1B19900
TXL R00000,4,0 F1B19910
CAL FSTYPE YES, UPDATE FUNCTION TYPE AND F1B19920
ADD L(1) COMPLETE FORSUB ENTRY BY ASSIGNING F1B19930
LXD BK,1 TYPE NUMBER. F1B19940
STA FORSUB-1,1 X F1B19950
ORS ARERAS ALSO SAVE FOR LATER REFERENCE. F1B19960
TRA R00000 F1B19970
TRA MS230 ENDMK F1B19980
TRA MS260 ( F1B19990
TRA MS210 , F1B20000
TRA MS220 ) F1B20010
ER0063 BSS 0 F1B20020
MSERR TSX DIAG,4 = F1B20030
TRA MS250 - F1B20040
TRA MS250 / F1B20050
TRA MS200 . F1B20060
TRA MS250 + F1B20070
MS240 ALS 30 * SAVE * F1B20080
TRBLKA BSS 0 F1B20090
SLW E+1 X F1B20100
TRA MS239 CHECK FOR RIGHT SIDE OF = SIGN (29)F1B20110
CAS STAR IS IT * F1B20120
TRA MS041 X F1B20130
TRA MS241 YES, THIS WAS ** F1B20140
TRA MS041 NO, GO COMPARE TO OTHER PUNCTUATION. F1B20150
MS241 CAL STRSTR REPLACE * WITH ** F1B20160
TRA MS251 X F1B20170
MS250 ALS 30 POSITION CHAR WHICH IS + OR - OR / F1B20180
MS251 SLW E+1 PUT CURRENT OP IN E+1. F1B20190
TRA MS238 CHECK FOR RIGHT SIDE OF = SIGN (29)F1B20200
MS260 ALS 30 ( TO SYMBOL WORD F1B20210
SLW E+2 X F1B20220
TRA LATXL GO PREFORM LEVEL ANALYSIS FOR ( F1B20230
TRA MS300 ENDMK F1B20240
TRA MS320 ( F1B20250
TRA MS300 , F1B20260
TRA MS300 ) F1B20270
TRA MS310 = F1B20280
TRA MS300 - F1B20290
TRA MS300 / F1B20300
ER0064 TSX DIAG,4 . F1B20310
TRA MS300 + F1B20320
MS300 PXD ,0 * CLEAR F1B20330
TRBLKB BSS 0 BASE ADDRESS FOR TAGGED TRANSFER. F1B20340
LGL 6 GET FIRST CHAR OF SYMBOL. F1B20350
TSX TESTFX+1,1 TEST FOR FIXED OR FLOATING POINT. F1B20360
REM DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B20370
TRA DP002 F1B20380
REM F1B20390
CAL EIFNO FIXED, PREPARE FORVAR ENTRY. F1B20400
ANA MASK1 X F1B20410
SLW G X F1B20420
TSX TET00,1 MAKE FORVAR ENTRY. F1B20430
5 X F1B20440
TRA LATXL GO PREFORM LEVEL ANALYSIS. F1B20450
REM DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B20460
REM ENTER NON-SUBSCRIPTED VARIABLES ON RIGHT OF = IN DPLIST. F1B20470
DP002 CLA MODECL F1B20480
SUB L(D) F1B20490
TZE MDLST2 F1B20500
ITEST1 SUB L(5) F1B20510
TNZ LATXL F1B20520
MDLST2 TSX DLIST2,4 ENTER NAME IN LIST OF DP OR I NON SUBSCRIPTE F1B20530
TRA LATXL VARIABLES. F1B20540
REM F1B20550
MS320 STZ CHSAVE CLEAR CELL FOR OP. F1B20560
MS321 PZE MS330,,0 TXH ON LEFT, TXL ON RIGHT OF = SIGN. F1B20570
TSX DIM1SR,4 THIS NAME FOLLOWED BY A ( CANNOT BE A F1B20580
TRA *+2 FUNCTION REFERENCE ON THE LEFT OF = SIGN.F1B20590
TRA MS321A THEREFORE IT MUST BE A SUBSCRIPTED VARIABLEF1B20600
TSX DIM2SR,4 AND ITS NAME MUST BE IN ONE OF THE DIMEN- F1B20610
TRA *+2 SION TABLES. SEARCH THESE TABLES AND IF THEF1B20620
TRA MS321A NAME IS NOT IN ANY ONE OF THEM CALL THE F1B20630
TSX DIM3SR,4 DIAGNOSTIC ROUTINE TO PRINT AN ERROR MES- F1B20640
ER0072 TSX DIAG,4 SAGE. F1B20650
MS321A TSX SS000X,4 GO PROCESS SUBSCRIPT COMBINATION. F1B20660
TSX C0190,4 GET NEXT CHAR. F1B20670
SUB EQUAL TEST FOR EQUAL SIGN. F1B20680
TNZ MSERR NO, ERROR. F1B20690
MS322 LXA L(3),4 MOVE CONTENTS OF E WORDS TO LEFT WORDS. F1B20700
MS323 LDQ E+3,4 X F1B20710
STQ LEFT+3,4 X F1B20720
TIX MS323,4,1 X F1B20730
MS311 CAL TXLOP SET SWITCHES FOR RIGHT SIDE SCAN. F1B20740
STP MS093 X F1B20750
STP MS310 X F1B20760
STP MS321 X F1B20770
SLN 1 TURN = OR ) LITE ON. F1B20780
TRA MS010 GO SCAN NEXT ELEMENT. F1B20790
MS310 PZE MSERR,,0 TXH ON LEFT, TXL ON RIGHT OF = SIGN. F1B20800
STZ CHSAVE CLEAR F1B20810
MS325 PXD ,0 CLEAR AC. F1B20820
LGL 6 GET FIRST CHAR OF SYMBOL. F1B20830
TSX TESTFX+1,1 TEST FOR FIXED OR FLOATING POINT F1B20840
REM DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B20850
TRA DP003 F1B20860
REM F1B20870
CAL EIFNO FIXED, PREPARE FORVAL ENTRY. F1B20880
ANA MASK1 X F1B20890
SLW G X F1B20900
TSX TET00,1 MAKE FORVAL ENTRY. F1B20910
6 X F1B20920
TRA MS322 F1B20930
REM F1B20940
REM ENTER NON-SUBSCRIPTED VARIABLES ON LEFT OF = IN DPLIST. F1B20950
DP003 CLA MODECL F1B20960
SUB L(D) F1B20970
TZE *+3 F1B20980
SUB L(5) F1B20990
TNZ MS322 F1B21000
REM F1B21010
REM PREVENT ENTRY OF QUASI-ARITHMETIC SYMBOLS FOR IF AND CALL F1B21020
CLA E+2 F1B21030
CAS IFSYM2 F1B21040
TRA *+2 F1B21050
TRA MS322 IF (...) STATEMENT, DO NOT ENTER F1B21060
SUB CALLSM F1B21070
TZE MS322 CALL NAME( ARG,...) STATEMENT, DO NOT ENTERF1B21080
MDLST3 TSX DLIST2,4 NEITHER, ENTER VARIABLE IN DLST2 F1B21090
TRA MS322 F1B21100
REM F1B21110
REM F1B21120
MS330 TSX DIM1SR,4 SEARCH FOR THIS NAME IN THE DIM1, DIM2, F1B21130
TRA MS331 AND DIM3 TABLES. IF IT IS FOUND IN ONE OF F1B21140
TRA MS333 THESE TABLES IT IS A SUBSCRIPTED VARIABLE F1B21150
MS331 TSX DIM2SR,4 OF THAT NUMBER OF DIMENSIONS. IF IT IS NOT F1B21160
TRA MS332 FOUND IN ANY DIMENSION TABLE THEN IT IS F1B21170
TRA MS333 ASSUMED TO BE THE NAME OF A FORTRAN II F1B21180
MS332 TSX DIM3SR,4 SUBROUTINE OR FUNCTION COMPILED SEPARATELY.F1B21190
TRA MS334 X F1B21200
MS333 TSX SS000X,4 GO PROCESS SUBSCRIPT COMBINATION. F1B21210
TRA LATXH GO PREFORM LEVEL ANALYSIS. F1B21220
MS334 CAL FNIND NOT FOUND, TREAT AS FUNCTION NAME. F1B21230
SLW FNBITS X F1B21240
TSX TET00,1 ENTER NAME IN CLOSUB TABLE. F1B21250
9 X F1B21260
MS335 SLN 2 TURN FUNCTION LITE ON. F1B21270
TRA LATXL GO PREFORM LEVEL ANALYSIS. F1B21280
HOLL STZ CHSAVE CLEAR CHSAVE F1B21290
CAL HOLCNT GET CURRENT H(+I WORD F1B21300
SLW E+2 F1B21310
LXA N,2 GET NUMBER OF CHARACTERS IN THIS ARG F1B21320
LXA XCHCTR,4 GET CURRENT RESIDU CHARACTER COUNT. F1B21330
LDQ RESIDU GET CURRENT RESIDU WORD F1B21340
C3351 LXA L(6),1 SET TO COLLECT SIX CHARS F1B21350
PXD 0,0 CLEAR AC F1B21360
C3352 TNX C3354,4,1 TEST FOR NO MORE CHARS IN RESIDU F1B21370
C33525 LGL 6 GET NEXT CHAR F1B21380
SLW 1G STORE WORD F1B21390
ANA ENDMK BLANK ALL EXCEPT CURRENT CHAR F1B21400
SUB ENDMK TEST FOR INTERNAL ENDMK F1B21410
TNZ C3353 F1B21420
ER0065 TSX DIAG,4 YES, ERROR, GO TO DIAGNOSTIC. F1B21430
C3353 CAL 1G RETREIVE WORD F1B21440
TNX C3358,2,1 TEST FOR ALL CHARS COLLECTED F1B21450
TNX C3356,1,1 TEST FOR SIX CHARS COLLECTED F1B21460
TRA C3352 NOT SIX CHARS YET, CONTINUE COLLECTINGF1B21470
C3354 LXD FWA,4 LOAD MQ WITH NEXT F REGION WORD F1B21480
LDQ 0,4 F1B21490
TXI C3355,4,-1 UPDATE FWA F1B21500
C3355 SXD FWA,4 F1B21510
LXA L(6),4 RESET MQ CHAR COUNT TO SIX F1B21520
TRA C33525 CONTINUE COLLECTING F1B21530
C3356 TSX C3390,1 GO TO ENTER WORD IN HOLARG TABLE F1B21540
C3357 TXI C3351,0,** RETURN TO CONTINUE COLLECTING F1B21550
C3358 STQ RESIDU UPDATE RESIDU F1B21560
SXA XCHCTR,4 UPDATE CHARACTER COUNT. F1B21570
TNX C3360,1,1 TEST FOR SIX CHARS IN AC, DEC IR1 F1B21580
LDQ BLANKS NOT SIX CHARS, PREPARE TO ADD BLANKS F1B21590
C3359 LGL 6 ADD BLANKS F1B21600
TIX C3359,1,1 F1B21610
C3360 TSX C3390,1 GO TO ENTER WORD IN HOLARG TABLE F1B21620
CAL ALL1 GET WORD OF ONES F1B21630
TSX C3390,1 GO TO ENTER WORD IN HOLARG TABLE F1B21640
REM LEVEL ANALYSIS F1B21650
LATXL CAL TXLOP F1B21660
TRA LATXL+3 F1B21670
LATXH CAL TXHOP F1B21680
STP CM4105 F1B21690
CLA MS093 GET LEFT-RIGHT SWITCH FROM SCAN AND F1B21700
TMI *+2 TEST FOR LEFT SIDE OF EQUAL SIGN. F1B21710
ER0073 TSX DIAG,4 YES IS ERROR, GO TO DIAGNOSTIC. F1B21720
LA0000 LXA L(0),1 F1B21730
CLA E+2 F1B21740
SLT 2 IS THIS A FUNCTION NAME F1B21750
TRA LA0000+36 NO F1B21760
SLN 2 YES - TURN F LITE BACK ON F1B21770
LXD BK,4 IS FORSUB EMPTY F1B21780
TXL LA0000+13,4,0 YES. GO SET FS BITS TO 0 F1B21790
SXD LA0000+12,4 F1B21800
CAS FORSUB,1 SEARCH FN NAME IN FORSUB F1B21810
TXI LA0000+12,1,-2 F1B21820
TRA LA0000+15 F1B21830
TXI LA0000+12,1,-2 F1B21840
TXH LA0000+8,1,0 F1B21850
STZ FSBITS SET FSBITS TO 0 F1B21860
TRA LA0000+25 F1B21870
CAL FORSUB+1,1 FN NAME IN FORSUB F1B21880
ANA MASK2 EXTRACT TYPE NUMBER F1B21890
LXD ARGCTR,4 IS THIS A FUNCTION STATEMENT F1B21900
TXL LA0000+22,4,0 NO F1B21910
CAS FSTYPE YES - UPDATE FS TYPE F1B21920
STA FSTYPE F1B21930
TXH 0,0,0 F1B21940
ALS 7 F1B21950
ORA FSIND F1B21960
SLW FSBITS F1B21970
LXD 3LBAR,1 LOAD LA COUNTERS F1B21980
LXD NBAR,2 F1B21990
LXD ABAR,4 F1B22000
TXL LA0003,1,0 F1B22010
TXH LA0001,1,-LAMBSZ F1B22020
ER0066 TSX DIAG,4 ERROR..LAMBDA TABLE EXCEEDED. F1B22030
LA0001 TXH LA0002,2,-BETASZ-1 F1B22040
ER0067 TSX DIAG,4 ERROR..BETA TABLE EXCEEDED F1B22050
LA0002 TXL LA0003,4,0 F1B22060
TXH LA0003,4,-ALPHSZ F1B22070
ER0068 TSX DIAG,4 ERROR..ALPHA TABLE EXCEEDED F1B22080
LXD ARGCTR,4 VARIABLE OR ( F1B22090
TXL LA0000+13,4,0 NOT AN FS - GO SET FS BITS TO 0 F1B22100
SXD LA0000+43,4 FUNCTION STATEMENT F1B22110
CAS ARGREG,1 SEARCH ARGUMENT (DUMMY VARIABLE) TABLE F1B22120
TXI LA0000+43,1,-1 F1B22130
TRA MS1018 F1B22140
TXI LA0000+43,1,-1 F1B22150
TXH LA0000+39,1,0 F1B22160
TRA LA0000+13 NOT PRESENT - GO SET FSBITS TO 0 F1B22170
MS1018 PXD 0,1 PRESENT - STORE TYPE IN FSBITS F1B22180
ARS 11 F1B22190
TRA LA0000+23 F1B22200
LA0003 CLA MS9002 =CM4200 ENTRY TO COUNTER ROUTINE F1B22210
STA LA4320 F1B22220
PXD 0,0 F1B22230
LDQ E+2 INITIALIZE ALL POSSIBLE OPERAND APPEARANCESF1B22240
STQ LAMBDA+11,1 F1B22250
STQ LAMBDA+8,1 F1B22260
STQ LAMBDA+5,1 F1B22270
LGL 6 F1B22280
STO FIRSTC F1B22290
SUB OPEN F1B22300
TZE LA003 F1B22310
CLA MS4007 F1B22320
SLT 2 FUNCTION LITE F1B22330
TRA LA002 F1B22340
SLN 2 F1B22350
CLA FINI03 F1B22360
LA002 STA LA4320 F1B22370
LA003 CLA E F1B22380
STO LAMBDA+9,1 F1B22390
STO LAMBDA+6,1 F1B22400
STO LAMBDA+3,1 F1B22410
CAL ADSPOP F1B22420
SLW LAMBDA+13,1 F1B22430
SLW LAMBDA+10,1 F1B22440
SLW LAMBDA+7,1 F1B22450
PXD ,0 F1B22460
LDQ E+1 OP CODE F1B22470
STQ LAMBDA+1,1 F1B22480
LGL 6 BRANCH ON OP CODE F1B22490
CAS STAR F1B22500
TRA LA0015 / SIGN F1B22510
TRA LA0010 * OR ** SIGN F1B22520
SLT 2 + OR - SIGN F1B22530
TRA LA0044 F1B22540
TXI MS1033,2,-3 -N TO -(N+3) F1B22550
MS1033 PXD ,2 OP IS FUNCTION F1B22560
ARS 18 F1B22570
STO LAMBDA+14,1 STO (N+3) IN LAMBDA+3 (L+4)+2 F1B22580
TXI FINI03,2,1 -(N+3) TO - (N+2) F1B22590
FINI03 PXA CM4300,2 F1B22600
SSM F1B22610
STO LAMBDA+12,1 STO -(N+2) IN LAMBDA+3 (L+4) F1B22620
LA0041 SLT 1 F1B22630
TXI L43130,2,1 BINARY -(N+2) TO -(N+1) F1B22640
TXI L13130,2,1 UNARY F1B22650
LA0044 CLA FIRSTC +OR-DATA OR OPEN PAREN F1B22660
CAS OPEN EXAMINE SYMBOL F1B22670
TRA LA0050 F1B22680
TXI LA0058,2,-3 -N TO -(N+3) F1B22690
LA0050 SLT 1 DATA F1B22700
TXI LA4000,2,-1 BINARY -(N) TO-(N+1) F1B22710
TXI LA1000,2,-1 UNARY -(N) TO -(N+1) F1B22720
LA0058 PXA ,2 +OR-OPEN PAREN F1B22730
STO LAMBDA+11,1 STO S(N+3) IN LAMBDA +3(L+3)+2 F1B22740
ADD L(1) FORM -(N+2) IN ADD (ACC) F1B22750
TXI LA0041,2,1 F1B22760
LA0010 TQP LA0015 GO TO * ROUTINE F1B22770
SLT 2 ** F1B22780
TRA LA0072 F1B22790
TXI L23000,2,-1 -N TO -(N+1) F1B22800
LA0072 CLA FIRSTC F1B22810
SUB OPEN F1B22820
TNZ LA2000 F1B22830
TXI L22000,2,-1 -N TO -(N+1) F1B22840
LA0015 SLT 2 * OR / F1B22850
TRA LA0021 F1B22860
TXI L33000,2,-2 -N TO -(N+2) F1B22870
LA0021 CLA FIRSTC F1B22880
CAS OPEN F1B22890
TXI LA3000,2,-1 F1B22900
TXI L32000,2,-2 -N TO -N(+2) F1B22910
TXI LA3000,2,-1 F1B22920
L13130 SLW ALPHA+3,4 STO -(N+2) IN ALPHA+A+3 F1B22930
CLS L(0) F1B22940
STO LAMBDA+9,1 STO -0 IN LAMBDA +3(L+3) F1B22950
SLN 1 F1B22960
LA1000 CLS CBAR UNARY + OR - DATA F1B22970
ARS 18 F1B22980
SLW ALPHA,4 STO -C IN ALPHA+A F1B22990
TXI LA1040,4,-3 -A TO - (A+3) F1B23000
LA1040 SXD ABAR,4 F1B23010
TRA LA4010 F1B23020
L22000 PXA ,2 ** OPEN PAREN F1B23030
STO LAMBDA+5,1 STO S(N+1) IN LAMBDA+3(L+1)+2 F1B23040
ADD L(1) F1B23050
TXI L23130,2,1 -(N+1) TO -N F1B23060
L23000 PXA ,2 ** FUNCTION F1B23070
STO LAMBDA+8,1 STO S(N+1) IN LAMBDA+3(L+2)+2 F1B23080
ADD L(1) F1B23090
SSM F1B23100
TXI L23090,2,1 -(N+1) TO -N F1B23110
L23090 STO LAMBDA+6,1 STO -N IN LAMBDA+3(L+2) F1B23120
L23130 SLW ALPHA,4 STO -N IN ALPHA +A F1B23130
CLS L(0) F1B23140
STO LAMBDA+3,1 STO -0 IN LAMBDA+3(L+1) F1B23150
SLN 1 F1B23160
LA2000 CLS ALPHA-1,4 ** DATA F1B23170
STO LAMBDA,1 F1B23180
CLA NBAR F1B23190
TXI LA4180,1,6 F1B23200
L43130 SLW ALPHA,4 STO -(N+2) IN ALPHA+A F1B23210
CLS L(0) F1B23220
STO LAMBDA+9,1 STO -0 IN LAMBDA+3(L+3) F1B23230
SLN 1 F1B23240
LA4000 CLS ALPHA-3,4 F1B23250
LA4010 STO LAMBDA,1 STO C(ALPHA+A-3) IN LAMBDA+3L F1B23260
CLS NBAR F1B23270
ARS 18 F1B23280
SLW ALPHA-2,4 STO-N IN ALPHA+A-2 F1B23290
SLW LAMBDA+2,1 STO S(N) IN LAMBDA+3L+2 F1B23300
STO LAMBDA+3,1 STO -N IN LAMBDA+3(L+1) F1B23310
PXA ,2 F1B23320
STO LAMBDA+5,1 STO S(N+1) IN LAMBDA+3(L+1)+2 F1B23330
STO ALPHA-1,4 STO-(N+1) IN ALPHA+A-1 F1B23340
SSM F1B23350
STO LAMBDA+6,1 STO -(N+1) IN LAMBDA+3(L+2) F1B23360
TXI LA4150,2,-1 -(N+1) TO -(N+2) F1B23370
LA4150 CAL ADSTAR F1B23380
SLW LAMBDA+4,1 STO * IN LAMBDA+3(L+1)+1 F1B23390
LA4170 PXD ,2 F1B23400
LA4180 ARS 18 F1B23410
STO LAMBDA+8,1 STOS(N+2) IN LAMBDA+3(L+2)+2 F1B23420
ORS LAMBDA+9,1 STO -(N+2) IN LAMBDA+3(L+3) F1B23430
CAL STRSTR F1B23440
SLW LAMBDA+7,1 STO SPOP IN LAMBDA+3(L+2)+1 F1B23450
CAL ADSPOP F1B23460
ORA FSBITS F1B23470
ORA FNBITS F1B23480
SLW LAMBDA+10,1 STO SPOP IN LAMBDA+3(L+3)+1 F1B23490
LA4320 TXI **,1,-9 F1B23500
L32000 PXA ,2 */ OPEN PAREN F1B23510
STO LAMBDA+8,1 STO 5(N+2) IN LAMBDA+3(L+2)+2 F1B23520
ADD L(1) F1B23530
TXI L33130,2,1 -(N+2) TO -(N+1) F1B23540
L33000 PXA ,2 */ FUNCTION F1B23550
STO LAMBDA+11,1 STO S(N+2) IN LAMBDA+3(L+3)+2 F1B23560
ADD L(1) F1B23570
SSM F1B23580
TXI L33090,2,1 -(N+2) TO -(N+1) F1B23590
L33090 STO LAMBDA+9,1 STO -(N+1) IN LAMBDA+3(L+3) F1B23600
L33130 SLW ALPHA,4 STO -(N+1) IN ALPHA+A F1B23610
CLS L(0) F1B23620
STO LAMBDA+6,1 F1B23630
SLN 1 F1B23640
LA3000 CLS ALPHA-2,4 */ DATA F1B23650
STO LAMBDA,1 STO C(ALPHA+A-2) IN LAMBDA+3L F1B23660
CLS NBAR F1B23670
ARS 18 F1B23680
SLW ALPHA-1,4 STO -N IN ALPHA+A-1 F1B23690
SLW LAMBDA+2,1 STO S(N) IN LAMBDA+3L+2 F1B23700
STO LAMBDA+3,1 STO -N IN LAMBDA+3(L+1) F1B23710
TXI LA4170,1,3 F1B23720
CM4100 TXI CM4101,1,-3 LA COUNTER MODIFICATION ROUTINES F1B23730
CM4101 SXD 3LBAR,1 F1B23740
CM4102 SXD CBAR,2 F1B23750
TXI CM4104,2,-1 F1B23760
CM4104 SXD NBAR,2 F1B23770
CM4105 PZE MS010,,0 F1B23780
MS020 CAL ADSTAR F1B23790
TRA MS030 F1B23800
CM4200 TXI CM4201,1,-3 F1B23810
CM4201 SXD 3LBAR,1 F1B23820
TXI CM4303,4,-1 F1B23830
CM4300 TXI CM4301,1,-6 F1B23840
CM4301 SXD 3LBAR,1 F1B23850
TXI CM4303,4,-1 F1B23860
CM4303 SXD ABAR,4 F1B23870
TXI CM4102,2,-1 F1B23880
REM CLOSED SUBROUTINE TO MAKE ENTRIES IN HOLARG TABLE F1B23890
C3390 SXD C3357,1 SAVE CALLING IR F1B23900
SLW 1G MOVE WORD TO BE ENTERED TO 1G F1B23910
TSX TET00,1 GO TO ENTER WORD IN HOLARG TABLE F1B23920
13 F1B23930
CLA HOLCNT F1B23940
ADD L(1) UPDATE HOLCNT F1B23950
STO HOLCNT F1B23960
LXD C3357,1 RELOAD CALLING IR F1B23970
TRA 1,1 RETURN TO CALLER+1 F1B23980
REM PROGRAM TO SIMPLIFY THE TREATMENT OF RELATIVE ADDRESSES IN F1B23990
REM SECTION ONE THRU THE USE OF THE RA000 SUBROUTINE BY STATE B. F1B24000
SS000X SXD SSIR4,4 SAVE CALLING TAG. F1B24010
TSX SS000,4 GO TO SUBSCRIPT SCAN AND ANALYSIS ROUTINE. F1B24020
TSX RA000,4 GO TO RELATIVE ADDRESS COMPUTATION ROUTINE.F1B24030
CAL GTAG F1B24040
ANA MASK1 F1B24050
SLW E+11 F1B24060
TSX SIG1IX,4 GO ENTER THIS RELATIVE ADDRESS IN SIGMA1. F1B24070
ALS 15 POSITION SIGMA TAG. F1B24080
ORS E ADD SIGMA TAG TO I-TAU TAGS IN E. F1B24090
LXD SSIR4,4 RELOAD CALLING TAG. F1B24100
TRA 1,4 RETURN TO CALLER +1. F1B24110
REM F1B24120
REM ROYCNV DOES FIXED AND FLOATING POINT CONVERSION FOR SECTION F1B24130
REM ARITHMETIC. F1B24140
REM ROYCNV= ENTRY POINT FOR FIXED OR FLOATING POINT INTEGERS. F1B24150
ROYCNV STO N SAVE DECIMAL DIGIT IN N. F1B24160
STZ DOE CLEAR DOE (IMPLICIT EXPONENT). F1B24170
CLA MODECL TEST WHETHER THIS STATEMENT IS LABELED F1B24180
SUB L(D) AS DOUBLE PRECISION. F1B24190
TZE DPCNV1 YES, GO TO DOUBLE PRECISION CONVERSION. F1B24200
SXD EXIT,4 SAVE C(XR4) FOR RETURN. F1B24210
CLA CM1 PICK UP SWITCH CONTROL, F1B24220
EXIT TXI IN2,0,** AND GO SET SWITCH. F1B24230
REM DECPNT= ENTRY POINT FOR FLOATING POINT FRACTIONS. F1B24240
DECPNT STZ N CLEAR N (NO INTEGER). F1B24250
STZ DOE CLEAR DOE (IMPLICIT EXPONENT). F1B24260
CLA MODECL TEST WHETHER THIS STATEMENT IS LABELED F1B24270
SUB L(D) AS DOUBLE PRECISION. F1B24280
TZE DPCNV2 YES, GO TO DOUBLE PRECISION. F1B24290
SXD EXIT,4 SAVE C(XR4) FOR RETURN. F1B24300
NC7 CAL CM1 PICK UP SWITCH CONTROL. F1B24310
IN2 STP CM2 SET SWITCHES CM2, AND F1B24320
STP CM3 CM3. F1B24330
TOV NC5 TURN OFF OV TRIGGER. F1B24340
NC5 TSX C0190,4 * GO GET NEXT NB CHARACTER IN THE AC.F1B24350
SLW CHSAVE SAVE IT FOR STATE B, AND THEN F1B24360
CAS L(H) COMPARE IT WITH H. F1B24370
TXI NC1,0,0 IF H, GO TO HEXIT. F1B24380
SSIR4 TXI HEXIT,0,** IF NOT H, CONTINUE F1B24390
NC1 CAS TEN AND COMPARE WITH TEN. F1B24400
CM1 TXL NC2,0,0 CHAR EXCEEDS 10, SO IS NON-NUMERIC.F1B24410
PXD ,0 CLEAR THE AC (MACHINE ERROR). F1B24420
STO H CHARACTER IS NUMERIC, SO HOLD IT. F1B24430
CLA N MULTIPLY THE PREVIOUS F1B24440
ALS 2 PARTIAL RESULT (OR ZERO) F1B24450
ADD N BY 10, F1B24460
ALS 1 AND ADD IN F1B24470
ADD H THE CURRENT DIGIT. F1B24480
CM2 TXH NC3,0,0 SWITCH (NO TRANSFER IF INTEGER). F1B24490
TOV NC4 TEST OVERFLOW, AND F1B24500
STO N IF NONE, SAVE NEW PARTIAL RESULT. F1B24510
TXI NC5,0,0 THEN GO PICK UP NEXT CHARACTER. F1B24520
NC2 CAS POINT COMPARE NON-NUMERIC WITH A POINT. F1B24530
TXI CM3,0,0 IF GREATER THAN 27, GO OUT. F1B24540
TXI NC7,0,0 IF POINT, GO BACK AND SET SWITCH. F1B24550
CAS L(E) IF LESS THAN 27, COMPARE WITH E. F1B24560
TXI CM3,0,0 IF GREATER THAN 21, GO OUT. F1B24570
TXI EC1,0,0 IF E, GO TO EXPONENT ROUTINE. F1B24580
CM3 TXH FN4,0,0 SWITCH (NO TRANSFER IF INTEGER). F1B24590
CLA N PICK UP CONVERTED CONSTANT, AND F1B24600
MS9506 ALS 18 STORE IN THE F1B24610
STO G DECREMENT OF G, AND F1B24620
TSX FXCNIX,4 * GO MAKE FIXCON ENTRY. F1B24630
ORA FIXVAR CREATE INTERNAL FXD-PT VARIABLE,ANDF1B24640
TXI EXITR,0,0 GO TAKE EXITR. F1B24650
NC3 TOV NC8 IF THERE WAS NO OVERFLOW, F1B24660
STO N SAVE PARTIAL RESULT, AND F1B24670
CLS L(1) SUBTRACT 1 FROM DOE F1B24680
NC9 ADD DOE TO ADJUST EXPONENT F1B24690
STO DOE IN FINAL RESULT. F1B24700
NC8 TXI NC5,0,0 THEN GO PICK UP NEXT CHARACTER. F1B24710
NC4 CLA L(1) ADD 1 TO DOE , F1B24720
TXI NC9,0,0 IF THERE WAS INTEGER OVERFLOW. F1B24730
EC1 TSX C0190,4 * GO GET NEXT NB CHARACTER IN THE AC.F1B24740
SLW CHSAVE SAVE IT FOR STATE B, AND F1B24750
STZ EKE CLEAR EKE (EXPLICIT EXPONENT). F1B24760
CAS 11Z COMPARE CHARACTER WITH A DASH. F1B24770
TXI FN5,0,0 IF GREATER THAN 32, GO OUT. F1B24780
TXI EC3,0,0 IF A DASH, SET EKE MINUS. F1B24790
CAS 12Z IF LESS THAN 32, COMPARE WITH PLUS.F1B24800
TXI FN5,0,0 IF GREATER THAN 16, GO OUT. F1B24810
TXI EC6,0,0 IF PLUS, GO EXAMINE NEXT CHAR. F1B24820
CAS MINUS IF LESS THAN 16,COMPARE WITH MINUS.F1B24830
TXI FN5,0,0 IF GREATER THAN 12, GO OUT. F1B24840
EC3 CLS EKE IF MINUS, SET EKE TO -0. F1B24850
CAS TEN COMPARE WITH TEN. F1B24860
TXI FN5,0,0 IF NON-NUMERIC, GO EXAMINE NEXT CH.F1B24870
EC4 PXD ,0 CLEAR ACC, F1B24880
EC5 STO EKE SAVE PARTIAL RESULT(OR 0) IN EKE. F1B24890
EC6 TSX C0190,4 * GO GET NEXT NB CHARACTER IN THE AC.F1B24900
SLW CHSAVE SAVE IT FOR STATE B, F1B24910
CAS TEN AND COMPARE WITH TEN. F1B24920
TXI FN5,0,0 CHAR EXCEEDS 10, SO IS NON-NUMERIC.F1B24930
PXD ,0 CLEAR THE AC (MACHINE ERROR). F1B24940
STO H CHARACTER IS NUMERIC, SO HOLD IT. F1B24950
CLA EKE MULTIPLY THE PREVIOUS F1B24960
ALS 2 PARTIAL RESULT (OR ZERO) F1B24970
ADD EKE BY 10, F1B24980
ALS 1 AND ADD IN F1B24990
ACL H THE CURRENT DIGIT. F1B25000
TXI EC5,0,0 CONTINUE UNTIL NON-NUMERIC IS MET. F1B25010
FN5 CLA EKE COMBINE EXPLICIT EXPONENT F1B25020
ADD DOE WITH IMPLICIT EXPONENT, F1B25030
STO DOE AND SAVE IN DOE. F1B25040
FN4 CLA N IF N CONTAINS ZERO, TAKE F1B25050
TZE MS9500 FLO PT CONSTANT RETURN. F1B25060
STA K1 PUT INTEGER INTO FLO PT WORD, F1B25070
ARS 15 ADJUST, AND F1B25080
TZE FN1 IF MORE THAN 15 BITS IN LENGTH F1B25090
ORA K2 AFFIX CORRECT EXPONENT. F1B25100
FN1 FAD K1 THEN FLOATING ADD THE RESULT F1B25110
RQL 8 OF INTEGER CONVERSION, AND F1B25120
RND ROUND --TO OBTAIN F1B25130
ORA K3 NORMALIZED RESULT. F1B25140
LXA DOE,1 EXAMINE THE C(DOE), AND F1B25150
TXL MS9500,1,0 IF ZERO, TAKE FLO PT RETURN. F1B25160
TXL FN2,1,50 IF GREATER THAN 50, THEN F1B25170
TXI CER,0,0 ERROR. --GO TO DIAGNOSTIC. F1B25180
FN2 LDQ DOE DETERMINE WHETHER INTEGER WAS F1B25190
TQP FN3 TO THE RIGHT OR TO THE LEFT OF DP. F1B25200
FDP TAB,1 IF TO THE RIGHT, DIVIDE BY A F1B25210
STQ N SUITABLE CONSTANT F1B25220
CLA N TO ADJUST RESULT F1B25230
ACL K4 AND TEST FOR OUT OF RANGE. F1B25240
PBT IF P=1, SKIP TO ARITH RETURN. F1B25250
TXI CER,0,0 ERROR. --GO TO DIAGNOSTIC. F1B25260
MS9500 STO G STORE IN G, AND F1B25270
TSX FLCNIX,4 * GO MAKE FLOCON ENTRY. F1B25280
ORA FLOVAR CREATE INTERNAL FLO-PT VARIABLE, F1B25290
EXITR SLW E+2 SAVE VARIABLE IN E+2, F1B25300
LXD EXIT,4 RESTORE THE C(XR4), AND F1B25310
TRA 2,4 * RETURN TO MAIN ROUTINE. F1B25320
FN3 STO N IF INTEGER WAS SITUATED F1B25330
LDQ N TO THE LEFT OF THE DECIMAL POINT, F1B25340
FMP TAB,1 MULTIPLY BY A SUITABLE F1B25350
ACL K5 CONSTANT TO ADJUST AND TEST RANGE. F1B25360
PBT IF P=1, SKIP TO ERROR. F1B25370
TXI MS9500,0,0 RETURN TO ARITHMETIC ROUTINE. F1B25380
ER0069 BSS 0 F1B25390
CER TSX DIAG,4 * CONVERSION ERROR, GO TO DIAGNOSTIC.F1B25400
HEXIT LXD EXIT,4 RESTORE THE C(XR4), AND F1B25410
TRA 1,4 * RETURN TO MAIN ROUTINE. F1B25420
K1 OCT 233000000000 CONSTANT USED BY ROYCNV. F1B25430
K2 OCT 252000000000 CONSTANT USED BY ROYCNV. F1B25440
K3 OCT 400000000 CONSTANT USED BY ROYCNV. F1B25450
K4 OCT 335000000000 CONSTANT USED BY ROYCNV. F1B25460
K5 OCT 43000000000 CONSTANT USED BY ROYCNV. F1B25470
L(E) BCD 100000E CONSTANT USED BY ROYCNV. F1B25480
OCT 375536246150 48-TABLE USED BY ROYCNV. F1B25490
OCT 372430204755 47-TABLE USED BY ROYCNV. F1B25500
OCT 366700324573 46-TABLE USED BY ROYCNV. F1B25510
OCT 363546566774 45-TABLE USED BY ROYCNV. F1B25520
OCT 360436770626 44-TABLE USED BY ROYCNV. F1B25530
OCT 354713132676 43-TABLE USED BY ROYCNV. F1B25540
OCT 351557257061 42-TABLE USED BY ROYCNV. F1B25550
OCT 346445677216 41-TABLE USED BY ROYCNV. F1B25560
OCT 342726145174 40-TABLE USED BY ROYCNV. F1B25570
OCT 337570120775 39-TABLE USED BY ROYCNV. F1B25580
OCT 334454732313 38-TABLE USED BY ROYCNV. F1B25590
OCT 330741367021 37-TABLE USED BY ROYCNV. F1B25600
OCT 325601137164 36-TABLE USED BY ROYCNV. F1B25610
OCT 322464114135 35-TABLE USED BY ROYCNV. F1B25620
OCT 316755023373 34-TABLE USED BY ROYCNV. F1B25630
OCT 313612334311 33-TABLE USED BY ROYCNV. F1B25640
OCT 310473426555 32-TABLE USED BY ROYCNV. F1B25650
OCT 304770675742 31-TABLE USED BY ROYCNV. F1B25660
OCT 301623713116 30-TABLE USED BY ROYCNV. F1B25670
OCT 276503074077 29-TABLE USED BY ROYCNV. F1B25680
OCT 273402374714 28-TABLE USED BY ROYCNV. F1B25690
OCT 267635456171 27-TABLE USED BY ROYCNV. F1B25700
OCT 264512676456 26-TABLE USED BY ROYCNV. F1B25710
OCT 261410545213 25-TABLE USED BY ROYCNV. F1B25720
OCT 255647410336 24-TABLE USED BY ROYCNV. F1B25730
OCT 252522640262 23-TABLE USED BY ROYCNV. F1B25740
OCT 247417031702 22-TABLE USED BY ROYCNV. F1B25750
OCT 243661534466 21-TABLE USED BY ROYCNV. F1B25760
OCT 240532743536 20-TABLE USED BY ROYCNV. F1B25770
OCT 235425434430 19-TABLE USED BY ROYCNV. F1B25780
OCT 231674055532 18-TABLE USED BY ROYCNV. F1B25790
OCT 226543212741 17-TABLE USED BY ROYCNV. F1B25800
OCT 223434157116 16-TABLE USED BY ROYCNV. F1B25810
OCT 217706576512 15-TABLE USED BY ROYCNV. F1B25820
OCT 214553630410 14-TABLE USED BY ROYCNV. F1B25830
OCT 211443023471 13-TABLE USED BY ROYCNV. F1B25840
OCT 205721522451 12-TABLE USED BY ROYCNV. F1B25850
OCT 202564416672 11-TABLE USED BY ROYCNV. F1B25860
OCT 177452013710 10-TABLE USED BY ROYCNV. F1B25870
OCT 173734654500 09-TABLE USED BY ROYCNV. F1B25880
OCT 170575360400 08-TABLE USED BY ROYCNV. F1B25890
OCT 165461132000 07-TABLE USED BY ROYCNV. F1B25900
OCT 161750220000 06-TABLE USED BY ROYCNV. F1B25910
OCT 156606500000 05-TABLE USED BY ROYCNV. F1B25920
OCT 153470400000 04-TABLE USED BY ROYCNV. F1B25930
OCT 147764000000 03-TABLE USED BY ROYCNV. F1B25940
OCT 144620000000 02-TABLE USED BY ROYCNV. F1B25950
OCT 141500000000 01-TABLE USED BY ROYCNV. F1B25960
TAB OCT 136400000000 00-TABLE USED BY ROYCNV. F1B25970
REM F1B25980
REM DOUBLE PRECISION CONSTANT CONVERSION ROUTINE F1B25990
REM F1B26000
DPCNV1 STZ N1 F1B26010
STZ DPWC F1B26020
SXD DEXIT,4 SAVE C(XR4) FOR RETURN. F1B26030
CLA DCM1 F1B26040
DEXIT TXI DIN2,0,** AND GO SET SWITCH. F1B26050
DPCNV2 STZ N1 F1B26060
STZ DPWC F1B26070
SXD DEXIT,4 SAVE C(XR4) FOR RETURN. F1B26080
DNC7 CAL DCM1 PICK UP SWITCH CONTROL. F1B26090
DIN2 STP DCM2 SET SWITCHES CM2, AND F1B26100
STP DCM3 CM3. F1B26110
STP DNC11 F1B26120
TOV DNC5 TURN OFF OV TRIGGER. F1B26130
DNC5 TSX C0190,4 GO GET NEXT NB CHARACTER IN THE AC. F1B26140
SLW CHSAVE SAVE IT FOR STATE B, AND THEN F1B26150
CAS L(H) COMPARE IT WITH H. F1B26160
TXI DNC1,0,0 IF H, GO TO HEXIT. F1B26170
DSSIR4 TXI DHEXIT,0,.. IF NOT H, CONTINUE F1B26180
DNC1 CAS TEN AND COMPARE WITH TEN. F1B26190
DCM1 TXL DNC2,0,0 CHAR EXCEEDS 10,SO IS NON-NUMERIC. F1B26200
PXD ,0 CLEAR THE AC (MACHINE ERROR). F1B26210
STO H CHARACTER IS NUMERIC, SO HOLD IT. F1B26220
CLA N MULTIPLY THE PREVIOUS F1B26230
ALS 2 PARTIAL RESULT (OR ZERO) F1B26240
ADD N BY 10, F1B26250
ALS 1 AND ADD IN F1B26260
ADD H THE CURRENT DIGIT. F1B26270
DCM2 TXH DNC3,0,0 SWITCH (NO TRANSFER IF INTEGER). F1B26280
TOV DNC4 TEST OVERFLOW, AND F1B26290
STO N IF NONE, SAVE NEW PARTIAL RESULT. F1B26300
TXI DNC5,0,0 THEN GO PICK UP NEXT CHARACTER. F1B26310
DNC2 CAS POINT COMPARE NON-NUMERIC WITH A POINT. F1B26320
TXI DCM3,0,0 IF GREATER THAN 27, GO OUT. F1B26330
TXI DNC7,0,0 IF POINT, GO BACK AND SET SWITCH. F1B26340
CAS L(E) IF LESS THAN 27,COMPARE WITH E. F1B26350
TXI DCM3,0,0 IF GREATER THAN 21, GO OUT. F1B26360
TXI DEC1,0,0 IF E, GO TO EXPONENT ROUTINE. F1B26370
DCM3 TXH DFN4,0,0 SWITCH (NO TRANSFER IF INTEGER). F1B26380
CLA N PICK UP CONVERTED CONSTANT, AND F1B26390
DS9506 ALS 18 STORE IN THE F1B26400
STO G DECREMENT OF G, AND F1B26410
TSX FXCNIX,4 *GO MAKE FIXCON ENTRY. F1B26420
ORA FIXVAR CREATE INTERNAL FXD-PT VARIABLE,AND F1B26430
TXI DEXITR,0,0 GO TAKE EXITR. F1B26440
DNC3 TOV DNC4 IF NO OVERFLOW F1B26450
STO N SAVE PARTIAL RESULT, AND F1B26460
CLS L(1) SUBTRACT 1 FROM DOE F1B26470
DNC9 ADD DOE TO ADJUST EXPONENT F1B26480
STO DOE IN FINAL RESULT. F1B26490
DNC8 TXI DNC5,0,0 THEN GO PICK UP NEXT CHARACTER. F1B26500
NC5D TSX C0190,4 GET NEXT NB CHAR FOR WORD TWO F1B26510
SLW CHSAVE SAVE FOR STATE B F1B26520
DNC4 CAL CHSAVE F1B26530
CAS TEN COMPARE IT TO TEN F1B26540
TXL NC2D,0,0 CHAR. EXCEEDS 10,NON-NUMERIC F1B26550
PXD 0,0 CLEAR AC(MACHINE ERROR) F1B26560
STO H CHARACTER NUMERIC, SO HOLD IT F1B26570
CLA N1 MULTIPLY PREVIOUS WORD 2 F1B26580
ALS 2 PARTIAL RESULT F1B26590
ADD N1 BY 10 F1B26600
ALS 1 AND ADD IN F1B26610
ADD H THE CURRENT DIGIT F1B26620
DNC11 TXH NC3D,0,0 F1B26630
TOV NC4D TEST OVERFLOW WORD 2,AND F1B26640
STO N1 IF NONE SQVE NEW PARTIAL RESULT F1B26650
NC9D CLA L(1) AND ADD 1 TO 2ND WORD F1B26660
ADD DPWC F1B26670
STO DPWC F1B26680
TXI NC5D,0,0 CHARACTER. F1B26690
NC2D CAS POINT COMPARE NON-NUMERIC WITH POINT. F1B26700
TXI DCM3,0,0 IF GREATER THAN 27, GO OUT F1B26710
TXI NC7D,0,0 IF POINT,GO BACK AND SET SWITCH. F1B26720
TXI DCM3-3,0,0 IF LESS THAN 27,COMPARE WITH E. F1B26730
NC3D TOV NC5D,0 IF THERE WAS NO OVERFLOW F1B26740
STO N1 SAVE PARTIAL RESULT,AND F1B26750
CLS L(1) SUBTRACT 1 FORM DOE F1B26760
ADD DOE TO ADJUST EXPONENT F1B26770
STO DOE IN FINAL RESULT F1B26780
TXI NC9D,0,0 ADD 1 TO WC AND PICK UP NEXT CHAR F1B26790
NC4D CLA L(1) ADD 1 TO DOE F1B26800
ADD DOE AND F1B26810
STO DOE GET NEXT F1B26820
TXI NC5D,0,0 CHARACTER. F1B26830
NC7D CAL DCM1 PICK UP SWITCH CONTROL F1B26840
STP DCM3 SET SWITCHES CM3, F1B26850
STP DNC11 AND NC11 F1B26860
TXI NC5D,0,0 GET NEXT CHAR. F1B26870
DEC1 TSX C0190,4 *GO GET NEXT NB CHARACTER IN THE AC. F1B26880
SLW CHSAVE SAVE IT FOR STATE B, AND F1B26890
STZ EKE CLEAR EKE (EXPLICIT EXPONENT). F1B26900
CAS 11Z COMPARE CHARACTER WITH A DASH. F1B26910
TXI DFN5,0,0 IF GREATER THAN 32, GO OUT. F1B26920
TXI DPEC3,0,0 F1B26930
CAS 12Z IF LESS THAN 32, COMPARE WITH PLUS. F1B26940
TXI DFN5,0,0 IF GREATER THAN 16, GO OUT. F1B26950
TXI DEC6,0,0 IF PLUS, GO EXAMINE NEXT CHAR. F1B26960
CAS MINUS IF LESS THAN 16,COMPARE WITH MINUS. F1B26970
TXI DFN5,0,0 IF GREATER THAN 12, GO OUT. F1B26980
DPEC3 CLS EKE F1B26990
CAS TEN COMPARE WITH TEN. F1B27000
TXI DFN5,0,0 IF NON-NUMERIC, GO EXAMINE NEXT CH. F1B27010
DEC4 PXD ,0 CLEAR ACC, F1B27020
DPEC5 STO EKE F1B27030
DEC6 TSX C0190,4 *GO GET NEXT NB CHARACTER IN THE AC. F1B27040
SLW CHSAVE SAVE IT FOR STATE B, F1B27050
CAS TEN AND COMPARE WITH TEN. F1B27060
TXI DFN5,0,0 CHAR EXCEEDS 10, SO IS NON-NUMERIC. F1B27070
PXD ,0 CLEAR THE AC (MACHINE ERROR). F1B27080
STO H CHARACTER IS NUMERIC, SO HOLD IT. F1B27090
CLA EKE MULTIPLY THE PREVIOUS F1B27100
ALS 2 PARTIAL RESULT (OR ZERO) F1B27110
ADD EKE BY 10, F1B27120
ALS 1 AND ADD IN F1B27130
ACL H THE CURRENT DIGIT. F1B27140
TXI DPEC5,0,0 F1B27150
DFN5 CLA EKE COMBINE EXPLICIT EXPONENT F1B27160
ADD DOE WITH IMPLICIT EXPONENT, F1B27170
STO DOE AND SAVE IN DOE. F1B27180
DFN4 CLA N IF N CONTAINS ZERO, TAKE F1B27190
TZE DS9500 FLO PT CONSTANT RETURN. F1B27200
LXA DPWC,1 F1B27210
TXL FN90,1,10 IS WC GREATER THAN 10 F1B27220
PXD 0,0 IF YES, F1B27230
LDQ N1 THEN DIVIDE N1 BY 10 F1B27240
DVH TAB1-1 AND STORE F1B27250
STQ N1 BACK IN N1 F1B27260
CLA DOE F1B27270
ADD L(1) F1B27280
STO DOE F1B27290
TXI FN90,1,-1 AND DECREASE WC BY 1 TO COMPENSATE F1B27300
FN90 LDQ N F1B27310
MPY TAB1,1 F1B27320
STO TEMP1 AND STORE MOST SIGNIFICANT PART AND F1B27330
STQ TEMP2 LEAST SIGNIFICANT PART F1B27340
CLA TEMP2 ADD LEAST SIG. PART WORD1 F1B27350
ADD N1 TO WORD 2 F1B27360
STO TEMP2 AND STORE F1B27370
PBT IF P=1,SKIP TO MODIFY MOST SIG. PART F1B27380
TXI FN6,0,0 OTHERWISE START CONVERSION TO FLOATING PT F1B27390
CLA TEMP1 ADD 1 F1B27400
ADD L(1) TO MOST SIG. PART F1B27410
STO TEMP1 AND STORE F1B27420
FN6 CLA TEMP2 PUT LEAST SIG. INTEGER INTO F1B27430
STA DK1 FLOATING POINT WORD F1B27440
ARS 15 ADJUST,AND F1B27450
TZE FN7 IF MORE THAN 15 BITS IN LENGTH F1B27460
ORA DK2 AFFIX CORRECT EXPONENT F1B27470
FN7 FAD DK1 THEN FLOATING ADD THE RESULT OF INT CONV. F1B27480
STO G+1 AND STORE MOST SIGNIFICANT AND F1B27490
STQ G LEAST SIGNIFICANT HALVES F1B27500
CLA TEMP1 PUT MOST ISG.INTEGER INTO F1B27510
TZE FN8 FLOATING PT WORD(IF NON-ZERO) F1B27520
STA DK3 AND F1B27530
ARS 15 IF MORE THAN 15 BITS IN LENGTH F1B27540
TZE FN9 ADJUST F1B27550
ORA DK4 AFFIX CORRECT EXPONENT F1B27560
FN9 FAD DK3 THEN FLOATING ADD THE RESULT F1B27570
STQ TEMP2 STORE LSH (A2) F1B27580
FAD G+1 A1PB1 AND F1B27590
STO TEMP1 STORE MSH F1B27600
STQ G+1 AND LSH F1B27610
CLA G+1 (A1+B1)2 F1B27620
UFA TEMP2 +A2 F1B27630
UFA G +B2 F1B27640
FAD TEMP1 +(A1+B1)1 F1B27650
STQ G STORE LSH F1B27660
STO G+1 AND MSH F1B27670
FN8 LXA DOE,1 EXAMINE C(DOE) F1B27680
TXL FN99,1,0 IF ZERO, MAKE FLOCON ENTRY F1B27690
TXL DFN2,1,55 IF GREATER THAN 55,THEN F1B27700
TXI DCER,0,0 ERR.--GO TO DIAGNOSTIC F1B27710
DFN2 LDQ DOE DETERMINE WHETHER INTEGER WAS F1B27720
TRA PDFN2 TO PATCH (20)F1B27730
CLA G+1 IF TO THE RIGHT,DIVIDE BY F1B27740
FDP DTAB,1 A SUITABLE DOUBLE PRECISION CONSTANT F1B27750
TOV FN54 TEST FOR UNDERFLOW F1B27760
STQ TEMP1 F1B27770
UFA G LSH+REMAINDER F1B27780
TQO FN14 TURN OFF UNDERFLOW F1B27790
FN14 FDP DTAB,1 /B1 F1B27800
TQO FN53 TEST FOR UNDERFLOW F1B27810
STQ G+1 STORE F1B27820
CLS DTAB+54,1 -B2 F1B27830
FDP DTAB,1 /B1 F1B27840
TOV FN15 TURN OFF UNDERFLOW F1B27850
FN15 FMP TEMP1 F1B27860
TOV FN53 TEST FOR UNDERFLOW F1B27870
UFA G+1 F1B27880
TQO FN16 TURN OFF UNDEFLOW F1B27890
FN16 FAD TEMP1 ALLIGN CHARACTERISTIC F1B27900
TQO FN53 TEST FOR UNDERFLOW F1B27910
FN44 STO G+1 STORE MSH AND F1B27920
STQ G LSH F1B27930
TXI FN60,0,0 F1B27940
FN53 LDQ TEMP1 UNDERFLOW F1B27950
FN54 LLS 35 CORRECTION F1B27960
TOV FN55 F1B27970
FN55 TRA FN44 F1B27980
FN60 CLA G+1 ADJUST CHARACTERISTIC F1B27990
ACL DK4 BY ADDITION OF A SUITABLE CONSTANT F1B28000
PBT IF P=1 THEN ADJUST LSH F1B28010
TXI DCER,0,0 ERROR F1B28020
STO G+1 STORE MSH OF CONVERTED CONSTANT F1B28030
CLA G ADJUST LSH BY F1B28040
ACL DK4 ADDITION OF CONSTANT F1B28050
PBT IF P=1 THEN STORE F1B28060
PXD 0,0 CLEAR AC IF LSH OUT OF RANGE F1B28070
STO G AND STORE LSH OF CONVERTED CONSTANT F1B28080
FN99 TSX DFLCON,4 F1B28090
ORA FLOVAR CREATE INTERNAL FLO-PT VARIABLE. F1B28100
DEXITR SLW E+2 SAVE VARIABLE IN E+2 F1B28110
LXD DEXIT,4 RESTORE 1RY,AND F1B28120
TRA 2,4 RETURN TO MAIN ROUTINE F1B28130
DFN3 LDQ G+1 A1 F1B28140
FMP DTAB,1 A1*B1 F1B28150
TOV DCER,0 IF OVERFLOW,OUT OF RANGE F1B28160
STO TEMP1 STORE MSH F1B28170
STQ TEMP2 AND LSH F1B28180
LDQ G+1 A1 F1B28190
FMP DTAB+54,1 A1*B2 F1B28200
UFA TEMP2 ADD (A1*B1)2 F1B28210
STO TEMP2 AND STORE F1B28220
LDQ DTAB,1 B1 F1B28230
FMP G A2*B1 F1B28240
UFA TEMP2 +PREVIOUS SUM F1B28250
FAD TEMP1 F1B28260
TOV DCER,0 ERROR IF OVERFLOW F1B28270
ACL DK5 ADD CONSTANT TO ADJUST AND TEST RANGE F1B28280
PBT IF P=1,SKIP TO ERROR F1B28290
TXI DS9501,0,0 F1B28300
DCER TSX DIAG,4 CONVERSION ERROR,GO TO DIAGNOSTIC F1B28310
DHEXIT LXD DEXIT,4 RESTORE IR4 AND F1B28320
TRA 1,4 RETURN TO MAIN ROUTINE F1B28330
DS9501 STO G+1 STORE MSH OF CONVERTED CONSTANT F1B28340
LLS 35 AND ADJUST LSH BY F1B28350
ACL DK5 ADDING A SUITABLE CONSTANT F1B28360
STO G STORE LSH OF CONVERTED CONSTANT F1B28370
TXI FN99,0,0 GO MAKE FLOCON ENTRY F1B28380
DS9500 STZ G+1 CONSTANT=0 F1B28390
STZ G STORE AND F1B28400
TXI FN99,0,0 ENTER INTO TABLE F1B28410
N1 BSS 1 F1B28420
DPWC BSS 1 F1B28430
TEMP1 BSS 1 F1B28440
TEMP2 BSS 1 F1B28450
DK1 OCT 233000000000 F1B28460
DK2 OCT 252000000000 F1B28470
DK3 OCT 276000000000 F1B28480
DK4 OCT 315000000000 F1B28490
DK5 OCT 63000000000 F1B28500
OCT 376413215433 F1B28510
OCT 372653510705 F1B28520
OCT 367526072235 F1B28530
OCT 364421541661 F1B28540
OCT 360665717602 F1B28550
OCT 355536246150 F1B28560
OCT 352430204754 F1B28570
OCT 346700324573 F1B28580
OCT 343546566774 F1B28590
OCT 340436770626 F1B28600
OCT 334713132675 F1B28610
OCT 331557257061 F1B28620
OCT 326445677215 F1B28630
OCT 322726145174 F1B28640
OCT 317570120775 F1B28650
OCT 314454732312 F1B28660
OCT 310741367020 F1B28670
OCT 305601137163 F1B28680
OCT 302464114134 F1B28690
OCT 276755023372 F1B28700
OCT 273612334310 F1B28710
OCT 270473426555 F1B28720
OCT 264770675742 F1B28730
OCT 261623713116 F1B28740
OCT 256503074076 F1B28750
OCT 253402374713 F1B28760
OCT 247635456171 F1B28770
OCT 244512676455 F1B28780
OCT 241410545213 F1B28790
OCT 235647410336 F1B28800
OCT 232522640261 F1B28810
OCT 227417031701 F1B28820
OCT 223661534465 F1B28830
OCT 220532743536 F1B28840
OCT 215425434430 F1B28850
OCT 211674055531 F1B28860
OCT 206543212741 F1B28870
OCT 203434157115 F1B28880
OCT 177706576511 F1B28890
OCT 174553630407 F1B28900
OCT 171443023471 F1B28910
OCT 165721522450 F1B28920
OCT 162564416672 F1B28930
OCT 157452013710 F1B28940
OCT 153734654500 F1B28950
OCT 150575360400 F1B28960
OCT 145461132000 F1B28970
OCT 141750220000 F1B28980
OCT 136606500000 F1B28990
OCT 133470400000 F1B29000
OCT 127764000000 F1B29010
OCT 124620000000 F1B29020
OCT 121500000000 F1B29030
DTAB OCT 116400000000 F1B29040
OCT 343156556174 F1B29050
OCT 337112575140 F1B29060
OCT 334556775600 F1B29070
OCT 331277144463 F1B29080
OCT 325145072436 F1B29090
OCT 322120710345 F1B29100
OCT 317732240267 F1B29110
OCT 313052063614 F1B29120
OCT 310041534474 F1B29130
OCT 305347575227 F1B29140
OCT 301414310361 F1B29150
OCT 276160240301 F1B29160
OCT 273615031715 F1B29170
OCT 267341534511 F1B29180
OCT 264116112072 F1B29190
OCT 261413241542 F1B29200
OCT 255653551066 F1B29210
OCT 252674440705 F1B29220
OCT 247543515404 F1B29230
OCT 243554174006 F1B29240
OCT 240443311470 F1B29250
OCT 235202556055 F1B29260
OCT 231004260110 F1B29270
OCT 226320214723 F1B29280
OCT 223563327102 F1B29290
OCT 220617422402 F1B29300
OCT 214177204003 F1B29310
OCT 211631003151 F1B29320
OCT 206024002441 F1B29330
OCT 202354635550 F1B29340
OCT 177760512755 F1B29350
OCT 174446725444 F1B29360
OCT 170561357240 F1B29370
OCT 165132614200 F1B29380
OCT 162110475000 F1B29390
OCT 156647310000 F1B29400
OCT 153354240000 F1B29410
OCT 150760200000 F1B29420
OCT 144432000000 F1B29430
OCT 141510000000 F1B29440
OCT 136240000000 F1B29450
OCT 132400000000 F1B29460
OCT 000000000000 F1B29470
OCT 000000000000 F1B29480
OCT 000000000000 F1B29490
OCT 000000000000 F1B29500
OCT 000000000000 F1B29510
OCT 000000000000 F1B29520
OCT 000000000000 F1B29530
OCT 000000000000 F1B29540
OCT 000000000000 F1B29550
OCT 000000000000 F1B29560
OCT 000000000000 F1B29570
OCT 000000000000 F1B29580
OCT 112402762000 F1B29590
OCT 007346545000 F1B29600
OCT 000575360400 F1B29610
OCT 000046113200 F1B29620
OCT 000003641100 F1B29630
OCT 000000303240 F1B29640
OCT 000000023420 F1B29650
OCT 000000001750 F1B29660
OCT 000000000144 F1B29670
OCT 000000000012 F1B29680
TAB1 OCT 000000000001 F1B29690
REM F1B29700
REM COMPLEX CONSTANT CONVERSION ROUTINE F1B29710
REM F1B29720
ICNV3 CAL FWA SAVE FWA F1B29730
SLW IFWA AND F1B29740
CAL RESIDU RESIDU F1B29750
SLW IRESDU AND F1B29760
CAL XCHCTR CHARACTER COUNT F1B29770
SLW ICHCTR F1B29780
CLA ICM1 SET SIGN SWITCH TO ON (PLUS) F1B29790
STP ICM3 F1B29800
STP ICNV32 F1B29810
ICNV34 STP ICNV22 F1B29820
STZ EKE F1B29830
TSX C0190,4 F1B29840
CAS L(9) NB CHAR. IS CHAR. NUMERIC F1B29850
TXI ICNV4,0,0 N0 F1B29860
TXI ICNV5,0,0 YES START CONVERSION F1B29870
TXI ICNV5,0,0 F1B29880
ICNV20 CAL IRESDU F1B29890
SLW RESIDU F1B29900
CAL ICHCTR AND F1B29910
SLW XCHCTR CHARACTER COUNT F1B29920
CAL IFWA AND F1B29930
SLW FWA FWA F1B29940
TXI ICNV6,0,0 F1B29950
ICNV4 CAS POINT IS CHAR.FOLLOWING ( A DECIMAL POINT F1B29960
TXI ICNV21,0,0 NO F1B29970
TXI ICNV7,0,0 YES,EXIT TO CONVERSION ROUTINE F1B29980
CAS 12Z NO, CHECK IF CHAR. + F1B29990
TXI ICNV20,0,0 NO SO RETURN TO SCAN F1B30000
TXI ICNV24,0,0 YES, CHAR,IS + F1B30010
TXI ICNV20,0,0 NO SO RETURN TO SCAN F1B30020
ICNV21 CAS 11Z IS CHAR. - F1B30030
TXI ICNV20,0,0 NO,RET. TO SCAN F1B30040
TXI ICNV23,0,0 YES, CHAR. IS - F1B30050
TXI ICNV20,0,0 NO,RET. TO SCAN F1B30060
ICNV23 CAL ICM1 SET SIGN SWITCH F1B30070
STP ICNV22 TO OFF (MINUS) F1B30080
ICNV24 TSX C0190,4 GET NEXT CHAR. F1B30090
CAS L(9) IS CHAR. NUMERIC F1B30100
TXI ICNV25,0,0 NO F1B30110
TXI ICNV5,0,0 CHAR. IS NUMERIC, START CONVERSION F1B30120
TXI ICNV5,0,0 DITTO F1B30130
ICNV25 CAS POINT IS CHAR. A DEC. PT. F1B30140
TXI ICNV20,0,0 NO,RETURN TO SCAN F1B30150
TXI ICNV7,0,0 CHAR. IS DEC. PT.,START CONVERSION F1B30160
TXI ICNV20,0,0 NO, RETURN TO SCAN F1B30170
ICNV5 STO N F1B30180
STZ DOE F1B30190
CLA ICM1 F1B30200
IEXIT TXI IIN2,0,** F1B30210
ICNV7 STZ N F1B30220
STZ DOE F1B30230
INC7 CAL ICM1 F1B30240
IIN2 STP ICM2 SET SWITCH 1 F1B30250
STP ICNV26 F1B30260
STP ICNV31 F1B30270
TOV INC5 F1B30280
INC5 TSX C0190,4 PICK UP NEXT CHAR. F1B30290
CAS TEN F1B30300
ICM1 TXL INC2,0,0 F1B30310
PXD 0,0 F1B30320
STO H F1B30330
CLA N F1B30340
ALS 2 F1B30350
ADD N F1B30360
ALS 1 F1B30370
ADD H F1B30380
ICM2 TXH INC3,0,0 F1B30390
TOV INC4 F1B30400
STO N F1B30410
TXI INC5,0,0 F1B30420
ICNV26 TXH ICM3,0,0 NO TRANSFER IF FIXED POINT F1B30430
TXI ICNV20,0,0 RETURN TO SCAN F1B30440
INC2 CAS POINT COMPARE NON NUMERIC WITH DP F1B30450
TXI ICNV26,0,0 F1B30460
TXI INC7,0,0 IF POINT,GO BACK AND SET SWITCH F1B30470
ICNV31 TXH ICNV30,0,0 F1B30480
TXI ICNV20,0,0 F1B30490
ICNV30 CAS L(E) F1B30500
TXI ICM6,0,0 IF GREATER THAN 21,ERROR F1B30510
TXI IEC1,0,0 IF E, GO TO EXPONENT ROUTINE F1B30520
ICM3 TXH ICM5,0,0 SWITCH, NO TRANSFER IF 1ST PART F1B30530
CAS COMMA IS CHAR. COMMA F1B30540
TXI ICM6,0,0 IF NO, ERROR F1B30550
TXI IFN5,0,0 YES, SO START CONVERSION OF REAL PART F1B30560
ICM6 TSX DIAG,4 TRANSFER TO DIAGNOSTIC F1B30570
ICM5 CAS CLOS IS CHAR ) F1B30580
TXI ICM6,0,0 NO,ERROR F1B30590
TXI IFN5,0,0 YES,SO START CONVERSION OF 2ND HALF F1B30600
TXI ICM6,0,0 NO,ERROR F1B30610
INC3 TOV INC8 F1B30620
STO N F1B30630
CLS L(1) F1B30640
INC9 ADD DOE F1B30650
STO DOE F1B30660
INC8 TXI INC5,0,0 F1B30670
INC4 CLA L(1) F1B30680
TXI INC9,0,0 F1B30690
IEC1 TSX C0190,4 F1B30700
CAS 12Z F1B30710
TXI ICNV36,0,0 GTR THAN PLUS(16) - MUST BE MINUS SIG F1B30720
TXI IEC6,0,0 NUMBER READS E+ F1B30730
TXI ICNV35,0,0 LESS THAN PLUS(16)-MUST BE A DIGIT. F1B30740
ICNV36 CAS 11Z COMPARE WITH MINUS $F1B30750
TXI ICM6,0,0 ERROR F1B30760
TXI IEC3,0,0 NUMBER READS E- F1B30770
TXI ICM6,0,0 ERROR F1B30780
IEC3 CLS EKE SET EKE TO -0 F1B30790
CAS TEN COMPARE WITH TEN F1B30800
TXI ICM6,0,0 ERROR F1B30810
IEC4 PXD 0,0 F1B30820
IEC5 STO EKE F1B30830
IEC6 TSX C0190,4 F1B30840
ICNV35 CAS TEN COMPARE WITH TEN F1B30850
TXI ICM3,0,0 NON NUMERIC,)OR, F1B30860
PXD 0,0 CLEAR AC F1B30870
STO H NUMERIC SO HOLD IT F1B30880
CLA EKE F1B30890
ALS 2 F1B30900
ADD EKE F1B30910
ALS 1 F1B30920
ACL H F1B30930
TXI IEC5,0,0 F1B30940
IFN5 CLA EKE COMBINE EXPLICIT EXPONENT F1B30950
ADD DOE WITH IMPLICIT EXPONENT, F1B30960
STO DOE AND SAVE IN DOE. F1B30970
IFN4 CLA N IF N CONTAINS ZERO, TAKE F1B30980
TZE IMS950 FLO PT CONSTANT RETURN. F1B30990
STA K1 PUT INTEGER INTO FLO PT WORD, F1B31000
ARS 15 ADJUST, AND F1B31010
TZE IFN1 IF MORE THAN 15 BITS IN LENGTH F1B31020
ORA K2 AFFIX CORRECT EXPONENT. F1B31030
IFN1 FAD K1 THEN FLOATING ADD THE RESULT F1B31040
RQL 8 OF INTEGER CONVERSION, AND F1B31050
RND ROUND --TO OBTAIN F1B31060
ORA K3 NORMALIZED RESULT. F1B31070
LXA DOE,1 EXAMINE THE C(DOE), AND F1B31080
TXL IMS950,1,0 IF ZERO, TAKE FLO PT RETURN. F1B31090
TXL IFN2,1,50 IF GREATER THAN 50, THEN F1B31100
TXI ICER,0,0 ERROR. --GO TO DIAGNOSTIC. F1B31110
IFN2 LDQ DOE DETERMINE WHETHER INTEGER WAS F1B31120
TQP IFN3 TO THE RIGHT OR TO THE LEFT OF DP. F1B31130
FDP TAB,1 IF TO THE RIGHT, DIVIDE BY A F1B31140
STQ N SUITABLE CONSTANT F1B31150
CLA N TO ADJUST RESULT F1B31160
ACL K4 AND TEST FOR OUT OF RANGE. F1B31170
PBT IF P=1, SKIP TO ARITH RETURN. F1B31180
TXI ICER,0,0 ERROR. --GO TO DIAGNOSTIC. F1B31190
IMS950 SSM SET NUMBER MINUS F1B31200
ICNV22 TXH IMS951,0,0 SWITCH, NO TRANSFER IF PLUS F1B31210
SSP SET NUMBER PLUS F1B31220
IMS951 STO G STORE IMAGINARY PART F1B31230
ICNV32 TXH ICNV33,0,0 NO TRANSFER IF REAL PART F1B31240
STO G+1 STORE REAL PART F1B31250
CAL CM1 SET SWITCH F1B31260
STP ICM3 ICM3AND F1B31270
STP ICNV32 F1B31280
CLA ICM1 TURN REAL-IMAG SWITCH ON (IMAG) F1B31290
TXI ICNV34,0,0 F1B31300
ICNV33 TSX DFLCON,4 ENTER COMPLEX CONSTANT INTO TABLE F1B31310
ORA FLOVAR CREATE INTERNAL FLO-PT VARIABLE, F1B31320
SLW E+2 SAVE VARIABLE IN E+2, F1B31330
TSX C0190,4 SET CHSAVE TO CHARACTER F1B31340
SLW CHSAVE FOLLOWING THE CLOSING PAREN. F1B31350
TXI LATXH,0,0 CONVERSION COMPLETED,RETURN TO PROG F1B31360
IFN3 STO N IF INTEGER WAS SITUATED F1B31370
LDQ N TO THE LEFT OF THE DECIMAL POINT, F1B31380
FMP TAB,1 MULTIPLY BY A SUITABLE F1B31390
ACL K5 CONSTANT TO ADJUST AND TEST RANGE. F1B31400
PBT IF P=1, SKIP TO ERROR. F1B31410
TXI IMS950,0,0 RETURN TO ARITHMETIC ROUTINE. F1B31420
ICER TSX DIAG,4 *CONVERSION ERROR, GO TO DIAGNOSTIC. F1B31430
TXI LATXH,0,0 CONVERSION COMPLETED,RETURN TO PROG F1B31440
IRESDU F1B31450
ICHCTR F1B31460
IFWA F1B31470
SIG1ST PZE SIGMA1+2,,1 F1B31480
REM F1B31490
REM STATE C PERFORMS OPTIMIZATION ON LAMBDA TABLE. F1B31500
R00000 LDQ L(0) CLEAR MQ F1B31510
LXD NBAR,A LDXA WITH -N F1B31520
SXD R00700,A F1B31530
SXD R05200,A F1B31540
SXD AS0800,A F1B31550
SXD AS2900,A F1B31560
LXA L(0),7 CLEAR XA,XB,XC, F1B31570
R00500 STQ BETA,B CLEAR BETA TABLE F1B31580
TXI R00700,B,-1 F1B31590
R00700 TXH R00500,B,0 F1B31600
CLA 3LBAR LENGTH OF LAMBDA F1B31610
STD R01700 F1B31620
STD R06200 F1B31630
R01000 CLA LAMBDA,A ADD INTO GAMMA COUNTERS F1B31640
PAX 0,B F1B31650
CLA BETA,B F1B31660
ADD BETAD1 077775077775,-3 TO ADD+DEC F1B31670
STD BETA,B F1B31680
STA BETA,B F1B31690
TXI R01700,A,-3 F1B31700
R01700 TXH R01000,A,0 -3L IN XA AT END F1B31710
R01800 TXH R04200,A,-6 EXIT FROM SINGLE ELEMENT REDUCTION F1B31720
CLA LAMBDA-3,A F1B31730
PAX 0,B F1B31740
CLA BETA,B F1B31750
SUB BETAD1 F1B31760
TZE R02600 F1B31770
TXI R01800,A,3 F1B31780
R02600 LDQ LAMBDA-2,A SINGLE ELEMENT F1B31790
LGL 6 EXAMINE OPERATION F1B31800
SUB 11Z F1B31810
TNZ R03200 F1B31820
TXI R01800,A,3 F1B31830
R03200 CAL MASK1 SINGLE ELEMENT, NON-UNARY OP F1B31840
ANS LAMBDA-3,A EXTRACT TAGS AND STORE BACK F1B31850
CLA LAMBDA-6,A F1B31860
ORA LAMBDA-3,A F1B31870
SLW LAMBDA-6,A F1B31880
CAL LAMBDA-2,A EXTRACT FS BITS AND STORE BACK F1B31890
ANA MASK5 F1B31900
ORS LAMBDA-5,A F1B31910
CAL LAMBDA-1,A STORE BACK SYMBOL F1B31920
SLW LAMBDA-4,A F1B31930
STZ BETA,B REDUCE GAMMA COUNT TO 0 F1B31940
STZ LAMBDA-3,A CLEAR TAG WORD F1B31950
TXI R01800,A,3 RESUME SCAN-BACK F1B31960
R04200 STZ G F1B31970
LXA L(0),7 CLEAR XA,XB,XC F1B31980
R04500 CLA BETA,B SET ORIGINS OF SCRIPL TABLE F1B31990
TZE R05100 F1B32000
LDQ G F1B32010
SLQ BETA,B F1B32020
ADD G F1B32030
STD G F1B32040
R05100 TXI R05200,B,-1 F1B32050
R05200 TXH R04500,B,0 DEC(K)=DEC(ACC)=-3P AT END F1B32060
R05300 CAL LAMBDA,A STRING BEADS... COMPRESS LAMBDA TABLE F1B32070
TZE R06100 F1B32080
SLW LAMBDA,C F1B32090
CLA LAMBDA+1,A F1B32100
STO LAMBDA+1,C F1B32110
CLA LAMBDA+2,A F1B32120
STO LAMBDA+2,C F1B32130
TXI R06100,C,-3 F1B32140
R06100 TXI R06200,A,-3 F1B32150
R06200 TXH R05300,A,0 F1B32160
SXD R07800,C -3P IN XC AT END F1B32170
SXD CS0760,C F1B32180
LXA L(0),A F1B32190
R06400 CLA LAMBDA,A STORE ORDERED, REDUCED LAMBDA TABLE F1B32200
PAX 0,B IN SCRIPL TABLE F1B32210
CLA BETA,B F1B32220
PDX 0,C F1B32230
CLA LAMBDA,A F1B32240
STO SCRIPL,C F1B32250
CLA LAMBDA+1,A F1B32260
STO SCRIPL+1,C F1B32270
CLA LAMBDA+2,A F1B32280
STO SCRIPL+2,C F1B32290
TXI R07500,C,-3 F1B32300
R07500 PXD 0,C F1B32310
STD BETA,B F1B32320
TXI R07800,A,-3 F1B32330
R07800 TXH R06400,A,0 -3P IN XA AT END F1B32340
CS0000 LDQ L(0) ELIMINATE COMMON SEGMENTS F1B32350
CS0010 CAL SCRIPL-3,A F1B32360
TZE CS0080 ERASED SEGMENT - CONTINUE BACK-SCAN F1B32370
CS0030 PAX 0,B F1B32380
TXL CS0660,B,0 EXIT FROM CS ROUTINE F1B32390
STA CS0030 F1B32400
CLA BETA,B F1B32410
CS0060 PAX 0,C F1B32420
TXL CS0090,C,-6 AT LEAST TWO ELEMENTS F1B32430
CS0080 TXI CS0010,A,3 ONE ELEMENT OR ERASED SEGMENT F1B32440
CS0090 SXD CS0470,A SAVE XA F1B32450
SXD LENGTH,C SAVE XC, CONTAINING LENGTH OF SEGMENT F1B32460
CS0100 TXL CS0130,C,0 SEARCH UP FOR MATCHING SEGMENT F1B32470
TXI CS0120,A,3 F1B32480
CS0120 TXI CS0100,C,3 F1B32490
CS0130 CAL SCRIPL-3,A F1B32500
TNZ CS0151 F1B32510
TXI CS0130,A,3 ERASED SEGMENT F1B32520
CS0151 PAX 0,B F1B32530
TXL CS0610,B,0 GO ON TO NEXT SEGMENT F1B32540
STA CS0060 F1B32550
CLA BETA,B F1B32560
PAX 0,C F1B32570
PXD 0,C F1B32580
SUB LENGTH F1B32590
TNZ CS0100 NOT SAME LENGTH SEGMENT-CONTINUE SEARCH F1B32600
LXD CS0470,B SAME LENGTH SEGMENT F1B32610
SXD CS0600,A F1B32620
CS0250 TXL CS0430,C,0 MATCHING SEGMENTS F1B32630
CLA SCRIPL-1,B F1B32640
SUB SCRIPL-1,A F1B32650
TNZ CS0100 F1B32660
CAL SCRIPL-3,B SYMBOLS MATCH F1B32670
ANA MASK1 F1B32680
SLW G F1B32690
CAL SCRIPL-3,A F1B32700
ANA MASK1 F1B32710
COM F1B32720
ACL G F1B32730
COM F1B32740
TNZ CS0100 F1B32750
CLA SCRIPL-2,B TAGS MATCH F1B32760
ARS 6 F1B32770
ALS 6 F1B32780
SUB SCRIPL-2,A F1B32790
TNZ CS0100 F1B32800
TXI CS0360,A,3 OPS MATCH F1B32810
CS0360 TXI CS0370,B,3 F1B32820
CS0370 TXI CS0250,C,3 F1B32830
CS0430 CAL SCRIPL,A MATCHING SEGMENTS F1B32840
ANA MASK2 SEARCH FOR REFERENCES F1B32850
CS0450 CAS SCRIPL-1,A F1B32860
TXI CS0450,A,3 F1B32870
CS0470 TXI CS0490,0,0 F1B32880
TXI CS0450,A,3 F1B32890
CS0490 CLA CS0030 CHANGE REFERENCE F1B32900
STA SCRIPL-1,A F1B32910
LXD LENGTH,C F1B32920
LXD CS0600,A F1B32930
CS0530 TXL CS0570,C,0 ERASE DUPLICATE SEGMENT F1B32940
STQ SCRIPL-3,A F1B32950
TXI CS0560,A,3 F1B32960
CS0560 TXI CS0530,C,3 F1B32970
CS0570 LXA CS0060,C F1B32980
STQ BETA,C F1B32990
CAL 11Z STORE CS BIT F1B33000
ORS SCRIPL+1,B F1B33010
CS0600 TXI CS0130,0,0 F1B33020
CS0610 LXD CS0470,A F1B33030
LXD LENGTH,C F1B33040
CS0630 TXL CS0010,C,0 F1B33050
TXI CS0650,A,3 F1B33060
CS0650 TXI CS0630,C,3 F1B33070
CS0660 LXA L(0),5 STRING BEADS... COMPRESS SCRIPL TABLE F1B33080
CS0670 CAL SCRIPL,A F1B33090
TZE CS0750 F1B33100
SLW SCRIPL,C F1B33110
CLA SCRIPL+1,A F1B33120
STO SCRIPL+1,C F1B33130
CLA SCRIPL+2,A F1B33140
STO SCRIPL+2,C F1B33150
TXI CS0750,C,-3 F1B33160
CS0750 TXI CS0760,A,-3 F1B33170
CS0760 TXH CS0670,A,0 F1B33180
SXD PM0080,C -3Q IN XC AT END F1B33190
SXD AS1800,C F1B33200
SXD AS3600,C F1B33210
PM0000 SLF TURN OFF ALL SENSE LITES F1B33220
CLA MODECL TEST FOR BOOLEAN EXPRESSION AND IF SO F1B33230
SUB L(B) SKIP PERMUTATION ROUTINE. F1B33240
TZE AS0000 F1B33250
LXA L(0),A PERMUTE * AND / F1B33260
PM0010 CLA SCRIPL,A F1B33270
PAX 0,B F1B33280
CLA BETA,B F1B33290
PAX 0,C LDXC WITH SEGMENT LENGTH F1B33300
SXD PM0070,C F1B33310
TXL PM0100,C,-9 F1B33320
PM0070 TXI PM0080,A,0 LENGTH LESS THAN 3 OR OD NOT = TO * F1B33330
PM0080 TXL AS0000,A,0 EXIT FROM PERMUTATION ROUTINE F1B33340
TRA PM0010 F1B33350
PM0100 CAL SCRIPL+1,A SEGMENT LENGTH AT LEAST = TO 3 F1B33360
LGR 30 F1B33370
SUB STAR F1B33380
TNZ PM0070 F1B33390
TQP PM0170 F1B33400
TRA PM0070 F1B33410
PM0170 SXD PM0260,C F1B33420
SXD PM0400,C F1B33430
SXD PM0680,C F1B33440
LXA L(0),C LDXC WITH 0 F1B33450
TXI PM0240,A,-3 F1B33460
PM0240 SLN 3 TURN * LITE ON F1B33470
PM0250 TXI PM0260,C,-3 F1B33480
PM0260 TXL PM0790,C,0 EXIT F1B33490
SXD PM0340,C F1B33500
LXD PM0290,B F1B33510
PM0290 TXI PM0300,3,0 XA TO XA AND XB F1B33520
PM0300 CAL SCRIPL+1,A F1B33530
LGR 30 F1B33540
CAS SLASH F1B33550
FEXUB PZE ,,7 TEST NUMBER FOR IN-LINE EXPONENTS. F1B33560
PM0340 TXL PM0640,0,0 / SIGN F1B33570
SLT 3 * SIGN... IS * LITE ON F1B33580
TXI PM0240,A,-3 NO F1B33590
TXI PM0390,B,-3 YES - SEARCH FOR / SIGN F1B33600
PM0390 TXI PM0400,C,-3 F1B33610
PM0400 TXL PM0770,C,0 EXIT F1B33620
CAL SCRIPL+1,B F1B33630
LGR 30 F1B33640
SUB SLASH F1B33650
TZE PM0480 F1B33660
TXI PM0390,B,-3 F1B33670
PM0480 CLA SCRIPL,A PERMUTE TAG WORDS F1B33680
LDQ SCRIPL,B F1B33690
STQ SCRIPL,A F1B33700
STO SCRIPL,B F1B33710
CLA SCRIPL+1,A PERMUTE OP WORDS F1B33720
LDQ SCRIPL+1,B F1B33730
STQ SCRIPL+1,A F1B33740
STO SCRIPL+1,B F1B33750
CLA SCRIPL+2,A PERMUTE SYMBOL WORDS F1B33760
LDQ SCRIPL+2,B F1B33770
STQ SCRIPL+2,A F1B33780
STO SCRIPL+2,B F1B33790
LXD PM0340,C F1B33800
TXI PM0250,A,-3 RESUME SEGMENT SCAN F1B33810
PM0640 SLT 3 / SIGN... IS * LITE ON F1B33820
PM0650 TXI PM0670,B,-3 NO F1B33830
TXI PM0250,A,-3 F1B33840
PM0670 TXI PM0680,C,-3 F1B33850
PM0680 TXL PM0770,C,0 F1B33860
CAL SCRIPL+1,B F1B33870
LGR 30 F1B33880
SUB SLASH F1B33890
TZE PM0650 F1B33900
SLN 3 TORN * LITE ON F1B33910
TRA PM0480 F1B33920
PM0770 LXD PM0780,A F1B33930
PM0780 TXI PM0790,3,0 XB TO XA,XB F1B33940
PM0790 CAL SCRIPL-2,A F1B33950
LGR 30 F1B33960
SUB SLASH F1B33970
TZE PM0080 ... / - EXIT FROM SEGMENT SCAN F1B33980
CAL SCRIPL-5,A F1B33990
LGR 30 F1B34000
SUB SLASH F1B34010
TZE PM0080 ... / * - EXIT FROM SEGMENT SCAN F1B34020
CLA SCRIPL-3,A ... ** F1B34030
STO E F1B34040
CLA SCRIPL-2,A F1B34050
STO E+1 F1B34060
CLA SCRIPL-1,A F1B34070
STO E+2 F1B34080
TXI PM0980,A,3 F1B34090
PM0980 TXI PM0990,C,3 F1B34100
PM0990 TXL PM1070,C,0 FINIS F1B34110
CLA SCRIPL-3,A F1B34120
STO SCRIPL,A F1B34130
CLA SCRIPL-2,A F1B34140
STO SCRIPL+1,A F1B34150
CLA SCRIPL-1,A F1B34160
STO SCRIPL+2,A F1B34170
TXI PM0980,A,3 F1B34180
PM1070 CLA E F1B34190
STO SCRIPL,A F1B34200
CLA E+1 F1B34210
STO SCRIPL+1,A F1B34220
CLA E+2 F1B34230
STO SCRIPL+2,A F1B34240
CAL SCRIPL+4,A PRESERVE CS BIT F1B34250
ANA 11Z F1B34260
ORS SCRIPL+1,A F1B34270
TRA PM0070 F1B34280
AS0000 LXA L(0),7 RENUMBER SEGMENT OF SCRIPL F1B34290
AS0100 CLA BETA,B F1B34300
TZE AS0700 F1B34310
PXA 0,C F1B34320
STA BETA,B F1B34330
TXI AS0700,C,-1 F1B34340
AS0700 TXI AS0800,B,-1 F1B34350
AS0800 TXH AS0100,B,0 F1B34360
AS0900 CLA SCRIPL,A F1B34370
PAX 0,B F1B34380
CLA BETA,B F1B34390
STA SCRIPL,A F1B34400
LDQ SCRIPL+2,A F1B34410
LGL 1 F1B34420
LBT F1B34430
TQP AS2000 F1B34440
TXI AS1800,A,-3 F1B34450
AS1800 TXH AS0900,A,0 F1B34460
TRA AS2500 F1B34470
AS2000 LGL 35 F1B34480
PAX 0,B F1B34490
CLA BETA,B F1B34500
STA SCRIPL+2,A F1B34510
TXI AS1800,A,-3 F1B34520
AS2500 LXA L(0),3 LDXA,XB WITH 0 F1B34530
LDQ L(0) CLEAR MQ F1B34540
AS2700 STQ BETA,B RECLEAR BETA TABLE F1B34550
TXI AS2900,B,-1 F1B34560
AS2900 TXH AS2700,B,0 F1B34570
AS3000 CLA SCRIPL,A ADD INTO GAMMA COUNTERS F1B34580
PAX 0,B F1B34590
CLA BETA,B F1B34600
ADD BETAD2 3*2**18+(-3) F1B34610
STD BETA,B F1B34620
STA BETA,B F1B34630
TXI AS3600,A,-3 F1B34640
AS3600 TXH AS3000,A,0 -3Q IN XA AT END F1B34650
SXD 3LBAR,A -3Q TO 3QBAR = 3LBAR F1B34660
CCS000 CAL SCRIPL-3,A ELIMINATE COMMON SUBEXPRESSIONS F1B34670
PAX 0,B LOAD XB WITH S(I) F1B34680
TXL CCS240,B,0 EXIT AT S(0) F1B34690
CAL BETA,B OBTAIN LENGTH OF S(I) F1B34700
STD CCS060 AND BACK UP TO F1B34710
CCS060 TXI CCS070,A,0 BEGINNING OF CURRENT SEGMENT F1B34720
CCS070 CAL SCRIPL+1,A OBTAIN OP1 (S(I)) F1B34730
ANA 11Z EXTRACT CS-BIT F1B34740
TZE CCS000 CONTINUE TO S(I-1) F1B34750
PXA 0,B F1B34760
LXA L(0),C TO S(I) F1B34770
LXD CCS140,B AND KEEP COUNT OF SAME F1B34780
CCS140 TXI CCS150,3,0 XA TO XA,XB F1B34790
CCS150 TXL CCS200,B,0 SEARCH-UP FINISHED. EXAMINE COUNT F1B34800
CAS SCRIPL-1,B F1B34810
TXI CCS150,B,3 CONTINUE SEARCH F1B34820
TXI CCS190,C,1 RAISE REF COUNTER AND F1B34830
CCS190 TXI CCS150,B,3 CONTINUE SEARCH F1B34840
CCS200 TXH CCS000,C,1 MULTIPLE REFERENCE F1B34850
CAL MASK4 SINGLE REFERENCE - SO SET F1B34860
ANS SCRIPL+1,A OP1(S(I))30 TO 0, AND F1B34870
TRA CCS000 CONTINUE FOR S(I-1) F1B34880
CCS240 LXD AS3600,A -3Q TO XA F1B34890
PL0000 TXL LK0000,A,0 GO TO LINKAGE F1B34900
CLA SCRIPL-3,A F1B34910
PAX 0,B F1B34920
CAL BETA,B F1B34930
PAX 0,C F1B34940
STD PL0060 F1B34950
PL0060 TXI PL0070,A,0 SET XA TO BEGINNING OF S(I) F1B34960
PL0070 CAL SCRIPL+1,A OBTAIN F1B34970
LGR 30 AND F1B34980
CAS SPECOP EXAMINE OP1 (S(I)) F1B34990
TRA PL0680 F1B35000
TRA PL0460 F1B35010
PL0130 CAL SCRIPL+2,A OP1 (S(I)) IS +, - OR * F1B35020
LGR 35 OBTAIN AND F1B35030
LBT EXAMINE SYM1 (S(I)) F1B35040
TQP PL0300 F1B35050
LGL 5 EX (IN)TERNAL VARIAVLE F1B35060
PL0135 CAS L(H) IS SYM1 (S(I)) FIX OR FLO PT F1B35070
CAS L(O) F1B35080
TRA PL0240 FLO PT... SET OP1 (S(I)) 32 = 1 F1B35090
TRA PL0240 FLO PT... DITTO F1B35100
TRA PL0000 FIX PT... OP1 (S(I)) 32 = 0 F1B35110
PL0240 CAL L(8) SET OP1 (S(I)) 32 = 1 F1B35120
PL0250 ORS SCRIPL+1,A F1B35130
PL0260 TXI PL0000,0,0 CONTINUE SCAN F1B35140
PL0300 LXD PL0310,B SYM1 (S(I)) = SOME S(J) F1B35150
PL0310 TXI PL0320,3,0 XA TO XA,XB F1B35160
PL0320 SXD PL0330,C F1B35170
PL0330 TXI PL0340,B,0 F1B35180
PL0340 CAL SCRIPL,B F1B35190
PAX 0,C F1B35200
ANA MASK2 F1B35210
SUB SCRIPL+2,A F1B35220
TZE PL0420 F1B35230
CLA BETA,C F1B35240
PAX 0,C F1B35250
TRA PL0320 F1B35260
PL0420 CAL SCRIPL+1,B SYM1(S(I)) = S(J) F1B35270
ANA L(8) EXTRACT OP1 (S(J)) 32 AND GO F1B35280
TRA PL0250 SET OP1 (S(I)) 32 = OP1 (S(J)) 32 F1B35290
PL0460 LGL 7 OP1 (S(I)) IS SPOP F1B35300
TQP PL0465 F1B35310
PL0461 CAL SCRIPL+2,A FS NAME - F1B35320
LGR 30 EXAMINE SUM1 (S(I)) S,1-5 F1B35330
SUB L(X) F1B35340
TNZ PL0240 FLO PT... GO SET OP1 (S(I)) 32 = 1 F1B35350
TRA PL0000 FIX PT ... OP1 (S(I)) 32 = 0 F1B35360
PL0465 LBT F1B35370
TRA PL0470 F1B35380
CAL SCRIPL+2,A F1B35390
LGR 30 F1B35400
TRA PL0135 F1B35410
PL0470 CLA SCRIPL+2,A NOT AN FS NAME F1B35420
LXA L(0),B F1B35430
PL0480 CAS OPSUB,B F1B35440
TXI PL0520,B,-1 F1B35450
REM DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B35460
TRA DP004 F1B35470
REM F1B35480
TXI PL0520,B,-1 F1B35490
PL0520 TXH PL0480,B,-20 F1B35500
STO G F1B35510
REM DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B35520
CLA MODECL F1B35530
SUB L(D) F1B35540
TZE DP0042 F1B35550
ITEST4 SUB L(5) F1B35560
TZE DP0042 F1B35570
REM F1B35580
PL0521 SXD PL0260,A F1B35590
TSX TET00,A F1B35600
HTR 9 F1B35610
LXD PL0260,A F1B35620
TRA PL0461 F1B35630
PL0650 CAL L(4) SET OP1 (S(I)) 33 =1 F1B35640
ORS SCRIPL+1,A F1B35650
TRA PL0461 F1B35660
PL0680 TQP PL0130 F1B35670
TRA EXPCH OP1 (S(I)) IS **, CHECK FOR ERROR $F1B35680
LGR 35 OBTAIN AND EXAMINE F1B35690
LBT SYM1 (S(I)) F1B35700
TQP PL1000 F1B35710
LGL 5 EX (IN)TERNAL VARIABLE F1B35720
CAS L(H) IS OT FIX OR FLO PT F1B35730
CAS L(O) F1B35740
TRA PL0800 F1B35750
TRA PL0800 F1B35760
TRA PL0830 FIX PT F1B35770
PL0800 CAL L(8) FLO PT... SET OP1 (S(I)) 32 = 1 F1B35780
PL0820 ORS SCRIPL+1,A F1B35790
PL0830 CAL SCRIPL+5,A OBTAIN F1B35800
LGR 35 AND F1B35810
LBT EXAMINE F1B35820
TQP PL1200 SYM2 (S(I)) F1B35830
LGL 5 F1B35840
CAS L(H) F1B35850
CAS L(O) F1B35860
TRA PL0940 SYM2 (S(I)) IS FLO PT, SO GO F1B35870
TRA PL0940 SET OP2 (S(I)) 32 = 1 F1B35880
PL0850 PXD 0,0 SYM2(S(I)) IS FIX PT F1B35890
LGL 6 F1B35900
SUB OPEN F1B35910
TNZ PL0000 SYM2 (S(I)) IS EXTERNAL F1B35920
REM DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B35930
REM AVOID USE OF OPEN SUBROUTINE FOR DP F1B35940
REM FLOATING PT BASE TO FIXED PT. POWER LESS F1B35950
REM THAN OR EQUAL TO 7. F1B35951
DP006 CLA MODECL F1B35960
SUB L(D) F1B35970
TZE PL0000 F1B35980
SUB L(5) F1B35990
TZE PL0000 F1B36000
PXD ,0 F1B36010
REM F1B36020
LGL 24 F1B36030
ADD FXCNIX-1 F1B36040
STA *+1 F1B36050
CLA ** F1B36060
PL1570 TZE PL0000 EXP IS 0, SO OP1 (S(I)) 33 = 0 F1B36070
CAS FEXUB F1B36080
TXH 0,,0 EXP NOT LESS THAN 7, SO F1B36090
TRA PL0000 OP1 (S(I)) 33 = 0 F1B36100
STO SCRIPL+5,A EXP LESS THAN 7, SO STORE EXP F1B36110
CAL L(4) AS SYM2 (S(I)) AND SET F1B36120
ORS SCRIPL+1,A OP1 (S(I)) 33 = 1 F1B36130
TRA PL0000 F1B36140
PL0940 CAL L(8) SYM2 (S(I)) IS FLO PT F1B36150
ORS SCRIPL+4,A SET OP2 (S(I)) 32 = 1 F1B36160
TRA PL0000 F1B36170
PL1000 LXD PL1010,B SYM1 (S(I)) IS SOME S(J) F1B36180
PL1010 TXI PL1020,3,0 XA TO XA,XB F1B36190
PL1020 SXD PL1030,C F1B36200
PL1030 TXI PL1040,B,0 F1B36210
PL1040 CAL SCRIPL,B F1B36220
PAX 0,C F1B36230
ANA MASK2 F1B36240
SUB SCRIPL+2,A F1B36250
TZE PL1130 F1B36260
CLA BETA,C F1B36270
PAX 0,C F1B36280
TRA PL1020 F1B36290
PL1130 CAL SCRIPL+1,B F1B36300
ANA L(8) F1B36310
TRA PL0820 F1B36320
PL1200 LXD PL1210,B SYM2 (S(I)) = SOME S(K) F1B36330
PL1210 TXI PL1220,3,0 XA TO XA,XB F1B36340
PL1220 LXD PL1330,C LKXC WITH -6 F1B36350
PL1230 SXD PL1240,C F1B36360
PL1240 TXI PL1250,B,0 F1B36370
PL1250 CAL SCRIPL,B F1B36380
PAX 0,C F1B36390
ANA MASK2 F1B36400
SUB SCRIPL+5,A F1B36410
TZE PL1340 SYM2(S(I)) = S(K) F1B36420
CLA BETA,C F1B36430
PAX 0,C F1B36440
PL1330 TXI PL1230,0,-6 F1B36450
PL1340 CAL SCRIPL+1,B SET OP2(S(I)) 32 = OP1 (S(K)) 32 F1B36460
ANA L(8) F1B36470
ORS SCRIPL+4,A F1B36480
TRA PL0000 RESUME SCAN F1B36490
REM DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B36500
REM PREFACE NAME OF LIBRARY SUBROUTINES FOR FLOATING POINT (DP) F1B36510
REM OPERATIONS BY D (EXAMPLE SIN BECOMES DSIN) F1B36520
REM OR PREFACE NAME OF SUBROUTINES WITH I IF COMPLEX ARITH F1B36530
REM MODE, FOR EXAMPLE SIN BECOMES ISIN. F1B36540
DP004 CLA MODECL F1B36550
SUB L(D) F1B36560
TZE DP0042 F1B36570
ITEST3 SUB L(5) TEST IF CPLX ARITH MODE. F1B36580
TNZ PL0650 F1B36590
DP0042 LDQ SCRIPL+2,1 F1B36600
PXD ,0 F1B36610
LGL 6 F1B36620
SUB L(X) F1B36630
REM FIXED POINT ERROR DETECTION F1B36640
TZE ERDP02 F1B36650
DP0045 CLA MODECL F1B36660
LDQ SCRIPL+2,1 GET NAME OF FUNCTION F1B36670
LGL 30 MOVE FIRST 5 CHARACTERS INTO AC. F1B36680
RQL 6 MOVE CHARACTER (IF ANY) TO LOW ORDER BITS F1B36690
XCL MOVE LAST CHARACTER INTO AC. F1B36700
SUB BLANK IF IT IS A BLANK, OK F1B36710
TZE DP0046 F1B36720
ERDP03 TSX DIAG,4 INCORRECTLY NAMED F1B36730
DP0046 XCL RETURN NAME TO AC. F1B36740
SLW SCRIPL+2,1 F1B36750
SLW G F1B36760
CORR05 AXT 0,2 F1B36770
LXA DOPSUB,4 INITIALIZE FOR TABLE SEARCH F1B36780
DP0047 LAS DOPSUB+1,2 BEGIN TABLE SEARCH F1B36790
TXI *+3,2,-1 CONTINUE F1B36800
TRA PL0240 F1B36810
TXI *+1,2,-1 CONTINUE F1B36820
TIX DP0047,4,1 F1B36830
TRA PL0521 F1B36840
REM F1B36850
LK0000 LXD AS3600,A -3Q TO XA F1B36860
LK0030 CAL SCRIPL-3,A F1B36870
PAX 0,B S(I) TO XB F1B36880
TXL LK1610,B,0 EXIT UPON ENCOUNTERING S(0) F1B36890
LDQ SCRIPL-2,A PLACE LAST OP OP S(I) IN MQ F1B36900
CLA BETA,B F1B36910
STD LK0110 F1B36920
LK0110 TXI LK0120,A,0 MOVE XA TO BEGINNING OF S(I) F1B36930
LK0120 LXD LK0130,C F1B36940
LK0130 TXI LK0140,5,0 XA TO XA,XC F1B36950
LK0140 SXD AS3600,A F1B36960
CLA BETA-1,B F1B36970
PDX 0,B LENGTH OF S(I-1) TO XB F1B36980
SXD LK0180,B F1B36990
LK0180 TXI LK0190,C,0 MOVE XC TO BEGINNING OF S(I-1) F1B37000
LK0190 TQP LK1200 S(I) TYPE AC F1B37010
RQL 1 F1B37020
TQP LK1200 S(I) TYPE AC F1B37030
CAL 12Z S(I) RESULTS IN MQ (TYPE MQ) F1B37040
ORS SCRIPL+1,A SET OP1 (S(I)) 31 = 1 F1B37050
CAL SCRIPL+1,C PLACE OP1 (S(I-1)) IN MQ F1B37060
LGR 30 F1B37070
CAS SPECOP F1B37080
TRA LK0320 F1B37090
TRA LK0950 F1B37100
TRA LK0030 S(I)TYPTMQ, S(I-1)TYPEAC . OP1(S(I))29=0 F1B37110
LK0320 TQP LK0570 F1B37120
LGL 27 S(I)TYPE MQ, OP1(S(I-1) = ** F1B37130
CAL SCRIPL,A F1B37140
ANA MASK2 EXTRACT S(I) IN ACC F1B37150
TQP LK0480 OP1 (S(I-1)) 33 = 0 F1B37160
SUB SCRIPL+2,C OP1 (S(I-1)) 33 = 1. OPEN ** SUBROUTINE. F1B37170
TNZ LK0030 SET OP1 (S(I)) 29 = OP1 (S(I-1)) 35 = 0 F1B37180
CAL L(3) S(I) = SYM1 (S(I-1)), SO F1B37190
LK0430 ORS SCRIPL+1,C F1B37200
LK0440 CAL BIT29 F1B37210
ORS SCRIPL+1,A F1B37220
TRA LK0030 OP1 (S(I-1)) = 0. CLOSED ** SUBROUTINE. F1B37230
LK0480 SUB SCRIPL+5,C F1B37240
TNZ LK0030 SET OP1(S(I))29=OP1(S(I-1))35=0 F1B37250
CAL L(1) S(I) = SYM2 (S(I-1)), SO F1B37260
ORS SCRIPL+4,C SET OP2 (S(I-1)) 35 = 1 F1B37270
TRA LK0440 F1B37280
LK0570 CAL SCRIPL+4,C S(I) TYPE MQ, OP1 (S(I-1)) = * F1B37290
LGR 30 PLACE PO2 (S(I-1)) IN MQ F1B37300
REM IS OP2 (S(I-1)) = * F1B37310
SUB STAR F1B37320
TNZ LK0030 NO - SET OP1 (S(I)) 29 = OP1 (S(I-1)) 35 =0F1B37330
CAL L(2) YES F1B37340
ORS SCRIPL+1,C SET OP1(S(I-1))34=1 F1B37350
LK0630 CAL SCRIPL,A F1B37360
ANA MASK2 SEARCH FOR S(I) IN S(I-1) F1B37370
LK0650 TXL LK0000,B,0 NOT FOUND AT ALL F1B37380
CAS SCRIPL-1,A F1B37390
TXI LK0700,A,3 F1B37400
TRA LK0710 F1B37410
TXI LK0700,A,3 NOT FOUND - CONTINUE SEARCH F1B37420
LK0700 TXI LK0650,B,-3 F1B37430
LK0710 LDQ SCRIPL-2,A S(I) IS SYMJ (S(I-1)) F1B37440
RQL 1 IS OPJ (S(I-1)) = * F1B37450
TQP LK0750 F1B37460
TXI LK0700,A,3 NO... CONTINUE SEARCH F1B37470
LK0750 CLA SCRIPL,C YES...PERMUTE EL1(S(I-1)) WITH ELJ(S(I-1)) F1B37480
LDQ SCRIPL-3,A EXCHANGE F1B37490
STO SCRIPL-3,A TAG F1B37500
STQ SCRIPL,C WORDS F1B37510
CAL SCRIPL+1,C PLACE OP1 (S(I-1)) IN ACC F1B37520
LDQ SCRIPL-2,A PLACE OPJ (S(I-1)) IN MQ F1B37530
SLW SCRIPL-2,A EXCHANGE F1B37540
STQ SCRIPL+1,C OP F1B37550
ANA MASK2 WORDS AND F1B37560
ORS SCRIPL+1,C SET OP1(S(I-1))30'33= OPJ(S(I-1))30'33 F1B37570
CLA SCRIPL+2,C THEN F1B37580
LDQ SCRIPL-1,A EXCHANGE F1B37590
STO SCRIPL-1,A SYMBOL F1B37600
STQ SCRIPL+2,C WORDS F1B37610
LXD AS3600,A RESTORE XA F1B37620
LK0900 CAL L(1) AND F1B37630
TRA LK0430 F1B37640
LK0950 RQL 27 S(I) TYPE MQ, OP1 (S(I-1)) = SPOP F1B37650
CAL SCRIPL,A F1B37660
ANA MASK2 EXTRACT S(I) IN ACC F1B37670
TQP LK1050 OP1 (S(I-1)) 33 = 0 (CLOSED SUBROUTINE) F1B37680
TXH LK0030,B,6 OPEN MULTIV... SET OP1 (S(I)) 29 = 0 F1B37690
SUB SCRIPL+5,C OPEN UNIV... IS S(I) = SUM2 (S(I-1)) F1B37700
TNZ LK0030 NO... SET OP1 (S(I))29 = OP2 (S(I-1))35 = 0F1B37710
CAL L(3) AND F1B37720
ORS SCRIPL+4,C SET OP2 (S(I-1))34 = OP2 (S(I-1))35 = 1 F1B37730
TRA LK0440 F1B37740
LK1050 RQL 15 F1B37750
TQP LK1100 TEST OP1(S(I-1))12 F1B37760
TRA LK0030 FN-NAME F1B37770
LK1100 TXL LK0030,B,6 CLOSED UNIV. SBRTN F1B37780
SUB SCRIPL+8,C CLOSED MULTIV. SBRTN F1B37790
TNZ LK0030 S(I) NOT = SYM3 (S (I-1)) F1B37800
CAL L(1) S(I) = SYM3 (S(I-1)), SO F1B37810
ORS SCRIPL+7,C SET OP3 (S(I-1))35 = 1 F1B37820
TRA LK0440 F1B37830
LK1200 PXD 0,0 S(I) TYPE AC F1B37840
LDQ SCRIPL+1,C PLACE OP1 (S(I-1)) IN MQ F1B37850
LGL 6 F1B37860
CAS SPECOP F1B37870
TRA LK1340 F1B37880
TRA LK1470 F1B37890
CAL SCRIPL,A S(I) TYPE AC, OP1 (S(I-1)) = + OR - F1B37900
ANA MASK2 SEARCH FOR S(I) IN S(I-1) F1B37910
LK1280 TXL LK0000,B,0 NOT FOUND AT ALL F1B37920
CAS SCRIPL-1,A F1B37930
TXI LK1330,A,3 F1B37940
TRA LK0750 S(I) = SOME SYMJ (S(I-1))... GO PERMUTE F1B37950
TXI LK1330,A,3 NOT FOUND... CONTINUE SEARCH F1B37960
LK1330 TXI LK1280,B,-3 F1B37970
LK1340 TQP LK1410 F1B37980
CAL SCRIPL,A S(I) TYPE AC, OP1 (S(I-1)) = ** F1B37990
ANA MASK2 F1B38000
SUB SCRIPL+2,C IS S(I) = SYM1 (S(I-1)) F1B38010
TNZ LK0030 NO F1B38020
TRA LK0900 YES F1B38030
LK1410 PXD 0,0 S(I) TYPE AC, OP1 (S(I-1)) = * F1B38040
LDQ SCRIPL+4,C F1B38050
LGL 6 IS OP2 (S(I-1)) = 1 F1B38060
SUB SLASH F1B38070
TZE LK0630 YES F1B38080
CLA MODECL FOR BOOLEAN MARK * AS TYPE AC. F1B38090
SUB L(B) F1B38100
TZE LK0630 F1B38110
CAL L(2) NO F1B38120
ORS SCRIPL+1,C SET OP1 (S(I-1)) 34 = 1 F1B38130
TRA LK0000 F1B38140
LK1470 RQL 27 S(I) TYPE AC, OP1 (S(I-1)) = SPOP F1B38150
CAL SCRIPL,A F1B38160
ANA MASK2 EXTRACT S(I) IN ACC F1B38170
TQP LK1530 F1B38180
TXH LK0030,B,6 OPEN MULTIV. F1B38190
LK1520 TRA LK0480 F1B38200
LK1530 RQL 15 F1B38210
TQP LK0480 F1B38220
TRA LK0030 FN-NAME F1B38230
LK1610 LXD BETA,B IS S(0) A SINGLE ELEMENT F1B38240
PXD 0,0 F1B38250
LDQ SCRIPL-2,A F1B38260
TXH LK1780,B,3 NO F1B38270
LGL 6 YES F1B38280
SUB 11Z IS OP (S(0)) = + OR - F1B38290
TZE LKK000 OP (S(0)) = - F1B38300
CAL SCRIPL+2 OP (S(0)) = + F1B38310
ANA MASK1 DOES SYM (S(0)) = S(1) F1B38320
TNZ LKK000 NO F1B38330
CAL SCRIPL+4 YES - PLACE OP1 (S(1)) IN ACC F1B38340
ANA 12Z F1B38350
TZE LKK000 OP1 (S(1)) 31 = 0 F1B38360
ORS SCRIPL+1 SET OP (S(0)) 31 = 1 F1B38370
ALS 2 F1B38380
ORS SCRIPL+4 SET OP1 (S(1)) 29 = 1 F1B38390
ARS 6 F1B38400
TRA LK1820 F1B38410
LK1780 TQP LKK000 S(0) TYPT AC F1B38420
RQL 1 F1B38430
TQP LKK000 S(0) TYPE AC F1B38440
CAL 12Z S(0) TYPE MQ, SO F1B38450
LK1820 ORS SCRIPL+1 F1B38460
LKK000 LXD 3LBAR,5 -3Q TO XA,XC F1B38470
CAL SCRIPL-3,C F1B38480
PAX 0,B F1B38490
CLA BETA,B F1B38500
STD LKK050 F1B38510
LKK050 TXI LKK060,C,0 BACK UP XA TO 1ST ELEMENT OF LAST SEGMENT F1B38520
LKK060 PXD 0,0 F1B38530
LDQ SCRIPL+1,C PLACE OP1 OF LAST SEGMENT IN MQ F1B38540
LGL 6 F1B38550
SUB STAR F1B38560
TNZ PC0000 F1B38570
TQP LKK130 F1B38580
TRA PC0000 F1B38590
LKK130 LDQ SCRIPL+4,C OP1 OF LAST SEGMENT IS * F1B38600
LGL 2 F1B38610
LBT F1B38620
ORS SCRIPL+1,C OP2 IS *, SO SET OP1 (S(L)) 34 = 1 F1B38630
PC0000 LXD ARGCTR,C IS THIS AN FS F1B38640
TXH PC0030,C,0 F1B38650
TXI PC0040,C,1 NO F1B38660
PC0030 LXA L(0),C YES F1B38670
PC0040 CAL SCRIPL-3,A F1B38680
PAX 0,B F1B38690
TXL MC0000,B,0 F1B38700
CLA BETA,B F1B38710
STD PC0100 F1B38720
PC0100 TXI PC0110,A,0 F1B38730
PC0110 LDQ SCRIPL+1,A PLACE OP1 (S(I)) IN MQ F1B38740
LGL 30 F1B38750
LBT F1B38760
PC0140 TXI PC0160,0,300 F1B38770
TQP PC0040 OP1 (S(I)) 29= 1 AND OP1 (S(I)) 30 = 0 F1B38780
PC0160 PXD 0,C OP1 (S(I)) 29 = 0 OR OP1 (S(I)) 30 = 1 F1B38790
STD BETA,B STORE ERAS. REL. ADD. COUNT IN BETA, F1B38800
TXI PC0040,C,1 AND UPDATE FOR NEXT SEGMENT F1B38810
REM DICTIONARY OF OPEN SUBROUTINES FOLLOWS F1B38820
OPSUB OCT 672122626060 XABS F1B38830
OCT 212262606060 ABS F1B38840
OCT 673145636060 XINT F1B38850
OCT 314563606060 INT F1B38860
OCT 674446246060 XMOD F1B38870
OCT 444624606060 MOD F1B38880
OCT 674421670060 XMAX0 F1B38890
OCT 442167016060 MAX1 F1B38900
OCT 674421670160 XMAX1 F1B38910
OCT 442167006060 MAX0 F1B38920
OCT 674431450060 XMIN0 F1B38930
OCT 443145016060 MIN1 F1B38940
OCT 674431450160 XMIN1 F1B38950
OCT 443145006060 MIN0 F1B38960
OCT 264346216360 FLOAT F1B38970
OCT 672631676060 XFIX F1B38980
OCT 623127456060 SIGN F1B38990
OCT 676231274560 XSIGN F1B39000
OCT 672431446060 XDIM F1B39010
OCT 243144606060 DIM F1B39020
BSS 10 EXPANSION SPACE FOR OPEN SUBROUTINE DICT. F1B39030
REM F1B39040
REM F1B39050
MC0000 LXD 3LBAR,A MODE CHECKING ROUTINE F1B39060
SXD MC0420,A F1B39070
LXA L(0),A F1B39080
MC0030 SXD XASAVE,A F1B39090
CAL SCRIPL,A F1B39100
PAX ,B S(I) TO XB F1B39110
CLA CPBETA,B F1B39120
PAX ,B F1B39130
SXD MC0410,B F1B39140
SXD MC0460,B F1B39150
TXH MC0410,B,-6 SINGLE ELEMENT - GO ONTO S(I+1) F1B39160
SLF TURN OFF ALL SENSE LITES F1B39170
PXD 0,0 CLEAR ACC F1B39180
LDQ SCRIPL+1,A PLACE OP1 (S(I)) IN MQ F1B39190
LGL 6 F1B39200
CAS SPECOP F1B39210
TQP MC0180 F1B39220
XASAVE TXI MC0410,0,0 F1B39230
MC0180 LGL 26 OP1 (S(I)) = +, - OR * F1B39240
TQP MC0210 FIX PT F1B39250
SLN 1 FLO PT F1B39260
MC0210 PXD 0,0 F1B39270
LDQ SCRIPL+2,A PLACE SYMJ (S(I)) IN MQ - J = 1,... F1B39280
LGL 1 F1B39290
LBT F1B39300
TQP MC0440 F1B39310
LGL 5 SYMJ (S(I)) IS A VARIABLE F1B39320
CAS L(H) F1B39330
CAS L(O) F1B39340
XBSAVE TXI MC0340,0,0 FLO PT F1B39350
TRA MC0340 FLO PT F1B39360
MC0310 SLT 1 SYMJ (S(I)) IS A FIX PT VARIABLE F1B39370
TXI MC0380,B,3 OK F1B39380
TRA *+2 F1B39390
MC0340 SLT 1 SYMJ(S(I)) IS A FLO PT VARIABLE F1B39400
ER0070 TSX DIAG,4 MIXED F1B39410
SLN 1 RESTORE FLO PT LITE F1B39420
TXI MC0380,B,3 F1B39430
MC0380 TXL MC0400,B,0 FINISHED WITH S(I) F1B39440
TXI MC0210,A,-3 CONTINUE SCANNING S(I). J TO J+1 F1B39450
MC0400 LXD XASAVE,A GO TO S(I+1) F1B39460
MC0410 TXI MC0420,A,0 F1B39470
MC0420 TXH MC0030,A,0 F1B39480
TRA CP0000 EXIT TO COMPILER F1B39490
MC0440 SXD XBSAVE,B SYMJ (S(ITT = SAME S(K) F1B39500
LXD XASAVE,C F1B39510
MC0460 TXI MC0470,C,0 MOVE XC TO 1ST ELEMENT OF S(I+1) F1B39520
MC0470 CAL SCRIPL,C F1B39530
ANA MASK2 EXTRACT S(K) IN ACC F1B39540
CAS SCRIPL+2,A AND COMPARE WITH SYMJ (S(I)) F1B39550
TRA MC0520 F1B39560
TRA MC0570 F1B39570
MC0520 PAX ,B S(K) TO XB F1B39580
CLA CPBETA,B F1B39590
PAX ,B F1B39600
SXD MC0560,B F1B39610
MC0560 TXI MC0470,C,0 F1B39620
MC0570 LXD XBSAVE,B SYMJ (S(I)) = S(K) FOR SOME K F1B39630
CAL SCRIPL+1,C PLACE OP1 (S(K)) IN ACC F1B39640
ARS 3 F1B39650
LBT F1B39660
TRA MC0310 S(K) IS FIX PT F1B39670
TRA MC0340 S(K) IS FLO PT F1B39680
REM F1B39690
REM COMPILER ROUTINE. F1B39700
REM HAVING DEVELOPED ALL NECESSARY LINKAGE AND OPTIMAZATION F1B39710
REM INFORMATION AND SET BITS IN EACH SCRIPL TABLE ENTRY ACCORD- F1B39720
REM INGLY, NOW MAKE ENTRIES IN THE COMPILED INSTRUCTION TABLE ON F1B39730
REM THE BASIS OF THESE SCRIPL TABLE ENTRIES. F1B39740
REM F1B39750
CP0000 SLF INITIALLY TURN OFF ALL LIGHTS AND CLEAR F1B39760
STZ FNSW CELL FOR FUNCTION SUBPROGRAM USAGE AND F1B39770
TRA CPPCH $F1B39780
LXD ARGCTR,4 TEST WHETHER THIS STATEMENT IS AN ARITH- F1B39790
TXL CP0090,4,0 METIC STATEMENT FUNCTION. F1B39800
TSX CIT00,4 YES, SO COMPILE CIT ENTRY OF 4 WORDS OF F1B39810
PZE ALL1,,ALL1 ONES AS LABEL FOR SECTION THREE. F1B39820
PZE ALL1,,ALL1 F1B39830
CP0090 LXD EIFNO,4 GET THE CURRENT INTERNAL FORMULA NUMBER F1B39840
STZ CW WHICH WILL BE COMPILED IN THE LOCATION WORDF1B39850
SXD CW,4 OF THE FIRST INSTRUCTION. ALSO SAVE FOR F1B39860
SXA CALLNM,4 POSSIBLE ENTRY IN FIRST AND LAST IFN TABLE.F1B39870
STZ BOOLIN TURN BOOLEAN INDICATOR OFF. F1B39880
CLA MODECL GET SPECIAL INDICATOR SYMBOL AND F1B39890
REM DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B39900
CAS L(D) F1B39910
TRA *+2 F1B39920
TRA CP000D DOUBLE PRECISION F1B39930
CAS L(I) F1B39940
TRA *+2 F1B39950
TRA CP000D F1B39960
CAS L(B) TEST FOR OTHER THAN NORMAL MODE. F1B39970
TRA *+2 F1B39980
STO BOOLIN YES, TURN BOOLEAN INDICATOR ON. F1B39990
REM F1B40000
LXD 3LBAR,1 LENGTH OF SCRIPL TABLE TO IR 1. F1B40010
REM INITIAL COMPILATION OF EACH LEVEL. F1B40020
CP0130 CLA SCRIPL-3,1 EXTRACT FROM TAG WORD OF LAST ENTRY OF NEXTF1B40030
PAX ,2 LEVEL THE LEVEL NUMBER. USING THIS GET THE F1B40040
CLA CPBETA,2 CORRESPONDING BETA TABLE ENTRY. SAVE THE F1B40050
STD PHI(I) DECREMENT AS ADDEND FOR 1( ERASABLE. F1B40060
ANA MASK2 SAVE THE ADDRESS WHICH IS LENGTH OF CURRENTF1B40070
PAX ,2 LEVEL. F1B40080
SXD CP0400,2 F1B40090
PAC 0,4 FORM TRUE LENGTH FROM COMPLEMENT AND MOVE F1B40100
SXD CP0240,4 IR 1 SO THAT IT WILL BE POSITIONED AT THE F1B40110
CP0240 TXI CP0250,1,** FIRST ENTRY IN CURRENT LEVEL. F1B40120
CP0250 SXD 3LBAR,1 SAVE IR 1 AS POSITION IN SCRIPL TABLE. F1B40130
CLA XCAIND ADD XCA LINKAGE INFORMATION,IF ANY, TO TAG F1B40140
ORS SCRIPL+1,1 WORD OF FIRST ENTRY OF CURRENT LEVEL. F1B40150
STZ XCAIND RESET XCA INDICATOR TO NO LINKAGE. F1B40160
LDQ SCRIPL+1,1 GET AND EXAMINE LINKAGE BITS IN OP WORD OF F1B40170
LGL 30 FIRST ENTRY OF CURRENT LEVEL. F1B40180
TQP *+2 IS THIS SEGMENT A COMMON SUBEXPRESSION. F1B40190
TRA CP0310 YES,MUST BE STORED. F1B40200
LBT IS IT LINKED BY EITHER AC OR MQ. F1B40210
TRA *+2 NO F1B40220
TRA CP0370 YES, SHOULD NOT BE STORED. F1B40230
CLA L(1) NEITHER A COMMON SUBEXPRESSION NOR LINKED. F1B40240
STO XCAIND POSSIBLITY OF USING XCA, SET INDICATOR SO. F1B40250
CP0310 SLN 1 TURN LIGHT 1 ON TO INDICATE NEED TO STORE F1B40260
RQL 1 RESULT OF THIS LEVEL COMPUTATION. F1B40270
TQP CP0350 TURN LIGHT 2 ON TO CALL FOR STQ INSTEAD OF F1B40280
SLN 2 STO. (BASED ON BIT 31 = 1) F1B40290
CP0350 RQL 1 GET AND EXAMINE F1B40300
TRA CP0380 BIT 32 OF F1B40310
CP0370 RQL 2 OP WORD OF F1B40320
CP0380 TQP CP0420 FIRST ENTRY OF CURRENT LEVEL. F1B40330
SLT 4 TURN LIGHT 4 ON TO INDICATE F1B40340
CP0400 TXH 0,0,** THAT CURRENT LEVEL IS FIXED POINT. F1B40350
TRA CP0430 F1B40360
CP0420 SLN 4 (BASED ON BIT 32 = 0) F1B40370
ZET BOOLIN TEST WHETHER THIS IS BOOLEAN... F1B40380
TRA BER001 YES, ERROR GO TO DIAGNOSTIC ROUTINE. F1B40390
CP0430 PXD 0,0 GET AND EXAMINE OP WORD OF FIRST ENTRY OF F1B40400
LDQ SCRIPL+1,1 CURRENT LEVEL FOR TYPE OF LEVEL. F1B40410
LGL 6 F1B40420
CAS SPECOP F1B40430
TXI CP0960,0,0 LEVEL IS * / OR **. F1B40440
TXI CP2040,1,-3 LEVEL IS FUNCTION. F1B40450
SUB 11Z LEVEL IS + -, WHICH OPERATION IS FIRST. F1B40460
TZE CP0760 OPERATION IS -. F1B40470
LGL 29 OPERATION IS +. IS INPUT IN AC. F1B40480
TQP CP1130 IF NOT IN AC GO COMPILE CLA. (BIT 35=0) F1B40490
CP0540 LXD CP0400,2 GET LENGTH OF THIS LEVEL AND TEST FOR ANY F1B40500
TXI CP0560,2,3 ENTRIES REMAINING TO BE COMPILED. IF NONE F1B40510
CP0560 TXL ES0000,2,0 GO TO THE END-OF-SEGMENT ROUTINE. F1B40520
SXD CP0400,2 IF SOME ENTRIES REMAIN, SAVE NEW REMAINING F1B40530
TXI CP0590,1,-3 LENGTH AND GO COMPILE NEXT ENTRY. F1B40540
CP0590 PXD 0,0 GET AND EXAMINE OP WORD OF THIS ENTRY. F1B40550
LDQ SCRIPL+1,1 OPERATION MAY BE + OR - OR * OR /. F1B40560
LGL 6 F1B40570
CAS STAR F1B40580
TRA CP1200 OPERATION IS / F1B40590
TRA CP1720 OPERATION IS * F1B40600
SUB 11Z F1B40610
TZE CP0880 OPERATION IS -. F1B40620
CAL L(FAD) OPERATION IS +. F1B40630
SLT 4 TEST LIGHT 4 FOR FIXED OR FLOATING POINT. F1B40640
TRA CP1680 FLOATING POINT, COMPILE FAD F1B40650
SLN 4 FIXED POINT, COMPILE ADD F1B40660
CAL L(ADD) AND LEAVE LIGHT 4 ON FOR LATER TEST. F1B40670
TRA CP1680 F1B40680
CP0760 LGL 29 FIRST OPERATION OF LEVEL IS -. IS INPUT IN F1B40690
TQP CP0850 AC, IF NOT GO COMPILE CLS. F1B40700
TSX CIT00,4 INPUT IN AC, COMPILE CHS. F1B40710
PZE L(0),,L(CHS) F1B40720
PZE L(0),,L(0) F1B40730
TRA CP0540 AND GO TO NEXT ENTRY IN LEVEL, IF ANY. F1B40740
CP0850 CAL L(CLS) FIRST OPERATION IN LEVEL IS - AND INPUT NOTF1B40750
CPBCOM TSX COMPM4,2 COMPILE CLS (CAL). F1B40760
NZT BOOLIN TEST WHETHER THIS IS BOOLEAN... F1B40770
TRA CP0540 NO. F1B40780
TSX CIT00,4 YES, COMPILE COM. F1B40790
PZE L(0),,L(COM) F1B40800
PZE L(0),,L(0) F1B40810
TRA CP0540 F1B40820
CP0880 CAL L(FSB) OPERATION IS -. F1B40830
SLT 4 TEST LIGHT 4 FOR FIXED OR FLOATING POINT. F1B40840
TRA CP1680 FLOATING POINT, COMPILE FSB. F1B40850
SLN 4 FIXED POINT, COMPILE SUB. F1B40860
CAL L(SUB) AND LEAVE LIGHT 4 ON FOR LATER TEST. F1B40870
TRA CP1680 F1B40880
CP0960 TQP CP0980 FIRST OPERATION IN LEVEL IS * OR **. F1B40890
TRA CP4140 TEST FOR WHICH. IF ** GO TO EXPONTENTIATIONF1B40900
CP0980 LGL 29 OPERATION OF FIRST ENTRY IS *. THIS MEANS F1B40910
SLN 3 A LEVEL OF * OR OF / OR OF * AND / F1B40920
LBT OPERATIONS. F1B40930
TRA CP1050 OP1 (S(I)) 34 = 0, SO LEAVE LITE 3 ON F1B40940
SLT 3 OP1 (S(I)) 34 = 1, SO TURN LITE 3 OFF F1B40950
TXH 0,0,0 F1B40960
CP1050 TQP CP1070 F1B40970
TRA CP0540 OP1 (S(I)) 35 = 1, SO GO MODIFY J F1B40980
CP1070 ZET BOOLIN TEST WHETHER THIS IS BOOLEAN... F1B40990
TRA CP1130 YES, GO COMPILE CLA (CAL). F1B41000
CAL L(LDQ) OP1 (S(I)) 35 = 0 F1B41010
SLT 3 F1B41020
TRA CP1680 F1B41030
SLN 3 EL1 (S(II) TO ACC F1B41040
CP1130 CAL L(CLA) F1B41050
TRA CP1680 F1B41060
CP1200 SLT 3 OPJ (S(I)) = / F1B41070
TRA CP1330 F1B41080
SLT 4 PREDECESSOR IN ACC F1B41090
TRA CP1670 FLO PT. F1B41100
SLN 4 FIX PT. RESTORE FXPTSW F1B41110
TSX CIT00,C COMPILE LRS 35 F1B41120
PZE L(0),,L(LRS) LOC,,OP-DEC F1B41130
PZE L(0),,DEC35 ADR,,RA-TAG F1B41140
TRA CP1450 F1B41150
CP1330 SLT 4 PREDECESSOR IN MQ F1B41160
TRA CP1570 AND SEGMENT IS F1B41170
SLN 4 FIX PT. RESTORE FXPTSW F1B41180
CP1450 CAL L(DVP) F1B41190
TSX COMPM4,B F1B41200
TSX CIT00,C COMPILE CLM F1B41210
PZE L(0),,L(CLM) LOC,,OP-DEC F1B41220
PZE L(0),,L(0) ADR,,RA-TAG F1B41230
TSX CIT00,C COMPILE LLS 18 F1B41240
PZE L(0),,L(LLS) LOC,,OP-DEC F1B41250
PZE L(0),,DEC18 ADR,,RA-TAG F1B41260
TRA CP0540 GO MODIFY J F1B41270
CP1570 TSX COMP0C,2 COMPILE XCA F1B41280
CP1670 CAL L(FDP) F1B41290
CP1680 SLW CW+1 F1B41300
CP1690 TSX COMPM3,2 F1B41310
TRA CP0540 GO MODIFY J F1B41320
CP1720 NZT BOOLIN TEST WHETHER THIS IS BOOLEAN... F1B41330
TRA *+2 NO. F1B41340
SLT 3 BOOLEAN, TURN OFF LITE 3 TO AVOID XCA F1B41350
SLT 3 OPJ(S(I))=* F1B41360
TRA CP1840 F1B41370
TSX COMP0C,2 COMPILE XCA F1B41380
CP1840 SLN 3 TURN LATE 3 ON F1B41390
SLT 4 F1B41400
TRA CP2000 F1B41410
SLN 4 FIX PT. RESTORE FXPTSW F1B41420
CAL L(MPY) F1B41430
TSX COMPM4,B F1B41440
TSX CIT00,C COMPILE ALS 17 F1B41450
PZE L(0),,L(ALS) LOC,,OP-DEC F1B41460
PZE L(0),,DEC17 ADR,,RA-TAG F1B41470
TRA CP0540 GO MODIFY J F1B41480
CP2000 CAL L(FMP) F1B41490
TRA CP1680 F1B41500
REM ** FUNCTION COMPILATION ** F1B41501
CP2040 LGL 7 OP1(S(I))=SPOP F1B41510
LBT TEST OP1(S(I))12 F1B41520
TQP CP2650 LIB OR OPEN FUNCTION F1B41530
TQP CP5000 FUNCTION SUBPROGRAM (FNII) F1B41540
PXD 0,0 ARITHMETIC STATEMENT FUNCTION F1B41550
LLS 15 PUT TYPE NO IN ADD(ACC) F1B41560
ORA P( FORM 4...TYPE NO. F1B41570
SLW ARGORG AND STO IN ARGORG F1B41580
ANA MASK2 F1B41590
ORA X( FORM 7...TYPE NO. F1B41600
SLW XRSAVE AND STO IN XRSAVE F1B41610
CLA SCRIPL+1,A F1B41620
LBT EXAMINE OP2(S(I))35 F1B41630
TRA CP2150 1ST ARG STORED F1B41640
CP2100 TSX CIT00,C 1ST ARG IN ACC F1B41650
PZE L(0),,L(STO) LOC,,OP-DEC F1B41660
PZE ARGORG,,L(0) ADR,,RA-TAG F1B41670
TXI CP2200,A,-3 GO ON TO OP3(S(I)) F1B41680
CP2150 CAL L(CLA) F1B41690
TSX COMPM4,B F1B41700
TRA CP2100 F1B41710
CP2200 LXD CP0400,B F1B41720
TXI CP2230,B,3 F1B41730
CP2230 TXH CP2500,B,-6 FINISHED WITH S(I) F1B41740
SXD CP0400,B F1B41750
CLA SCRIPL+1,A F1B41760
LBT EXAMINE OP3(S(I))35 F1B41770
TRA CP2300 2ND ARG STORED F1B41780
CP2250 TSX CIT00,C 2ND ARG IN MQ F1B41790
PZE L(0),,L(STQ) LOC,,OP-DEC F1B41800
PZE ARGORG,,2E18 ADR,,RA-TAG F1B41810
TXI CP2350,A,-3 GO ON TO SYM4(S(I)) F1B41820
CP2300 CAL L(LDQ) F1B41830
TSX COMPM4,B F1B41840
TRA CP2250 F1B41850
CP2350 CLA DECMI2 INITIALIZE DEC(P(CNTR) TO 2 F1B41860
SLW P(CNTR F1B41870
CP2370 LXD CP0400,B F1B41880
TXI CP2390,B,3 F1B41890
CP2390 TXH CP2500,B,-6 FINISHED WITH S(I) F1B41900
SXD CP0400,B F1B41910
CAL L(CLA) F1B41920
TSX COMPM4,B F1B41930
TSX CIT00,C COMPILE STO 4...TYPE NO. + J-2, J=4,... F1B41940
PZE L(0),,L(STO) LOC,,OP-DEC F1B41950
PZE ARGORG,,P(CNTR ADR,,RA-TAG F1B41960
CLA P(CNTR UPDATE P(CNTR F1B41970
ADD 2E18 F1B41980
STO P(CNTR F1B41990
TXI CP2370,A,-3 F1B42000
CP2500 LXD 3LBAR,A FINISHED WITH S(I) F1B42010
CAL SCRIPL+2,A RETURN TO FIRST ELEMENT OF SEGMENT AND GET F1B42020
SLW CW+2 NAME OF FUNCTION FOR TSX ....,4 F1B42030
LXD ARGCTR,4 DETERMINE WHETHER IN AN ARITHMETIC FUNCTIONF1B42040
TXL CP2600,4,0 OR NOT. F1B42050
TSX PCH2,4 GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX $F1B42060
PZE L(0),,L(SXD) F1B42070
PZE XRSAVE,,L(4) SXD 7(I,4 F1B42080
TSX CIT00,4 F1B42090
PZE L(0),,L(TSX) TSX ....,4 F1B42100
PZE CW+2,,L(4) F1B42110
TSX FLTR00,4 COMPILE FLOW TRACING INSTRUCTIONS AND THEN F1B42120
PZE L(0),,L(LXD) F1B42130
PZE XRSAVE,,L(4) LXD 7(I,4 F1B42140
TRA ES0000 AND GO TO END OF SEGMENT ROUTINE. F1B42150
CP2600 TSX COMP0A,2 NOT IN AN ARITHMETIC FUNCTION, COMPILE F1B42160
TSX CIT00,4 SXD 6(+4,4 F1B42170
PZE L(0),,L(TSX) TSX ....,4 F1B42180
PZE CW+2,,L(4) F1B42190
TSX FLTR00,4 COMPILE FLOW TRACING INSTRUCTIONS AND THEN F1B42200
PZE L(0),,L(LXD) LXD 6(+4,4 F1B42210
PZE O(,,D4A4 F1B42220
CP5830 TXI ES0000,0,** F1B42230
REM ** LIBRARY (OR OPEN) SUBROUTINE ** F1B42231
CP2650 LGL 20 TEST OP1(S(I))33 F1B42240
TQP CP3060 0... LIB. SBRTN F1B42250
TSX OPENSB,4 USE SUBROUTINE TO COMPILE CALLING SEQUENCE.F1B42260
TRA ES0000 F1B42270
CP3060 TXL CP3350,B,-9 F1B42280
CLA SCRIPL+1,A CLOSED UNIVARIATE FUNCTION F1B42290
LBT EXAMINE OP2(S(I))35 F1B42300
TRA CP3280 0... ARG STORED F1B42310
CP3100 LXD ARGCTR,4 DETERMINE WHETHER THIS IS AN ARITHMETIC F1B42320
TXL CP3200,4,0 FUNCTION BEING COMPILED. F1B42330
TSX COMP0B,2 YES, COMPILE SXD 7(,4 F1B42340
TRA *+2 F1B42350
CP3200 TSX COMP0A,2 NOT A FUNCTION, COMPILE SXD 6(+4,4 F1B42360
CLA SCRIPL-1,1 GET NAME OF FUNCTION FOR TSX ....,4 F1B42370
STO CW+2 F1B42380
TSX CIT00,4 COMPILE F1B42390
PZE L(0),,L(TSX) TSX ....,4 F1B42400
PZE CW+2,,L(4) F1B42410
TRA CP5010 GO COMPILE PROPER LXD F1B42420
CP3280 CAL L(CLA) F1B42430
TSX COMPM4,B F1B42440
TRA CP3100 GO COMPILE SXD,TSX,LXD SEQUENCE F1B42450
CP3350 TXL CP3560,B,-12 F1B42460
CLA SCRIPL+1,A CLOSED BIVARIATE FUNCTION F1B42470
LBT EXAMINE OP2(S(I))35 F1B42480
TRA CP3450 0... ARG1 STORED F1B42490
CP3390 CAL L(LDQ) 1... ARG1 IN ACC F1B42500
TXI CP3420,A,-3 F1B42510
CP3420 TSX COMPM4,B F1B42520
TXI CP3100,A,3 GO COMPILE SXD,TSX,LXD SEQUENCE F1B42530
CP3450 CLA SCRIPL+4,A F1B42540
LBT EXAMINE OP3(S(I))35 F1B42550
TRA CP3490 0... ARG2 STORED F1B42560
TRA CP3280 1... ARG2 IN MQ F1B42570
CP3490 CAL L(CLA) F1B42580
TSX COMPM4,B F1B42590
TRA CP3390 GO COMPILE LDQ,SXD,TSX,LXD SEQUENCE F1B42600
CP3560 CLA SCRIPL+1,A CLOSED MULTIVARIATE FUNCTION F1B42610
LBT EXAMINE OP2(S(I))35 F1B42620
TXI CP3820,A,-6 0... ARG1 STORED F1B42630
TXI CP3600,A,-6 1... ARG1 IN ACC F1B42640
CP3600 CLA DECMI2 F1B42650
STO P(CNTR INITIALIZE P(CNTR TO -2 F1B42660
CP3620 CAL L(LDQ) F1B42670
TSX COMPM4,B F1B42680
TSX CIT00,C COMPULE STQ P(, I F1B42690
PZE L(0),,L(STQ) LOC,,OP-DEC F1B42700
PZE P(,,P(CNTR ADR,,RA-TAG F1B42710
CLA P(CNTR F1B42720
SUB 2E18 F1B42730
STO P(CNTR F1B42740
LXD CP0400,B F1B42750
TXI CP3770,B,3 F1B42760
CP3770 TXL CP3800,B,-12 F1B42770
LXD 3LBAR,A FINISHED WITH ARG VECTOR F1B42780
TXI CP3390,A,-3 F1B42790
CP3800 SXD CP0400,B F1B42800
TXI CP3620,A,-3 GO PICK UP NEXT ARG. F1B42810
CP3820 CLA SCRIPL-2,A F1B42820
LBT EXAMINE OP3(S(I))35 F1B42830
TXI CP4070,A,6 0... ARG2 STORED F1B42840
CLA DECMI2 1... ARG2 IN MQ F1B42850
STO P(CNTR F1B42860
CP3870 CAL L(CLA) F1B42870
TSX COMPM4,B F1B42880
TSX CIT00,C COMPILE STO P(, I F1B42890
PZE L(0),,L(STO) LOC,,OP-DEC F1B42900
PZE P(,,P(CNTR ADR,,RA-TAG F1B42910
CLA P(CNTR F1B42920
SUB 2E18 F1B42930
STO P(CNTR F1B42940
LXD CP0400,B F1B42950
TXI CP4020,B,3 F1B42960
CP4020 TXL CP4050,B,-12 F1B42970
LXD 3LBAR,A FINISHED WITH ARG VECTOR F1B42980
TXI CP3280,A,-3 F1B42990
CP4050 SXD CP0400,B F1B43000
TXI CP3870,A,-3 GO PICK UP NEXT ARG F1B43010
CP4070 CAL L(CLA) F1B43020
TSX COMPM4,B F1B43030
TXI CP3600,A,-6 F1B43040
REM ** COMPILE EXPONENTIATION SEGMENT ** F1B43041
CP4140 LGL 27 OP1(S(I))=** F1B43050
TQP CP4410 CLOSED SBRTN SINCE OP1(S(I))33=0 F1B43060
LBT * OPEN SUBROUTINE BIT 33=1 F1B43070
TRA CP4200 BASE FIX PT SINCE OP1(S(I))32=0 F1B43080
CLA STRSTR BASE FLO PT SINCE OP1(S(II))32=1 F1B43090
TRA CP4210 F1B43100
CP4200 CLA ADSTAR F1B43110
CP4210 STO CW+1 F1B43120
LGL 2 EXAMINE OP1(S(I))35 F1B43130
TQP CP4310 0... BASE STORED F1B43140
LDQ ADSTAR 1... BASE NOT STORED F1B43150
LBT EXAMINE OP1(S(I))34 F1B43160
LDQ ADPLUS 0... BASE IN ACC F1B43170
STQ CW+2 1...BASE IN MQ F1B43180
STZ CW+3 F1B43190
TRA CP4320 F1B43200
CP4310 TSX AC0000,C ADDRESS COMPILE SYM1(S(I)) F1B43210
CP4320 CLS CW F1B43220
STO CW CW TO -CW F1B43230
TSX COMP,B COMPILE BASE F1B43240
CLA SCRIPL+5,A F1B43250
STO CW+2 F1B43260
TSX COMP,B COMPILE FIX PT CONSTANT EXPONENT F1B43270
STZ CW+1 RESET CW+1 F1B43280
TRA ES0000 F1B43290
CP4410 LGL 3 * CLOSED EXP. SBRTN F1B43300
LBT EXAMINE OP1(S(I))35 F1B43310
TRA CP4860 0... BASE STORED F1B43320
CP4440 CAL L(LDQ) 1... BASE IN ACC. F1B43330
TXI CP4470,A,-3 F1B43340
CP4470 TSX COMPM4,B F1B43350
CP4490 LXD ARGCTR,4 DETERMINE WHETHER AN ARITHMETIC FUNCTION ISF1B43360
TXL CP4500,4,0 IS BEING COMPILED. F1B43370
TSX COMP0B,2 YES, COMPILE SXD 7(,4 F1B43380
TRA *+2 F1B43390
CP4500 TSX COMP0A,2 NO, COMPILE SXD 6(+4,4 F1B43400
CLA SCRIPL+1,A F1B43410
ARS 3 F1B43420
LBT EXAMINE OP2(S(I))32 F1B43430
TXI CP4660,A,3 0... F1B43440
CLA FLFL 1... FLO**FLO F1B43450
LDQ SCRIPL-2,A EXAMINE OP1(S(I))32 TO CHECK F1B43460
RQL 32 FOR MIXED EXPONENTIAL EXPRESSION F1B43470
TQP MC0310+2 ERROR FIX PT BASE, FLOAT EXP. F1B43480
TRA CP4730 F1B43490
CP4660 LDQ SCRIPL+1,A F1B43500
RQL 32 EXAMINE OP1(S(I))32 F1B43510
CLA FXFX F1B43520
TQP CP4730 0...FX**FX F1B43530
CLA FLFX 1... FL**FX F1B43540
CP4730 STO G FOR CLOSUB ENTRY AND FOR TSX ....,4 F1B43550
TSX CIT00,4 COMPILE F1B43560
PZE L(0),,L(TSX) TSX ....,4 F1B43570
PZE G,,L(4) F1B43580
TSX TET00,A F1B43590
HTR 9 F1B43600
TRA CP5010 F1B43610
CP4860 CAL L(CLA) F1B43620
TSX COMPM4,B F1B43630
CLA SCRIPL+4,A F1B43640
LBT EXAMINE OP2(S(I))35 F1B43650
TXI CP4440,0,0 0...EXP STORED F1B43660
TXI CP4490,A,-3 1... EXP IN MQ F1B43670
CP5000 TSX FNIISB,4 USE SUBROUTINE TO COMPILE CALLING SEQUENCE.F1B43680
CP5010 LXD ARGCTR,4 DETERMINE WHETHER THIS IS AN ARITHMETIC F1B43690
TXL CP5020,4,0 FUNCTION BEING COMPILED. F1B43700
TSX FLTR00,4 COMPILE FLOW TRACING INSTRUCTIONS AND THEN F1B43710
PZE L(0),,L(LXD) LXD 7(,4 F1B43720
PZE X(,,L(4) F1B43730
TRA ES0000 GO TO END OF SEGMENT ROUTINE. F1B43740
CP5020 TSX FLTR00,4 COMPILE FLOW TRACING INSTRUCTIONS AND THEN F1B43750
PZE L(0),,L(LXD) LXD 6(+4,4 F1B43760
PZE O(,,D4A4 F1B43770
REM F1B43780
REM END OF SEGMENT ROUTINE. F1B43790
ES0000 LXD 3LBAR,A -3Q TO XA F1B43800
SLT 1 IS A STORE NEEDED F1B43810
TRA CP0130 NO, GO TO NEXT SEGMENT F1B43820
CAL SCRIPL,A YES, ARE WE AT LEVEL ZERO F1B43830
ANA MASK2 F1B43840
TZE ES0160 TRA=YES F1B43850
ZET XCAIND WAS XCA INDICATOR SET. F1B43860
TRA ESXCA0 YES, POSSIBILITY OF USING XCA. F1B43870
CLA ARERAS S(I) NOT = S(0) F1B43880
STO CW+2 F1B43890
CLA PHI(I) F1B43900
STO CW+3 F1B43910
CAL L(STQ) F1B43920
SLT 2 IS STQ LITE ON F1B43930
CAL L(STO) F1B43940
TSX COMPM2,B COMPILE STO/STQ 1... TYPE NO + PHI(I) F1B43950
TRA CP0130 GO TO NEXT SEGMENT F1B43960
ES0160 LDQ LEFT+2 S(I)=S(0) F1B43970
LGL 12 F1B43980
CAS IFSYM IS THIS AN IF STATEMENT F1B43990
TRA ES0200 F1B44000
TRA ES1500 F1B44010
ES0200 CAS CALLER IS THIS A CALL STATEMENT F1B44020
TRA ES0220 F1B44030
TRA ES1520 F1B44040
ES0220 ARS 6 F1B44050
LXD ARGCTR,C IS THIS A FUNCTION STATEMENT F1B44060
TXH ES1300,C,0 YES F1B44070
CAS L(H) NOT A FUNCTION STATEMENT F1B44080
CAS L(O) F1B44090
TRA ES0300 F1B44100
TRA ES0300 F1B44110
SLT 4 F1B44120
TRA ES0870 F1B44130
ES0710 CLA L(STQ) FX(FLO) PT ON LEFT, FX(FLO) PT ON RIGHT F1B44140
SLT 2 F1B44150
ES0730 CLA L(STO) F1B44160
STO CW+1 F1B44170
TSX AC0M60,C ADDRESS COMPILE VARIABLE ON LEFT F1B44180
TSX COMP,B COMPILE STO/STQ LEFT+2 F1B44190
TRA ES1590 EXIT TO FETCH STATE A F1B44200
ES0870 SLT 2 FX PT ON LEFT, FLO PT ON RIGHT F1B44210
TRA ES0990 F1B44220
TSX COMP0C,2 COMPILE XCA F1B44230
ES0990 TSX CIT00,C COMPILE FIXING INSTRUCTIONS, WHEN F1B44240
PZE L(0),,L(UFA) LOC,,OP-DEC F1B44250
PZE O(,,L(0) ADR,,RA-TAG F1B44260
TSX CIT00,C F1B44270
PZE L(0),,L(LRS) LOC,,OP-DEC F1B44280
PZE L(0),,L(0) ADR,,RA-TAG F1B44290
TSX CIT00,C F1B44300
PZE L(0),,L(ANA) LOC,,OP-DEC F1B44310
PZE O(,,2E18 ADR,,RA-TAG F1B44320
TSX CIT00,C F1B44330
PZE L(0),,L(LLS) LOC,,OP-TAG F1B44340
PZE L(0),,L(0) ADR,,RA-TAG F1B44350
TSX CIT00,C F1B44360
PZE L(0),,L(ALS) LOC,,OP-DEC F1B44370
PZE L(0),,DEC18 ADR,,RA-TAG F1B44380
TRA ES0610 F1B44390
ES0300 SLT 4 F1B44400
TRA ES0710 F1B44410
ES0320 SLT 2 F1B44420
TRA ES0440 F1B44430
TSX COMP0C,2 COMPILE XCA F1B44440
ES0440 TSX CIT00,C COMPILE FLOATING INSTRUCTIONS, WHEN F1B44450
PZE L(0),,L(LRS) LOC,,OP-DEC F1B44460
PZE L(0),,DEC18 ADR,,RA-TAG F1B44470
TSX CIT00,C F1B44480
PZE L(0),,L(ORA) LOC,,OP-DEC F1B44490
PZE O(,,L(0) ADR,,RA-TAG F1B44500
TSX CIT00,C F1B44510
PZE L(0),,L(FAD) LOC,,OP-DEC F1B44520
PZE O(,,L(0) ADR,,RA-TAG F1B44530
ES0610 LXD ARGCTR,C IS THIS A FUNCTION STATEMENT F1B44540
TXL ES0730,C,0 NO F1B44550
ES0630 TSX PCH2,4 GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX $F1B44560
PZE L(0),,L(TRA) LOC,,OP-DEC F1B44570
PZE L(0),,ABTAG1 ADR,,RA-TAG F1B44580
TRA ES1590 EXIT TO FETCH STATE A F1B44590
REM ** FUNCTION SUBPROGRAM ** F1B44591
ES1300 SUB L(X) TEST FIXED OR FLOAT F1B44600
TZE ES1360 F1B44610
SLT 4 F1B44620
TRA ES1380 FLO NAME, FLO RESULT, STORE IT. F1B44630
TRA ES0320 FLO NAME, FIX RESULT, GO FLOAT IT. F1B44640
ES1360 SLT 4 FIX NAME, F1B44650
TRA ES0870 FLO RESULT, GO FIX IT. F1B44660
ES1380 SLT 2 FIX NAME, FIX RESULT, STORE IT F1B44670
TRA ES0630 F1B44680
TSX COMP0C,2 COMPILE XCA F1B44690
TRA ES0630 F1B44700
REM ** IF STATEMENT ** F1B44701
ES1500 TRA PCH4 GO TO PROGRAM TET $F1B44710
TSX DBCHK,4 GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX $F1B44720
REM ** IF AND CALL STATEMENT ** F1B44721
ES1520 SLT 2 F1B44730
TRA ES1590 EXIT TO FETCH STATE A F1B44740
TSX COMP0C,2 COMPILE XCA F1B44750
ES1590 CLA FNSW F1B44760
STZ LEFT+2 F1B44770
TRA ES1595 TO RESET ARITHMETIC FORTAG FLAG. (23)F1B44780
STD CALLNM F1B44790
TSX TET00,1 MAKE ENTRY OF FIRST, LAST IFN IN CALL TABLEF1B44800
16 F1B44810
TRA CHSIFN F1B44820
REM F1B44830
ESXCA0 CLA SCRIPL-3,1 IS FIRST ELEMENT OF NEXT SEGMENT LEVEL F1B44840
PAX ,2 NUMBER, IF NOT XCA IMPOSSIBLE. F1B44850
CLA CPBETA,2 F1B44860
PAC ,4 LENGTH OF NEXT LEVEL TO IR4. F1B44870
SXD *+1,4 F1B44880
TXI *+1,1,** BUMP IR1 TO BEGINNING OF NEXT SEGMENT. F1B44890
CAL SCRIPL+1,1 GET OP1 OF NEXT LEVEL AND TEST FOR ** OR $ F1B44900
LGR 30 DO NOT COMPILE XCA FOR EITHER CASE. F1B44910
SUB SPECOP F1B44920
TZE ESXCA1 F1B44930
TQP *+2 F1B44940
TRA ESXCA1 F1B44950
CLA SCRIPL,1 GET TAGWORD OF FIRST ELEMENT OF NEXT SEG- F1B44960
TPL ESXCA1 MENT AND TEST FOR SUBSCRIPTED VAR., EXIT IFF1B44970
REM YES. F1B44980
LDQ SCRIPL+2,1 GET SYMBOL WORD AND TEST FOR LEVEL NUMBER. F1B44990
LGL 1 F1B45000
LBT F1B45010
TQP *+2 F1B45020
TRA ESXCA1 ANYTHING OTHER THAN LEVEL NUMBER EXCLUDES F1B45030
REM XCA, EXIT. F1B45040
LGL 35 F1B45050
PAX ,2 F1B45060
CAL CPBETA,2 IS LEVEL NUMBER BEGINNING THIS SEGMENT F1B45070
ANA MASK1 SAME AS LEVEL NUMBER ENDING PREVIOUS SEG- F1B45080
SUB PHI(I) MENT. IF NOT XCA IS EXCLUDED. F1B45090
TNZ ESXCA1 F1B45100
REM ALL CONDITIONS HAVE BEEN SATISFIED. F1B45110
TSX COMP0C,2 COMPILE XCA. F1B45120
SLT 2 TURN LITE I OFF. F1B45130
NOP F1B45140
TRA CP0130-1 GO TO NEXT SEGMENT. F1B45150
REM SOME CONDITION FAILED, XCA EXCLUDED. F1B45160
ESXCA1 LXD 3LBAR,1 RELOAD IR1 F1B45170
STZ XCAIND CLEAR INDICATOR OF LINKED BIT. F1B45180
TRA ES0000+8 GO COMPILE STO OR STQ 1(+I F1B45190
REM F1B45200
REM F1B45210
OPENSB SXA CP2890,4 SAVE CALLING TAG. F1B45220
CLS CW 1... OPEN SBRTN F1B45230
STO CW CW TO -CW F1B45240
CLA SCRIPL-1,A F1B45250
STO CW+2 F1B45260
PATF CAL L(PZE) SET OPERATION CODE TO PZE. F1B45270
SLW CW+1 F1B45280
TSX COMP,B COMPILE FUNCTION NAME F1B45290
LXD CP0400,B F1B45300
TXL CP2930,B,-9 F1B45310
CAL ALL1 OPEN UNIVARIATE FUNCTION F1B45320
SLW CW F1B45330
CLA SCRIPL+1,A F1B45340
LBT EXAMINE OP2(S(I))35 F1B45350
TRA CP2900 0... ARG STORED F1B45360
ARS 1 1... ARG NOT STORED F1B45370
LDQ ADPLUS F1B45380
LBT F1B45390
TRA CP2860 F1B45400
LDQ ADSTAR F1B45410
CP2860 STQ CW+2 F1B45420
STZ CW+3 F1B45430
CP2880 TSX COMP,B COMPILE ACC OR MQ INDICATOR F1B45440
CP2890 AXT ..,4 RELOAD CALLING TAG. F1B45450
TRA 1,4 RETURN TO CALLER. F1B45460
CP2900 TSX AC0000,C ADDRESS COMPILE SYM2(S(I)) F1B45470
TRA CP2880 GO COMPILE SYM2(S(I)) F1B45480
CP2930 TSX AC0000,C OPEN MULTIVARIATE FUNCTION F1B45490
LXD CP0400,B F1B45500
TXI CP2960,B,3 F1B45510
CP2960 TXH CP3000,B,-6 F1B45520
SXD CP0400,B F1B45530
TSX COMP,B COMPILE SYMJ(S(I)) F1B45540
TXI CP2930,A,-3 F1B45550
CP3000 CAL ALL1 F1B45560
SLW CW F1B45570
TRA CP2880 F1B45580
REM F1B45590
FNIISB SXA CP5780,4 SAVE CALLING TAG. F1B45600
STZ FNSW2 INITIALIZE SUPP IFN SWITCH. (23)F1B45610
TRA *+2 (23)F1B45620
FNSW2 ,,** (23)F1B45630
LXA L(1),C INITIALIZE STAIX TO 1 F1B45640
CP5050 CLA SCRIPL,A EXAMINE TAGJ(S(I)), J=2,... F1B45650
TMI CP8000 NON-SUBSCRIPTED VARIABLE F1B45660
SXD CP5830,B SUBSCRIPTED-IS THERE A GENERAL TAG F1B45670
SXD STACTR,C F1B45680
TSX AC0000,C F1B45690
CAL TAGPRT F1B45700
TNZ CP5220 GENERAL TAG PRESENT F1B45710
CAL CW+3 NO GENERAL TAG PRESENT,SO PLACE F1B45720
ARS 11 RELATIVE ADDRESS IN OPJ(S(I))14'28 AND F1B45730
ORA NGTBIT SET OPJ(S(I))10=1 FROM NGTBIT F1B45740
ORS SCRIPL+1,A F1B45750
CP5160 LXD STACTR,C F1B45760
LXD CP5830,B F1B45770
CP5180 TXI CP5190,B,3 F1B45780
CP5190 TXH CP5460,B,-6 FINISHED WITH PRELUDE,IF ANY F1B45790
TXI CP5210,C,1 NOT FINISHED-STAIX=STAIX+1 F1B45800
CP5210 TXI CP5050,A,-3 GO ON TO NEXT ARGUMENT F1B45810
CP5220 CAL L(PXA) F1B45820
TSX COMPM2,B COMPILE PXD SYMJ(S(I)), TAGJ(S(I)) F1B45830
TSX CIT00,C COMPILE ADD *-2 F1B45840
PZE L(0),,L(SUB) LOC,,OP-DEC F1B45850
PZE PROCTR,,DECMI1 ADR,,RA-TAG F1B45860
LXD EIFNO,C COMPUTE VALUE OF (23)F1B45870
TXI CP5221,C,1 NEEDED SUPP IFN. (23)F1B45880
CP5222 SLW CW+2 STORE IT FOR STA INSTR. (23)F1B45890
LXD STACTR,C F1B45900
PXD 0,C F1B45910
SLW CW+3 F1B45920
CAL L(STA) F1B45930
TSX COMPM2,B COMPILE STA IFN+STAIX F1B45940
TXI CP5160,0,0 GO ON TO NEXT ARGUMENT,IF ANY F1B45950
CP5460 LXD 3LBAR,A F1B45960
LXD ARGCTR,4 DETERMINE WHETHEN AN ARITHMETIC FUNCTION F1B45970
TXL CP5470,4,0 IS BEING COMPILED. F1B45980
TSX COMP0B,2 YES, COMPILE SXD 7(,4 F1B45990
TSX CIT00,C COMPILE STRING OF ONES FOR SEC. THREE. F1B46000
PZE ALL1,,ALL1 F1B46010
PZE ALL1,,ALL1 F1B46020
TRA *+2 F1B46030
CP5470 TSX COMP0A,2 NO, COMPILE SXD 6(+4,4 F1B46040
CP5520 CAL FNSW2 PICK UP SUPPLEMENTAL IFN (23)F1B46050
SLW CW AND STORE FOR LOCATION FIELD. (23)F1B46060
TNZ CP5521 WAS IT NEEDED, YES. (23)F1B46070
CAL SCRIPL+2,A F1B46080
SLW CW+2 F1B46090
TSX CIT00,4 COMPILE F1B46100
PZE CW,,L(TSX) TSX ...,4 F1B46110
PZE CW+2,,L(4) F1B46120
STZ CW CLEAR CW OF IFN. F1B46130
CLA L(TSX) SET OPERATION CODE FOR ARGUMENTS TO TSX. F1B46140
STO CW+1 F1B46150
TXI CP5680,A,-3 POSITION XA TO SYM2(S(I)) F1B46160
CP5680 CLA SCRIPL,A F1B46170
TPL CP5700 F1B46180
CORR08 CLA MODECL TEST FOR DOUBLE PRECISION F1B46190
SUB L(D) F1B46200
TZE DPMD F1B46210
SUB L(5) OR COMPLEX ARITHMETIC F1B46220
TZE DPMD F1B46230
TSX AC0000,C NONSUBSCRIPTED F1B46240
TRA *+2 F1B46250
REM F1B46260
DPMD TSX ACDP00,4 F1B46270
STACTR TXI CP5720,0,0 F1B46280
CP5700 LDQ SCRIPL+1,A SUBSCRIPTED F1B46290
LGL 11 F1B46300
LBT F1B46310
LDQ L(0) GENERAL TAG PRESENT F1B46320
STQ CW+3 NO GENERAL TAG PRESENT F1B46330
CAL SCRIPL+2,A F1B46340
SLW CW+2 F1B46350
CP5720 TSX COMP,B COMPILE TSX SYMJ(S(I)) , J=2,... F1B46360
LXD CP0400,B F1B46370
TXI CP5750,B,3 F1B46380
CP5750 TXH CP5780,B,-6 FINISHED SCANNING F1B46390
SXD CP0400,B F1B46400
TXI CP5680,A,-3 F1B46410
CP5780 AXT ..,4 RELOAD CALLING TAG. F1B46420
TRA 1,4 RETURN TO CALLER. F1B46430
CP8000 LDQ SCRIPL+2,1 THIS ARGUMENT OF A SUBPROGRAM IS NOT A F1B46440
STQ G+1 SUBSCRIPTED VARIABLE. TEST WHETHER IT IS A F1B46450
PXD ,0 SOURCE LANGUAGE FIXED POINT VARIABLE. F1B46460
LGL 6 F1B46470
CAS L(H) TEST FIRST CHARACTER FOR I,J,K,L,M,N F1B46480
CAS L(O) F1B46490
TXI CP5180,0,0 NOT FIXED POINT BEGINNING. F1B46500
TXI CP5180,0,0 F1B46510
PXD ,0 F1B46520
LGL 6 TEST SECOND CHARACTER FOR ( WHICH MEANS F1B46530
SUB OPEN FIXED POINT CONSTANT. F1B46540
TZE CP5180 DO NOT ENTER IN FORVAL. F1B46550
CLA LEFT+2 TEST WHETHER THIS FUNCTION IS WITHIN AN F1B46560
SUB IFSYM2 IF(...) STATEMENT. F1B46570
TZE CP5180 DO NOT ENTER IN FORVAL. F1B46580
CLA CALLNM ALL TEST SATISFIED, PREPARE TO ENTER THE F1B46590
ALS 18 FIRST INTERNAL FORMULA NUMBER AND THE NAME F1B46600
STO G OF THE VARIABLE IN FORVAL. F1B46610
SXD CP8001,1 SAVE IR1. F1B46620
TSX TET00,1 MAKE FORVAL TABLE ENTRY. F1B46630
6 F1B46640
LXD CP8001,1 RELOAD IR1. F1B46650
CP8001 TXI CP5180,0,** F1B46660
REM F1B46670
REM ADDRESS COMPLETION SUBROUTINE. F1B46680
REM USING INFORMATION IN SCRIPL TABLE THIS ROUTINE FORMS WORDS 3 F1B46690
REM AND 4 ( SYMBOL AND ADDEND-TAG WORDS) FOR NEXT CIT ENTRY. F1B46700
REM THESE WORDS ARE PLACED IN CW+2 AND CW+3. F1B46710
REM F1B46720
AC0M60 CLA LEFT ENTRY POINT FROM END OF SEGMENT ROUTINE. F1B46730
STO TAGWRD MOVE CONTENTS OF LEFT WORDS TO WORKING F1B46740
CLA LEFT+1 STORAGE FOR THIS SUBROUTINE. F1B46750
STO OPWORD F1B46760
CLA LEFT+2 F1B46770
STO SYMWRD F1B46780
TRA AC0060 F1B46790
AC0000 CLA SCRIPL,1 ENTRY POINT FROM COMPILER ROUTINE. F1B46800
STO TAGWRD F1B46810
CLA SCRIPL+1,1 MOVE SCRIPL TABLE ENTRY TO WORKING STORAGE.F1B46820
STO OPWORD F1B46830
CLA SCRIPL+2,1 F1B46840
STO SYMWRD F1B46850
AC0060 CAL TAGWRD GET TAGS IF ANY F1B46860
SXD ACXR2,2 SAVE IR2 F1B46870
ANA MASK1 EXTRACT TAGS IN ACC. F1B46880
PBT SUBSCRIPTED OR NON-SUBSCRIPTED... F1B46890
TRA AC0540 SUBSCRIPTED F1B46900
PXD 0,0 NON-SUBSCRIPTED SYMBOL F1B46910
LDQ SYMWRD GET SYMBOL AND TEST FOR LEVEL NUMBER OR F1B46920
LGL 1 VARIABLE NAME. F1B46930
LBT F1B46940
TQP AC0460 SYMBOL IS SOME LEVEL NUMBER S(K). F1B46950
LGL 11 NON-SUBSCRIPTED EX/INTERNAL VARIABLE F1B46960
SUB L(A() IS THIS A FLO PT CONSTANT F1B46970
TZE AC0410 YES F1B46980
ADD L(A() NO F1B46990
SUB L(I() IS THIS A FIX PT CONSTANT F1B47000
TZE AC0390 YES F1B47010
ADD L(I() NO F1B47020
SUB L(H() IS THIS A HOLLERITH FIELD F1B47030
TZE AC0350 YES F1B47040
LDQ OPWORD * NON-SUBSCRIPTED EXTERANL VARIABLE F1B47050
LGL 13 IS THIS A DUMMY VARIABLE F1B47060
TQP AC0340 NO, FSIND BIT=0 F1B47070
LLS 15 YES,FSIND BIT=1 F1B47080
COM F1B47090
SUB L(1) FORM ADDEND FOR ARGUMENT ADDRESS. F1B47100
PAX 0,B F1B47110
PXD 0,B F1B47120
SLW CW+3 STORE ARGUMENT BUFFER RELATIVE ADDRESS F1B47130
LXD BK,B F1B47140
CAL FORSUB-1,2 F1B47150
ANA MASK2 EXTRACT FUNCTION STATEMENT TYPE F1B47160
ORA P( FORM 4(I F1B47170
AC0320 SLW CW+2 F1B47180
AC0330 LXD ACXR2,2 RELOAD IR2 F1B47190
TRA 1,C RETURN F1B47200
AC0340 STZ CW+3 * NON-SUBSCRIPTED, REAL VARIABLE F1B47210
CAL SYMWRD F1B47220
TRA AC0320 F1B47230
AC0350 CAL ADSPOP * HOLLERITH FIELD F1B47240
TRA AC0420 F1B47250
AC0390 CLA I( * FIX PT. CONSTANT, 2) ADDR F1B47260
AC0420 STO CW+2 F1B47270
RQL 6 F1B47280
AC0450 STQ CW+3 F1B47290
TRA AC0330 GO TO COMMON EXIT. F1B47300
AC0410 CLA A( * FLO PT. CONSTANT, 3) ADDR F1B47310
TRA AC0420 F1B47320
REM LEVEL NUMBER F1B47330
AC0460 LGL 35 SYMBOL IS SOME S(K) F1B47340
PAX ,2 F1B47350
CAL CPBETA,2 F1B47360
ANA MASK1 GET THE PREPARED ADDEND FROM BETA F1B47370
SLW CW+3 F1B47380
CAL ARERAS PUT IN AN ADDRESS OF 1) F1B47390
TRA AC0320 F1B47400
REM SUBSCRIPTED VARIABLE F1B47410
AC0540 SLW TAGWRD F1B47420
LDQ TAGWRD F1B47430
PXD ,0 CLEAR AC. F1B47440
LGL 12 I-TAU TAGS TO AC. F1B47450
SLW CW+3 STORE FOR NEXT CIT ENTRY. F1B47460
AC0990 TQP AC1000 THERE IS AN I-TAU TAG FOR CURRENT CIT. F1B47470
STZ CW+3 F1B47480
PXD ,0 REPLACE NULL TAG. F1B47490
SLW TAGPRT SAVE FOR LATER USE. F1B47500
LGL 1 F1B47510
PXD ,0 CLEAR AC. F1B47520
LGL 8 SIGMA TAG TO AC. F1B47530
ADD SIG1IX-1 FORM BASE OF TABLE + SIGMA TAG. F1B47540
STA *+1 F1B47550
CAL ** GET RELATIVE ADDRESS. F1B47560
ORS CW+3 ADD RELATIVE ADDRESS TO I-TAU TAG. F1B47570
CAL SYMWRD VARIABLE NAME FOR NEXT CIT ENTRY. F1B47580
ACXR2 TXI AC0320,0,** GO STORE AC AND EXIT. F1B47590
REM F1B47600
AC1000 LXD ARGCTR,2 TEST WHETHER THIS SUBSCRIPTED VARIABLE IS F1B47610
TXL AC1050,2,0 WITHIN AN ARITHMETIC FUNCTION. (23)F1B47620
ER0071 TSX DIAG,4 YES, THIS IS IN ERROR, GO TO DIAGNOSTIC. F1B47630
DUP 1,6 (23)F1B47640
PZE (UNUSED STORAGE) (23)F1B47650
AC1050 CAL EIFNO PREPARE TO MAKE FORTAG (23)F1B47700
ANA MASK1 ENTRY.. CONSISTS OF IFN (23)F1B47710
ORA CW+3 IN THE DECREMENT AND TAU TABLE (23)F1B47720
SLW G POINTER IN THE ADDRESS. (23)F1B47730
SXA AC1070,1 SAVE IR1 (23)F1B47740
TSX CFTAG,2 (23)F1B47750
AC1070 AXT **,1 RELOAD IR1 F1B47760
AC1080 LDQ TAGWRD RESTORE AC AND MQ TO PREVIOUS CONTENTS. F1B47770
PXD ,0 F1B47780
LGL 12 F1B47790
TRA AC0990+3 RETURN TO ORIGINAL CODING. F1B47800
REM F1B47810
REM F1B47820
COMPM4 SLW CW+1 STORE SYMBOLIC OPERATION CODE. F1B47830
COMPM3 TSX AC0000,4 F1B47840
TRA COMP F1B47850
COMPM2 SLW CW+1 STORE SYMBOLIC OPERATION CODE. F1B47860
COMP TSX CIT00,C COMPILE CONTENTS OF CW,CW+1,CW+2,CW+3. F1B47870
PZE CW,,CW+1 LOC,,OP-DEC F1B47880
PZE CW+2,,CW+3 ADR,,RA-TAG F1B47890
STZ CW CLEAR INTERNAL FORMULA NUMBER IF ANY. F1B47900
TRA 1,B RETURN TO CALLER. F1B47910
REM F1B47920
COMP0A TSX CIT00,4 F1B47930
PZE CW,,L(SXD) LOC,,OP-DEC F1B47940
PZE O(,,D4A4 ADR,,RA-TAG F1B47950
TRA PCH5 GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX $F1B47960
REM F1B47970
COMP0B TSX CIT00,4 COMPILE SXD 7(,4 F1B47980
PZE CW,,L(SXD) F1B47990
PZE X(,,L(4) F1B48000
TRA PCH5 GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX $F1B48010
REM F1B48020
COMP0C TSX CIT00,4 F1B48030
PZE L(0),,L(XCA) LOC,,OP-DEC F1B48040
PZE L(0),,L(0) ADR,,RA-TAG F1B48050
TRA 1,2 F1B48060
REM F1B48070
REM SUBROUTINE TO COMPILE TSX NAME OF FUNCTION,4 F1B48080
COMTSX TSX CIT00,4 F1B48090
L(0),,L(TSX) F1B48100
CW+2,,L(4) F1B48110
TRA 1,2 RETURN TO CALLER. F1B48120
REM F1B48130
REM F1B48140
REM DOUBLE PRECISION ARITHMETIC COMPILER ROUTINE. F1B48150
REM F1B48160
REM F1B48170
CP000D STZ TRAPCL RESET INDICATOR OF LAST ROUTINE CALLED F1B48180
SXD CPBETA,0 F1B48190
CP005D LXD 3LBAR,1 GET LENGTH OF REMAINING SCRIPL TABLE. F1B48200
CP013D CLA SCRIPL-3,1 EXTRACT CURRENT S(I) F1B48210
CP014D PAX ,2 F1B48220
CLA CPBETA,2 F1B48230
STD PHI(I) STO ERAS. REL. ADD. IN PHI (I) F1B48240
ANA MASK2 F1B48250
CP018D PAX ,2 SAVE LENGTH OF SEGMENT IN DECREMENT F1B48260
SXD CP040D,2 FOR LATER BUMPING AND TESTING F1B48270
PAC 0,4 F1B48280
SXD *+1,4 F1B48290
TXI *+1,1,.. MOVE XA TO 1ST ELEMENT OF CURRENT S(I) F1B48300
SXD 3LBAR,1 STORE LEVEL FOR ESR00 F1B48310
LDQ SCRIPL+1,1 EXAMINE OP1 (S(I)) 29,30,31,32 F1B48320
LGL 30 F1B48330
LBT F1B48340
TRA CP031D OP1 (S(I)) 29 = 0 LINKAGE NOT POSSIBLE F1B48350
TQP CP037D OP1 (S(I)) 30 = 0 NO SUB EXPRESS TO STO F1B48360
CP031D SLN 1 OP1 (S(I)) 29 = 0 OR OP1 (S(I)) 30 = 1, SO F1B48370
CP032D RQL 1 SET STORE LITE THEN DECIDE IS AC OR MQ F1B48380
TQP CP035D OP1 (S(I)) 31 = 0, SO SET STO LITE F1B48390
SLN 2 OP1 (S(I)) 31 = 1, SO SET STQ LITE 2 ON F1B48400
CP035D RQL 1 F1B48410
TRA CP038D F1B48420
CP037D RQL 2 F1B48430
CP038D TQP CP042D TEST OP1 (S(I)) 32 F1B48440
SLT 4 OP1 (S(I)) 32 = 1, SO SET FLPTSW F1B48450
CP040D TXH 0,0,.. ACTS AS NOP,WITH A USEFUL DECREMENT F1B48460
TRA CP043D F1B48470
REM F1B48480
REM ROUTINE TO COMPILE FIXED POINT + - * / WHEN IN D.P. OR C.A. F1B48490
REM MODES. OP(1) SPECIAL CASE F1B48500
REM F1B48510
CP042D SLN 4 LITE 4 ON FOR FIXED F1B48520
PXD 0,0 F1B48530
LDQ SCRIPL+1,1 GET OP WORD OF FIRST ENTRY OF LEVEL F1B48540
LGL 6 F1B48550
CAS SPECOP COMPARE WITH $ F1B48560
TRA CP096F OF IS * OR ** F1B48570
TXI CP204D,1,-3 OF IS $ F1B48580
SUB 11Z OP IS + OR - F1B48590
TZE CP076F F1B48600
LGL 29 F1B48610
TQP CP113F 35=0 NO LINKAGE F1B48620
TRA CP054F LINKAGE, TEST END OF SEGMENT F1B48630
CP113F CAL L(CLA) NO LINK COMPILE CLA F1B48640
CP168F SLW CW+1 F1B48650
TSX ACDP00,4 PREPARE CW+2, CW+3 F1B48660
TSX COMP,2 TAKES TO CIT00 AND COMPILES F1B48670
REM F1B48680
CP054F LXD CP040D,2 GET SEGMENT LENGTH F1B48690
TXI *+1,2,3 BUMP IT F1B48700
TXL ES000D,2,0 TEST END OF SEGMENT F1B48710
SXD CP040D,2 SAVE SEGMENT LENGTH LEFT F1B48720
TXI *+1,1,-3 GET NEXT ELEMENT OF LEVEL F1B48730
PXD 0,0 F1B48740
LDQ SCRIPL+1,1 F1B48750
LGL 6 F1B48760
CAS STAR F1B48770
TRA CP120F OP IS / F1B48780
TRA CP172F OP IS * F1B48790
SUB 11Z OP IS + OR - F1B48800
TZE CP088F OP IS - F1B48810
CAL L(ADD) OP IS + F1B48820
TRA CP168F GO COMPILE ALL F1B48830
REM F1B48840
CP076F LGL 29 F1B48850
TQP CP085F 35 = 0, NO LINKAGE F1B48860
TSX CIT00,4 COMPILE CHS F1B48870
PZE L(0),,L(CHS) F1B48880
PZE L(0),,L(0) F1B48890
TRA CP054F F1B48900
CP085F CAL L(CLS) F1B48910
TRA CP168F F1B48920
REM F1B48930
CP088F CAL L(SUB) OP(4) IS - F1B48940
TRA CP168F GO COMPILE SUB F1B48950
REM F1B48960
CP096F TQP *+2 OP(1) IS * OR ** F1B48970
TRA CP414D CASE OF ** F1B48980
LGL 29 F1B48990
SLN 3 F1B49000
LBT F1B49010
TRA CP105F LEAVE 3 ON F1B49020
SLT 3 BIT 34 = 1 SO TURN 3 OFF F1B49030
NOP F1B49040
CP105F TQP CP107F TEST BIT 35 F1B49050
TRA CP054F LECEL IS LINKED F1B49060
CP107F SLT 3 TEST 3 FOR AC OR MQ F1B49070
TRA *+4 F1B49080
SLN 3 F1B49090
CAL L(CLA) COMPILE CLA F1B49100
TRA CP168F F1B49110
CAL L(LDQ) COMPILE LDQ F1B49120
TRA CP168F F1B49130
REM F1B49140
CP120F SLT 3 F1B49150
TRA *+4 F1B49160
TSX CIT00,4 COMPILE LRS 35 F1B49170
PZE L(0),,L(LRS) F1B49180
PZE L(0),,DEC35 F1B49190
CP145D TSX ACDP00,4 PREPARE CW+2, CW+3 F1B49200
CAL L(DVP) F1B49210
TSX COMPM2,2 F1B49220
TSX CIT00,4 COMPILE CLM F1B49230
PZE L(0),,L(CLM) F1B49240
PZE L(0),,L(0) F1B49250
TSX CIT00,4 COMPILE LLS 18 F1B49260
PZE L(0),,L(LLS) F1B49270
PZE L(0),,DEC18 F1B49280
TRA CP054F F1B49290
CP172F SLT 3 F1B49300
TRA *+2 F1B49310
TSX COMP0C,2 F1B49320
SLN 3 F1B49330
TSX ACDP00,4 PREPARE CW+2, CW+3 F1B49340
CAL L(MPY) F1B49350
TSX COMPM2,2 F1B49360
TSX CIT00,4 F1B49370
PZE L(0),,L(ALS) F1B49380
PZE L(0),,DEC17 F1B49390
TRA CP054F F1B49400
REM F1B49410
REM ROUTINE FOR FLOATING POINT + - * / WHEN IN D.P. OR C.A. MODESF1B49420
REM F1B49430
REM COMPILATION OF BOTH DP AND CA SEGMENT OP(1) FOR + - * F1B49440
REM F1B49450
CP043D TSX ACDP00,4 PREPARE CW+2, CW+3, DPCW F1B49460
PXD 0,0 F1B49470
LDQ SCRIPL+1,1 PLACE OP1 (S(I)) IN MQ F1B49480
LGL 6 F1B49490
CAS SPECOP WHAT OPERATION F1B49500
TRA CP096D * OR ** F1B49510
TXI CP204D,1,-3 $ , GET NEXT LEVEL AND PROCEED F1B49520
SUB 11Z OP IS + OR - F1B49530
TZE CP076D OP IS - F1B49540
LGL 29 OP1 (S(I)) = + TEST LINKAGE BIT 35 F1B49550
TQP CP113D OP1 (S(I)) 35 = 0 NO LINKAGE COMPILE CLA F1B49560
TRA CP054D LINKAGE, SEE IF END OF SEGMENT F1B49570
CP076D LGL 29 OP IS -, SO TEST LINKAGE BIT 35 F1B49580
TQP CP085D NO LINK SO SKIP F1B49590
TSX CPDCHS,2 COMPILE SEQUENCE FOR BOTH DP AND CA CHS F1B49600
TRA CP054D SINCE LINKED IN AC F1B49610
CP085D TSX CPDCLS,2 COMPILE SEQUENCE FOR BOTH DP AND CA CLS F1B49620
TRA CP054D F1B49630
REM F1B49640
CP096D TQP *+2 OP IS * OR ** F1B49650
TRA CP414D OP IS ** F1B49660
LGL 29 OP1 (S(I)) = * F1B49670
SLN 3 TURN LITE 3 ON NEEDS MULTIPLIER IN MQ F1B49680
LBT TEST OP1 (S(I)) 34 1= PREV LEVEL TYPE AC F1B49690
TRA CP105D OP1 (S(I)) 34 = 0, SO LEAVE LITE 3 ON F1B49700
SLT 3 OP1 (S(I)) 34 = 1, SO TURN LITE 3 OFF F1B49710
NOP F1B49720
CP105D TQP CP107D BIT 35 = 0 F1B49730
TRA CP054D OP1 (S(I)) 35 = 1, SO GO MODIFY J F1B49740
CP107D SLT 3 F1B49750
TRA *+4 F1B49760
SLN 3 EL1 (S(II) TO ACC F1B49770
CP113D TSX CPDCLA,2 COMPILE SEQUENCE FOR BOTH DP AND CA CLA F1B49780
TRA CP054D F1B49790
TSX CPDLDQ,2 COMPILE SEQUENCE FOR BOTH DP AND CA LDQ F1B49800
REM F1B49810
REM COMPILATION OF DP SEGMENT OP(2) THRU OP(N) FOR + - * / F1B49820
REM F1B49830
CP054D LXD CP040D,2 OP1 (S(I)) 35 = 1 OBTAIN SEGMENT LENGTH F1B49840
TXI *+1,2,3 BUMP IT F1B49850
TXL ES000D,2,0 GO TO END-OF-SEGMENT SBRTN F1B49860
SXD CP040D,2 STORE CURRENT SEGMENT LENGTH F1B49870
TXI *+1,1,-3 F1B49880
TSX ACDP00,4 PREPARE CW+2, CW+3, DPCW F1B49890
LDQ SCRIPL+1,1 PLACE OPJ (S(I)) IN MQ F1B49900
CLA MODECL F1B49910
SUB L(I) TEST FOR COMPLEX ARITHMETIC F1B49920
TZE CP059I GO TO COMPLEX ROUTINE F1B49930
PXD 0,0 F1B49940
LGL 6 F1B49950
CAS STAR F1B49960
TRA CP120D OPJ (S(I)) = / F1B49970
TRA CP172D OPJ (S(I)) = * F1B49980
SUB 11Z F1B49990
TZE CP088D OPJ (S(I)) = - F1B50000
TSX CPDFAD,2 GO COMPILE DP FAD SEQUENCE F1B50010
TRA CP054D GO TO NEXT ELEMENT IN SEGMENT. F1B50020
REM F1B50030
CP088D TSX CPDFSB,2 COMPILE SEQUENCE FOR DP FSB F1B50040
TRA CP054D GO TO NEXT ELEMENT IN SEGMENT F1B50050
REM F1B50060
CP120D SLT 3 OPJ (S(I)) = / DIVIDEND MUST BE IN AC F1B50070
TSX CPMQAC,2 COMPILE SEQUENCE TO MAVE MQ TO AC F1B50080
TSX CPDFDP,2 COMPILE SEQUENCE FOR DP FDP F1B50090
TRA CP054D LEAVE THREE OFF FOR RESULT IS IN MQ F1B50100
REM F1B50110
CP172D SLT 3 OPJ(S(I))=* F1B50120
TRA *+2 PREVIOUS RESULT IN MQ F1B50130
TSX CPACMQ,2 COMPILE SEQUENCE TO MOVE AC TO MQ F1B50140
SLN 3 TURN THREE ON BECAUSE RESULT IN AC F1B50150
TSX CPDFMP,2 COMPILE SEQUENCE FOR DP FMP F1B50160
TRA CP054D F1B50170
REM F1B50180
REM COMPILATION OF CA SEGMENT OP(2) THRU OP(N) FOR + - * / F1B50190
REM F1B50200
CP059I LGL 6 F1B50210
CAS STAR F1B50220
TRA CP120I F1B50230
TRA CP172I F1B50240
LXD CP040D,2 GET SEGMENT LENGTH F1B50250
SXA CP054I,2 SAVE IT FOR LATER BUMPING AND TESTING F1B50260
SXA CP154I,2 F1B50270
SXA CP160I-1,1 SAVE IR(1) TO MOVE THROUGH SCRIPL AGAIN F1B50280
PAX 0,2 SAVE PLUS OR MINUS F1B50290
TSX CIT00,4 COMPILE CLA REAL PART F1B50300
PZE L(0),,L(CLA) F1B50310
PZE P(,,L(0) F1B50320
PXA 0,2 RETRIEVE + OR - F1B50330
CP087I SUB 11Z TEST F1B50340
TZE CP088I OP IS - F1B50350
TSX CIT00,4 OP IS +, COMPILE FAD F1B50360
PZE L(0),,L(FAD) F1B50370
PZE CW+2,,CW+3 F1B50380
TRA CP054I F1B50390
CP088I TSX CIT00,4 COMPILE FSB F1B50400
PZE L(0),,L(FSB) F1B50410
PZE CW+2,,CW+3 F1B50420
CP054I AXT 0,2 PICK UP SEGMENT LENGTH F1B50430
TXI *+1,2,3 BUMP IT F1B50440
TXL CP254I,2,0 TIME TO START IMAG. F1B50450
SXA CP054I,2 SAVE LENGTH AGAIN F1B50460
TXI *+1,1,-3 MOVE TO NEXT ELEMENT F1B50470
TSX ACDP00,4 GET NEXT ADDRESS. F1B50480
LDQ SCRIPL+1,1 GET OP(N) F1B50490
PXD 0,0 PREPARE TO TEST FOR + OR - F1B50500
LGL 6 F1B50510
TRA CP087I F1B50520
CP254I TSX CIT00,4 STORE REAL RESULT F1B50530
PZE L(0),,L(STO) F1B50540
PZE P(,,L(0) F1B50550
TSX CIT00,4 START IMAGINARY PART F1B50560
PZE L(0),,L(CLA) F1B50570
PZE P(,,DECMI1 F1B50580
AXT 0,1 RESTORE IR(1) TO OP(2) F1B50590
CP160I TSX ACDP00,4 PREPARE IMAGINARY ADDRESS F1B50600
LDQ SCRIPL+1,1 GET OP(N) F1B50610
PXD 0,0 TEST FOR + OR - F1B50620
LGL 6 F1B50630
SUB 11Z F1B50640
TZE CP188I OP IS - F1B50650
TSX CIT00,4 OP IS +, COMPILE FAD F1B50660
PZE L(0),,L(FAD) F1B50670
PZE CW+2,,DPCW F1B50680
TRA CP154I F1B50690
CP188I TSX CIT00,4 COMPILE FSB F1B50700
PZE L(0),,L(FSB) F1B50710
PZE CW+2,,DPCW F1B50720
CP154I AXT 0,2 GET SEGMENT LENGTH F1B50730
TXI *+1,2,3 BUMP IT F1B50740
TXL CP255I,2,0 FINISHED WITH IMAG. F1B50750
SXA CP154I,2 NO SAVE LENGTH AGAIN F1B50760
TXI CP160I,1,-3 MOVE THROUGH SCRIPL F1B50770
CP255I TSX CIT00,4 STORE IMAGINARY RESULT F1B50780
PZE L(0),,L(STO) F1B50790
PZE P(,,DECMI1 F1B50800
TRA ES000D F1B50810
REM F1B50820
CP120I SLT 3 F1B50830
TSX CPMQAC,2 COMPILE SEQUENCE TO MOVE FROM MQ TO AC F1B50840
TSX CPIFDP,2 COMPILE SEQUENCE FOR CA FDP F1B50850
TRA CP054D F1B50860
REM F1B50870
CP172I SLT 3 F1B50880
TRA *+2 F1B50890
TSX CPACMQ,2 COMPILE SEQUENCE TO MOVE FROM AC TO MQ. F1B50900
SLN 3 F1B50910
TSX CPIFMP,2 COMPILE SEQUENCE FOR CA FMP F1B50920
TRA CP054D F1B50930
REM F1B50940
REM FUNCTION LEVEL F1B50950
REM FIRST DETERMINE TYPE OF FUNCTION F1B50960
REM F1B50970
CP204D TRA P1B00B GO TO PATCH *F1B50980
LBT TEST OP1(S(I))12 F1B50990
TQP CP265D LIB OR OPEN FUNCTION F1B51000
TQP CP500D FN-FUNCTION F1B51010
PXD 0,0 FS-FUNCTION F1B51020
LLS 15 PUT TYPE NO IN ADD(ACC) F1B51030
ORA P( FORM 4...TYPE NO. F1B51040
SLW ARGORG F1B51050
ANA MASK2 F1B51060
ORA X( F1B51070
SLW XRSAVE F1B51080
STZ COUNT2 F1B51090
CLA 2E18 F1B51100
STO COUNT1 F1B51110
CAL SCRIPL-1,1 GET FUNCTION NAME F1B51120
ARS 30 F1B51130
SUB L(X) AND TEST FOR FIXED POINT BEGINNING F1B51140
TNZ *+2 F1B51150
ERDP02 TSX DIAG,4 F1B51160
CLA SCRIPL+1,1 F1B51170
LBT EXAMINE OP2(S(I))35 F1B51180
TRA CP215D 1ST ARG STORED F1B51190
REM FIRST ARGUMENT IS IN PSEUDO-AC F1B51200
CLA P( F1B51210
STO CW+2 F1B51220
STZ CW+3 F1B51230
CLA DECMI1 F1B51240
STO DPCW F1B51250
TSX CPDARG,2 COMPILE SEQUENCE TO MOVE ARGUMENT 1 F1B51260
TRA CP220D CONTINUE TO ARGUMENT 2 F1B51270
REM FIRST ARGUMENT IS STORED F1B51280
CP215D TSX ACDP00,4 PREPARE CW+2, CW+3, DPCW F1B51290
TSX CPDARG,2 COMPILE SEQUENCE TO MOVE ARGUMENT 1 F1B51300
CP220D STZ CW CLEAR CW OF IFN IF ANY. F1B51310
LXD CP040D,2 F1B51320
TXI *+1,2,6 F1B51330
TXL CP250D,2,0 EXIT IF ONLY ONE ARGUMENT F1B51340
SXD CP040D,2 F1B51350
TXI *+1,1,-3 MOVE TO SECOND ARGUMENT F1B51360
REM F1B51370
CLA SCRIPL+1,1 GET OP WORD F1B51380
LBT F1B51390
TRA CP230D F1B51400
REM SECOND ARGUMENT IS IN PSEUDO-MQ F1B51410
CLA P( F1B51420
STO CW+2 F1B51430
CLA DECMI2 F1B51440
STO CW+3 F1B51450
CLA DECMI3 F1B51460
STO DPCW F1B51470
TSX CPDARG,2 COMPILE SEQUENCE TO MOVE ARGUMENT 2 F1B51480
TRA CP235D CONTINUE TO ARGUMENT 3 F1B51490
REM SECOND ARGUMENT IS STORED F1B51500
CP230D TSX ACDP00,4 PREPARE CW+2, CW+3, DPCW F1B51510
TSX CPDARG,2 COMPILE SEQUENCE TO MOVE ARGUMENT 2 F1B51520
REM F1B51530
CP235D LXD CP040D,2 F1B51540
TXI *+1,2,3 F1B51550
TXL CP250D,2,0 EXIT IF ONLY TWO ARGUMENTS F1B51560
SXD CP040D,2 F1B51570
REM ARGUMENTS 3 THRU N ARE ALWAYS STORED F1B51580
TXI CP230D,1,-3 COMTINUE WITH REST OF ARGUMENTS F1B51590
REM F1B51600
REM FINISHED WITH ARGUMENTS F1B51610
CP250D LXD 3LBAR,1 F1B51620
CAL SCRIPL+2,1 GET NAME OF FUNCTION F1B51630
SLW CW+2 F1B51640
LXD ARGCTR,4 F1B51650
TXL CP260D,4,0 F1B51660
REM WITHIN AN ARITHMETIC STATEMENT FUNCTION F1B51670
TSX PCH2,4 GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX $F1B51680
PZE L(0),,L(SXD) F1B51690
PZE XRSAVE,,L(4) F1B51700
TSX COMTSX,2 F1B51710
TSX FLTR00,4 F1B51720
PZE L(0),,L(LXD) F1B51730
PZE XRSAVE,,L(4) F1B51740
TRA ES000D GO TO END-OF-SEGMENT ROUTINE F1B51750
REM NOT WITHIN AN ARITHMETIC STATEMENT FUNCTION F1B51760
CP260D TSX COMP0A,2 COMPILE SXD 6)+4,4 F1B51770
TSX COMTSX,2 COMPILE TSX NAME,4 F1B51780
TSX FLTR00,4 F1B51790
PZE L(0),,L(LXD) F1B51800
PZE O(,,D4A4 F1B51810
TRA ES000D GO TO END-OF-SEGMENT ROUTINE F1B51820
REM F1B51830
CP265D LGL 20 F1B51840
TQP CP306D FOR LIBRARY FUNCTIONS, TRANSFER F1B51850
LXD CP040D,4 GET SEGMENT LENGTH F1B51860
SXD CP0400,4 STORE IT AND GO TO NORMAL FORTRAN F1B51870
TSX OPENSB,4 FOR OPEN SUBROUTINES F1B51880
TRA ES000D GO TO END-OF-SEGMENT ROUTINE F1B51890
REM F1B51900
REM CLOSED (LIBRARY) FUNCTIONS F1B51910
CP306D CAL P( F1B51920
SLW ARGORG F1B51930
CLS L(0) F1B51940
STO COUNT1 F1B51950
CLS 2E18 F1B51960
STO COUNT2 F1B51970
CLA SCRIPL+1,1 F1B51980
LBT F1B51990
TRA CP354D F1B52000
REM ARGUMENT 1 IS IN PSEUDO-AC F1B52010
TSX DARG02,2 BUMP COUNT WORDS FOR ARG SKIPPED F1B52020
TRA CP356D CONTINUE TO ARGUMENT 2 F1B52030
REM ARGUMENT 1 IS STORED F1B52040
CP354D TSX ACDP00,4 PREPARE CW+2, CW+3, DPCW F1B52050
TSX CPDARG,2 COMPILE SEQUENCE TO MOVE ARGUMENT 1 F1B52060
REM F1B52070
CP356D LXD CP040D,2 F1B52080
STZ CW CLEAR IFN IF ANY F1B52090
TXI *+1,2,6 F1B52100
TXL CP310D,2,0 EXIT IF ONLY ONE ARGUMENT. F1B52110
SXD CP040D,2 F1B52120
TXI CP349D,1,-3 MOVE TO ARGUMENT 2 (22)F1B52130
DUP 1,5 (22)F1B52140
PZE (NOT USED) (22)F1B52150
CP349D TSX ACDP00,4 PREPARE CW+2, CW+3, DPCW F1B52210
TSX CPDARG,2 COMPILE SEQUENCE TO MOVE ARGUMENT 2 F1B52220
REM F1B52230
CP328D LXD CP040D,2 F1B52240
TXI *+1,2,3 F1B52250
TXL CP310D,2,0 EXIT IF ONLY TWO ARGUMENTS F1B52260
SXD CP040D,2 F1B52270
REM ARGUMENT 3 THRU ARGUMENT N ARE STORED. F1B52280
TXI CP349D,1,-3 F1B52290
REM FINISHED WITH ARGUMENTS F1B52300
CP310D LXD 3LBAR,1 F1B52310
CAL SCRIPL+2,1 GET FUNCTION NAME F1B52320
SLW CW+2 F1B52330
LAS DABS F1B52340
TRA *+2 F1B52350
TRA CPDABS COMPILE DABS SEQUENCE IN LINE F1B52360
LAS DSIGN F1B52370
TRA *+2 F1B52380
TRA CDSIGN COMPILE DSIGN SEQUENCE IN LINE F1B52390
TRA *+6 (22)F1B52400
DARG05 AXT **,2 OPERAND LEVEL FOUND (22)F1B52410
CAL SCRIPL+1,4 FROM OP OF FIRST ENTRY (22)F1B52420
ARS 3 (22)F1B52430
TRA DARG06 (22)F1B52440
PZE (NOT USED) (22)F1B52450
LAS DFLOAT F1B52460
TRA *+2 F1B52470
TRA CDFLOT COMPILE SEQUENCE FOR DFLOAT IN LINE F1B52480
LAS IFLOAT F1B52490
TRA *+2 F1B52500
TRA CDFLOT COMPILE SAME SEQUENCE FOR IFLOAT AS DFLOAT F1B52510
LAS ISIGN COMPARE NAME TO ISIGN. F1B52511
TRA *+2 F1B52512
TRA CISIGN *COMPILE SEQUENCE FOR ISIGN IN-LINE. F1B52513
NOP IF MORE OPEN SUBROUTINES ARE ADDED, THIS F1B52520
REM PROVIDES SPACE FOR A TRANSFER TO THE TEST. F1B52530
REM F1B52540
LXD ARGCTR,4 IS THIS IN AN ASF F1B52550
TXL CP320D,4,0 NO WILL TRANSFER F1B52560
REM WITHIN AN ARITHMETIC STATEMENT FUNCTION. F1B52570
TSX COMP0B,2 COMPILE SXD 7),4 F1B52580
TSX COMTSX,2 COMPILE A TSX F1B52590
TRA CP501D COMPILE LXD 7),4 F1B52600
REM NOT WITHIN AN ARITHMETIC STATEMENT FUNCTION F1B52610
CP320D TSX COMP0A,2 COMPILE SXD 6)+4,4 F1B52620
TSX COMTSX,2 COMPILE TSX F1B52630
TRA CP502D COMPILE LXD 6)+4,4 F1B52640
REM F1B52650
DOPSUB PZE 7 DOPSUB TABLE, NUMBER OF ENTRIES. F1B52660
REM OF ENTRIES FOR INDEXING SEARCH. F1B52670
DSIGN BCD 1DSIGN F1B52680
DABS BCD 1DABS F1B52690
BCI 1,XXXXXX TABLE ENTRY DELETED (22)F1B52700
BCI 1,XXXXXX TABLE ENTRY DELETED (22)F1B52710
IFLOAT BCD 1IFLOAT F1B52720
DFLOAT BCD 1DFLOAT F1B52730
ISIGN BCI 1,ISIGN F1B52731
BSS 5 PATCH SPACE FOR ADDING DOPSUB NAMES F1B52740
REM F1B52750
REM CASE OF ** F1B52760
CP414D LGL 30 POSITION BIT WHICH INDICATES BASE IN AC. F1B52770
LDQ SCRIPL+1,1 DETERMINE IF BASE IS FIXED OR FLOATING. F1B52780
RQL 32 F1B52790
TQP *+2 F1B52800
TRA CP447D BASE IS FLOATING. F1B52810
LBT BASE IS FIXED. F1B52820
TRA CP486D BASE NOT IN AC. F1B52830
TXI *+1,1,-3 MOVE IR1 TO EXPONENT F1B52840
CP444D TSX ACDP00,4 PREPARE CW+2,CW+3, DPCW F1B52850
CAL L(LDQ) COMPILE LDQ OF BASE F1B52860
TSX COMPM2,2 F1B52870
CP448D CLA SCRIPL+1,1 GET OP WORD F1B52880
LGR 4 F1B52890
TQP *+2 TEST FOR FIXED OR FLOATING EXPONENT F1B52900
TRA MC0310+2 FIXED BASE FLOATING EXPONENT ILLEGAL F1B52910
CLA FXFX PREPARE TO COMPILE TSX EXP(1 F1B52920
CP449D STO G F1B52930
LXD ARGCTR,4 DETERMINE IF IN AN ARITHMETIC FUNCTION F1B52940
TXH SXTRP,4,0 F1B52950
TSX PCH9,2 IF NOT COMPILE SXD 6)+4,4 $F1B52960
CP473D TSX CIT00,4 COMPILE TSX EXP(1 OR DEXP(2 OR DEXP(3 F1B52970
PZE L(0),,L(TSX) F1B52980
PZE G,,L(4) F1B52990
TSX TET00,1 F1B53000
PZE 9 F1B53010
LXD ARGCTR,4 F1B53020
TXH CP501D,4,0 F1B53030
TRA CP502D F1B53040
TRA CP501D F1B53050
SXTRP TSX PCH10,2 COMPILE SXD 7) $F1B53060
TRA CP473D F1B53070
CP486D TSX ACDP00,4 PREPARE CW+2, CW+3, DPCW F1B53080
CAL L(CLA) BASE NOT IN AC, COMPILE CLA OF BASE. F1B53090
TSX COMPM2,2 F1B53100
TXI *+1,1,-3 F1B53110
CLA SCRIPL+1,1 F1B53120
LBT F1B53130
TRA CP444D EXPONENT NOT IN MQ, F1B53140
TRA CP448D EXPONENT IN MQ. F1B53150
CP447D LBT FLOATING BASE. F1B53160
TRA CP450D BASE IN CORES. F1B53170
CP460D LDQ SCRIPL+4,1 F1B53180
RQL 32 F1B53190
TQP CP470D EXPONENT IS FIXED POINT. F1B53200
CP461D TXI *+1,1,-3 F1B53210
TSX ACDP00,4 PREPARE CW+2, CW+3, DPCW F1B53220
TSX CPDLDQ,2 COMPILE SEQUENCE TO LOAD PSEUDO-MQ F1B53230
CP465D CLA MODECL F1B53240
SUB L(I) TEST FOR CA MODE F1B53250
TNZ *+3 F1B53260
TRA ICM6 $F1B53270
TRA CP449D F1B53280
CLA DFLFL F1B53290
TRA CP449D F1B53300
CP450D TSX ACDP00,4 PREPARE CW+2, CW+3, DPCW F1B53310
TSX CPDCLA,2 COMPILE SEQUENCE TO LOAD PSEUDO-AC F1B53320
LDQ SCRIPL+4,1 POSITION BIT WHICH INDICATES THAT EXPONENT F1B53330
RQL 32 IS FIXED OR FLOATING TO S OF MQ. F1B53340
CLA SCRIPL+4,1 F1B53350
LBT F1B53360
TRA CP455D F1B53370
TQP CP471D FIXED EXPONENT IN AC. F1B53380
TRA CP465D FLOATING EXPONENT IN PSEUDO AC. F1B53390
CP455D TQP CP470D FIXED POINT EXPONENT IN CORES. F1B53400
TRA CP461D FLOATING EXPONENT IN CORES. F1B53410
CP470D TXI *+1,1,-3 F1B53420
TSX ACDP00,4 PREPARE CW+2, CW+3, DPCW F1B53430
CAL L(LDQ) FIXED EXPONENT, COMPILE LDQ F1B53440
TSX COMPM2,2 F1B53450
CP471D CLA MODECL F1B53460
SUB L(I) TEST FOR CA MODE F1B53470
TNZ *+3 F1B53480
CLA IFLFX F1B53490
TRA CP449D F1B53500
CLA DFLFX F1B53510
TRA CP449D F1B53520
REM F1B53530
DFLFX BCD 1DEXP(2 F1B53540
DFLFL BCD 1DEXP(3 F1B53550
IFLFX BCD 1IEXP(2 F1B53560
IFLFL BCD 1IEXP(3 F1B53570
REM F1B53580
REM F1B53590
CP500D LXD CP040D,2 F1B53600
SXD CP0400,2 F1B53610
STZ TRAPCL WHO KNOWS WHAT CHANGES LURK IN A SUBPROGRAMF1B53620
TSX FNIISB,4 COMPILE CALLING SEQUENCE FOR SUBPROGRAMS F1B53630
LXD ARGCTR,4 F1B53640
TXL CP502D,4,0 F1B53650
REM WITHIN AN ARITHMETIC STATEMENT FUNCTION F1B53660
CP501D TSX FLTR00,4 (33)F1B53670
PZE L(0),,L(LXD) F1B53680
PZE X(,,L(4) F1B53690
TRA ES000D F1B53700
REM NOT WITHIN AN ARITHMETIC STATEMENT FUNCTION F1B53710
CP502D TSX FLTR00,4 F1B53720
PZE L(0),,L(LXD) F1B53730
PZE O(,,D4A4 F1B53740
REM F1B53750
REM END OF SEGMENT ROUTINE F1B53760
REM F1B53770
ES000D LXD 3LBAR,1 GET INDEX TO FIRST ELEMENT OF CURRENT LEVELF1B53780
CAL SCRIPL,1 GET TAGWORD OF FIRST ELEMENT OF LEVEL F1B53790
ANA MASK2 F1B53800
TZE ES016D ZERO IS LAST OF EQUAL SIGN RIGHT F1B53810
CLA ARERAS F1B53820
STO CW+2 PREPARE ADDRESS AND ADDEND FOR F1B53830
CLA PHI(I) POSSIBLE COMPILATION OF STO (STQ) BETWEEN F1B53840
ALS 1 LEVELS. F1B53850
STO DPCW F1B53860
ADD 2E18 F1B53870
STO CW+3 F1B53880
SLT 4 F1B53890
TRA ES010D TO FLOATING POINT LEVEL F1B53900
SLT 1 LEVEL IS FIXED POINT, TEST LINKAGE (22)F1B53910
TRA CP005D LEVEL LINKED AND NOT CS (22)F1B53920
CAL L(STQ) STORE NEEDED, PREPARE STQ (22)F1B53930
SLT 2 IS RESULT IN MQ (22)F1B53940
CAL L(STO) NO, MAKE IT STO (22)F1B53950
TSX COMPM2,2 COMPILE IT (22)F1B53960
TRA CP005D GO TO NEXT LEVEL (22)F1B53970
REM (22)F1B53980
DARG06 LBT DETERMINE TYPE (22)F1B53990
TRA DARGFX FIXED (22)F1B54000
CAL SCRIPL+1,1 IS THERE LINKAGE (22)F1B54010
LBT (22)F1B54020
TRA DARGFL NO, COMPILE FLOATING ARGUMENT (22)F1B54030
CAL ARGORG YES, IS IT LIBRARY (22)F1B54040
ERA P( OR OPEN FUNCTION (22)F1B54050
TZE DARG02 NO (22)F1B54060
TRA DARGFL YES, COMPILE FLOATING ARGUMENT (22)F1B54061
DARGFX AXT L(STQ),4 YES, PREPARE TO COMPILE (22)F1B54070
NZT COUNT1 STQ, BUT IS IT FIRST ARGUMENT (22)F1B54080
AXT L(STO),4 YES, PREPARE FOR CLA (22)F1B54090
SXD DARG08,4 INITIALIZE CIT CELL (22)F1B54100
CAL SCRIPL+1,1 GET OP WORD (22)F1B54110
LBT DOES LINKAGE EXIST (22)F1B54120
TRA DARG09 NO, COMPILE CLA (22)F1B54130
CAL ARGORG IS ARG FOR LIBRARY OR (22)F1B54140
ERA P( OPEN FUNCTION (22)F1B54150
TNZ DARG07 STORE IF NOT (22)F1B54160
NZT COUNT1 IS IT FIRST ARGUMENT (22)F1B54170
TRA DARG02 DONT STORE IF YES (22)F1B54180
DARG07 TSX CIT00,4 STORE FUNCTION ARGUMENT (22)F1B54190
DARG08 L(0),,** (22)F1B54200
ARGORG,,COUNT1 (22)F1B54210
TRA DARG02 UPDATE COUNTS (22)F1B54220
DARG09 AXT L(LDQ),4 IF NOT FIRST ARGUMENT (22)F1B54230
NZT COUNT1 COMPILE LDQ (22)F1B54240
AXT L(CLA),4 OTHERWISE COMPILE CLA (22)F1B54250
SXD *+2,4 FOR UNLINKED (22)F1B54260
TSX CIT00,4 FIXED POINT ARGUMENT (22)F1B54270
CW,,** (22)F1B54280
CW+2,,CW+3 (22)F1B54290
TRA DARG07 (22)F1B54300
REM F1B54310
ES010D SLT 1 F1B54320
TRA CP013D LEVEL IS LINKED, GO TO NEXT LEVEL. F1B54330
SLT 2 F1B54340
TRA *+3 F1B54350
TSX CPDSTQ,2 COMPILE SEQUENCE FOR DP AND CA STQ F1B54360
TRA CP013D GO TO NEXT LEVEL. F1B54370
TSX CPDSTO,2 COMPILE SEQUENCE FOR DP AND CA STO F1B54380
TRA CP013D GO TO NEXT LEVEL. F1B54390
REM F1B54400
REM F1B54410
REM SCRIPL ENTRIES COMPLETED, NOW COMPILE TERMINAL CITS FOR LEFT F1B54420
REM OF EQUAL SIGN. F1B54430
ES016D LDQ LEFT+2 F1B54440
LGL 12 F1B54450
CAS IFSYM F1B54460
TRA *+2 F1B54470
TRA ES150D THIS IS AN IF(...)N1,N2,N3 F1B54480
CAS CALLER F1B54490
TRA *+2 F1B54500
TRA ES1520 THIS IS A CALL NAME (ARG1,...,ARGN) F1B54510
ARS 6 F1B54520
LXD ARGCTR,4 THIS IS AN ARITHMETIC STATEMENT FUNCTION F1B54530
TRA PCH7 GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX $F1B54540
REM F1B54550
REM STATEMENT OF FORM X = Y.... F1B54560
CAS L(H) F1B54570
CAS L(O) F1B54580
TRA ES030D FLOATING POINT ON LEFT OF EQUAL SIGN F1B54590
TRA ES030D FLOATING POINT F1B54600
SLT 4 FIXED POINT F1B54610
TRA ES087D FLOATING POINT ON RIGHT OF EQUAL SIGN. F1B54620
REM F1B54630
REM FIXED POINT ON BOTH RIGHT AND LEFT OF EQUAL SIGN. F1B54640
CAL L(STQ) COMPILE STQ IF LAST RESULT IN MQ F1B54650
SLT 2 F1B54660
ES073D CAL L(STO) COMPILE STO IF LAST RESULT IN AC. F1B54670
SLW CW+1 F1B54680
TSX AC0M60,4 PREPARE CW+2, CW+3 F1B54690
TSX COMP,2 F1B54700
TRA ES1590 RETURN TO STANDARD FORTRAN ARITHMETIC. F1B54710
REM F1B54720
REM FIXED POINT ON LEFT, FLOATING POINT ON RIGHT. F1B54730
ES087D SLT 2 F1B54740
TRA *+3 F1B54750
TSX CPCLA2,2 MOST SIGN. (REAL) MQ TO MACHINE AC F1B54760
TRA *+2 F1B54770
TSX CPCLA1,2 MOST SIGN. (REAL) AC TO MACHINE AC F1B54780
TSX CPFIX,2 COMPILE FIXING INSTRUCTIONS F1B54790
TRA ES073D F1B54800
REM F1B54810
REM FLOATING POINT ON LEFT OF EQUAL SIGN. F1B54820
ES030D SLT 4 F1B54830
TRA ES031D FLOATING POINT ON RIGHT. F1B54840
REM F1B54850
REM FIXED ON RIGHT, FLOATING ON LEFT. F1B54860
SLT 2 RESULT IN AC OR MQ F1B54870
TRA *+2 IN AC F1B54880
TSX COMP0C,2 IN MQ COMPILE XCA F1B54890
TSX CFLOAT,2 FLOAT MOST SIGNIFICANT F1B54900
TSX ACDP0L,4 PRE F1B54910
TSX CIT00,4 F1B54920
PZE L(0),,L(STO) COMPILE STO F1B54930
PZE CW+2,,CW+3 F1B54940
TSX CIT00,4 F1B54950
PZE L(0),,L(STZ) COMPILE STZ FOR LEAST SIGNIFCANT PART. F1B54960
PZE CW+2,,DPCW F1B54970
TRA ES1590 F1B54980
REM F1B54990
REM FLOATING POINT ON BOTH SIDES OF EQUAL. F1B55000
ES031D TSX ACDP0L,4 PREPARE CW+2, CW+3, DPCW F1B55010
SLT 2 F1B55020
TRA *+3 F1B55030
TSX CPDSTQ,2 COMPILE SEQUENCE FOR DP AND CA STQ F1B55040
TRA ES1590 RETURN TO STANDARD FORTRAN ARITHMETIC F1B55050
TSX CPDSTO,2 COMPILE SEQUENCE FOR DP AND CA STO F1B55060
TRA ES1590 RETURN TO STANDARD FORTRAN ARITHMETIC F1B55070
REM F1B55080
REM STATEMENT IS AN ARITHMETIC STATEMENT FUNCTION. F1B55090
ES130D SUB L(X) F1B55100
TZE ES136D FIXED POINT ON LEFT OF EQUAL F1B55110
SLT 4 F1B55120
TRA ES132D FLOATING POINT ON RIGHT OF EQUAL. F1B55130
REM F1B55140
REM FIXED POINT ON RIGHT, FLOATING POINT ON LEFT. F1B55150
SLT 2 F1B55160
TRA *+2 F1B55170
TSX COMP0C,2 RESULT IS IN MQ, COMPILE XCA F1B55180
TSX CFLOAT,2 COMPILE INSTRUCTIONS TO FLOAT MOST SIGN. F1B55190
TSX CIT00,4 F1B55200
PZE L(0),,L(STO) STO IN 4) F1B55210
PZE P(,,L(0) F1B55220
TSX CIT00,4 F1B55230
PZE L(0),,L(STZ) COMPILE STZ IN 4)-1 FOR LEAST SIGNIF PART.F1B55240
PZE P(,,DECMI1 F1B55250
TRA ES0630 RETURN TO STANDARD FORTRAN F1B55260
REM F1B55270
REM FLOATING POINT ON BOTH SIDES OF EQUAL SIGN. F1B55280
ES132D SLT 2 F1B55290
TRA ES0630 F1B55300
TSX CPMQAC,2 COMPILE SEQUENCE TO MOVE MQ TO AC. F1B55310
TRA ES0630 F1B55320
REM F1B55330
REM FIXED POINT ON LEFT OF EQUAL SIGN. F1B55340
ES136D TSX DIAG,4 ILLEGAL DP OR CA DEFINITION OF FIXED FUNCT F1B55350
REM F1B55360
REM F1B55370
REM STATEMENT IS AN IF(...)N1,N2,N3 F1B55380
ES150D SLT 4 F1B55390
TRA *+2 F1B55400
TRA ES1500 FIXED POINT, RETURN TO STANDARD FORTRAN. F1B55410
REM FLOATING POINT ON RIGHT OF EQUAL. F1B55420
SLT 2 F1B55430
TRA *+4 F1B55440
TSX CPCLA2,2 MOST SIGN. (REAL) MQ TO MACHINE AC. F1B55450
AXT DECMI3,2 F1B55460
TRA *+3 F1B55470
TSX CPCLA1,2 MOST SIGN. (REAL) AC TO MACHINE AC. F1B55480
AXT DECMI1,2 F1B55490
TRA ES1500 RETURN TO STANDARD FORTRAN. F1B55500
REM F1B55510
CLA MODECL IS THIS DOUBLE-PRECISION. F1B55520
SUB L(D) F1B55530
TNZ ES1500 NO, EXIT. F1B55540
SXD *+3,2 YES, SET ADDEND. F1B55550
TSX CIT00,4 F1B55560
PZE L(0),,L(ADD) F1B55570
PZE P(,,** F1B55580
TRA ES1500 RETURN TO STANDARD FORTRAN. F1B55590
REM F1B55600
REM F1B55610
REM F1B55620
REM SUBROUTINE TO PROVIDE ADDRESS OF MOST SIGNIFICANT (REAL) PARTF1B55630
REM AND ADDRESS OF LEAST SIGNIFICANT (IMAGINARY) PART FOR F1B55640
REM FOR COMPILATION OF DOUBLE PRECISION AND COMPLEX ARITHMETIC. F1B55650
REM F1B55660
REM USES STANDARD AC0000 ROUTINE TO GET ADDRESS OF MOST SIGN. F1B55670
REM PART. THEN SUBTRACTS ONE FOR ALL BUT SUBSCRIPTED VARIABLES. F1B55680
REM FOR SUBSCRIPTED VARIABLES LOOKS IN DLIST1 AND GETS SIZE OF F1B55690
REM ARRAY WHICH IT THEN SUBTRACTS TO FORM LEAST SIGN ADDRESSS. F1B55700
REM F1B55710
REM ENTRY POINT FOR LEFT OF EQUAL. F1B55720
ACDP0L SXA ACDP04,4 SAVE CALLING TAG. F1B55730
TSX AC0M60,4 PREPARE CW+2, CW+3 F1B55740
TRA ACDP00+2 F1B55750
REM F1B55760
REM ENTRY POINT FOR RIGHT OF EQUAL. F1B55770
ACDP00 SXA ACDP04,4 SAVE CALLING TAG F1B55780
TSX AC0000,4 GET ADDRESS OF MOST SIGNIFICANT PART F1B55790
LXD DLIST1-2,4 SUBSCRIPTED, GET COUNT OF ENTRIES IN DLST1 F1B55800
AXT 0,2 INITIALIZE INDEX FOR SEARCH. F1B55810
CLA CW+2 GET VARIABLE NAME. F1B55820
ACDP01 CAS **,2 AND F1B55830
TXI ACDP02,2,-2 SEARCH FOR IT IN DLST1 F1B55840
TRA ACDP03 FOUND F1B55850
TXI ACDP02,2,-2 F1B55860
ACDP02 TIX ACDP01,4,1 CONTINUE SEARCH F1B55870
CLA TAGWRD IS THIS A NON-SUBSCRIPTED VARIABLE. F1B55880
TRA ACDP08 (25)F1B55890
ERDP01 TSX DIAG,4 NOT FOUND IS ERROR F1B55900
ACDP03 CLA CW+3 F1B55910
STO DPCW ADDRESS AND STORE F1B55920
LRS 0 F1B55930
ANA 1BAR ERASE ALL BUT ADDEND F1B55940
LLS 0 GET SIGN BACK F1B55950
ACDP07 SUB **,2 SUBTRACT SIZE OF ARRAY (DLST1+1) F1B55960
STD DPCW STORE NEW ADDEND F1B55970
LDQ L(0) F1B55980
LRS 0 SAVE SIGN F1B55990
XCL F1B56000
STP DPCW STORE NEW SIGN F1B56010
TRA ACDP04 F1B56020
ACDP05 CLA CW+3 GET ADDRESS F1B56030
SUB 2E18 SUBTRACT ONE TO FORM LEAST SIGNIFICANT F1B56040
STO DPCW ADDRESS AND STORE F1B56050
CAL CW+2 F1B56060
TZE ACDP04 ABSOLUTE ADDRESS CASE F1B56070
ARS 30 F1B56080
CAS L(1) 1) ERASEABLE CASE F1B56090
TRA *+2 F1B56100
TRA ACDP06 F1B56110
CAS L(4) 4) ERASEABLE CASE F1B56120
TRA ACDP04 F1B56130
TRA ACDP06 F1B56140
TRA ACDP04 F1B56150
ACDP06 LXD CW+3,4 GET ADDEND F1B56160
PXD 0,4 F1B56170
ALS 1 DOUBLE IT F1B56180
STO DPCW USE X)+2I AS LEAST SIGNIF ADDRESS F1B56190
ADD 2E18 ADD ONE FOR MOST SIGNIF F1B56200
STO CW+3 USE AS MOST SIGNIF F1B56210
ACDP04 AXT ..,4 RELOAD CALLING TAG F1B56220
TRA 1,4 RETURN TO CALLER F1B56230
REM F1B56240
REM SUBROUTINE TO COMPILE DP AND CA SEQUENCE FOR CLA F1B56250
CPDCLA TSX CIT00,4 F1B56260
PZE CW,,L(CLA) CLA MOST. SIGN. (REAL) PART. F1B56270
PZE CW+2,,CW+3 F1B56280
STZ CW F1B56290
TSX CIT00,4 F1B56300
PZE L(0),,L(STO) STO 4) F1B56310
PZE P(,,L(0) F1B56320
TSX CIT00,4 F1B56330
PZE L(0),,L(CLA) CLA LEAST SIGN. (IMAG.) PART. F1B56340
PZE CW+2,,DPCW F1B56350
TSX CIT00,4 F1B56360
PZE L(0),,L(STO) STO 4)-1 F1B56370
PZE P(,,DECMI1 F1B56380
TRA 1,2 F1B56390
REM F1B56400
REM SUBROUTINE TO COMPILE DP AND CA SEQUENCE FOR CLS F1B56410
CPDCLS TSX CIT00,4 F1B56420
PZE CW,,L(CLS) CLS MOST. SIGN. (REAL) PART. F1B56430
PZE CW+2,,CW+3 F1B56440
STZ CW F1B56450
TSX CIT00,4 F1B56460
PZE L(0),,L(STO) STO 4) F1B56470
PZE P(,,L(0) F1B56480
TSX CIT00,4 F1B56490
PZE L(0),,L(CLS) CLS LEAST SIGN. (IMAG.) PART. F1B56500
PZE CW+2,,DPCW F1B56510
TSX CIT00,4 F1B56520
PZE L(0),,L(STO) STO 4)-1 F1B56530
PZE P(,,DECMI1 F1B56540
TRA 1,2 F1B56550
REM F1B56560
REM SUBROUTINE TO COMPILE DP AND CA SEQUENCE FOR STO F1B56570
CPDSTO TSX CIT00,4 F1B56580
PZE L(0),,L(CLA) F1B56590
PZE P(,,L(0) F1B56600
TSX CIT00,4 F1B56610
PZE L(0),,L(STO) F1B56620
PZE CW+2,,CW+3 F1B56630
TSX CIT00,4 F1B56640
PZE L(0),,L(CLA) F1B56650
PZE P(,,DECMI1 F1B56660
TSX CIT00,4 F1B56670
PZE L(0),,L(STO) F1B56680
PZE CW+2,,DPCW F1B56690
TRA 1,2 F1B56700
REM F1B56710
REM SUBROUTINE TO COMPILE DP AND CA SEQUENCE FOR LDQ F1B56720
CPDLDQ TSX CIT00,4 F1B56730
PZE CW,,L(LDQ) F1B56740
PZE CW+2,,CW+3 F1B56750
STZ CW F1B56760
TSX CIT00,4 F1B56770
PZE L(0),,L(STQ) F1B56780
PZE P(,,DECMI2 F1B56790
TSX CIT00,4 F1B56800
PZE L(0),,L(LDQ) F1B56810
PZE CW+2,,DPCW F1B56820
TSX CIT00,4 F1B56830
PZE L(0),,L(STQ) F1B56840
PZE P(,,DECMI3 F1B56850
TRA 1,2 F1B56860
REM F1B56870
REM SUBROUTINE TO COMPILE DP AND CA SEQUENCE FOR STQ F1B56880
CPDSTQ TSX CIT00,4 F1B56890
PZE L(0),,L(LDQ) F1B56900
PZE P(,,DECMI2 F1B56910
TSX CIT00,4 F1B56920
PZE L(0),,L(STQ) F1B56930
PZE CW+2,,CW+3 F1B56940
TSX CIT00,4 F1B56950
PZE L(0),,L(LDQ) F1B56960
PZE P(,,DECMI3 F1B56970
TSX CIT00,4 F1B56980
PZE L(0),,L(STQ) F1B56990
PZE CW+2,,DPCW F1B57000
TRA 1,2 F1B57010
REM F1B57020
REM SUBROUTINE TO COMPILE DP AND CA SEQUENCE FOR CHS F1B57030
CPDCHS TSX CIT00,4 F1B57040
PZE L(0),,L(CLS) CLS 4) F1B57050
PZE P(,,L(0) F1B57060
TSX CIT00,4 F1B57070
PZE L(0),,L(STO) STO 4) F1B57080
PZE P(,,L(0) F1B57090
TSX CIT00,4 F1B57100
PZE L(0),,L(CLS) CLS 4)-1 F1B57110
PZE P(,,DECMI1 F1B57120
TSX CIT00,4 F1B57130
PZE L(0),,L(STO) STO 4)-1 F1B57140
PZE P(,,DECMI1 F1B57150
TRA 1,2 F1B57160
REM F1B57170
REM SUBROUTINE TO COMPILE SEQUENCE TO MOVE AC TO MQ. F1B57180
CPACMQ TSX CIT00,4 F1B57190
PZE L(0),,L(LDQ) LDQ 4) F1B57200
PZE P(,,L(0) F1B57210
TSX CIT00,4 F1B57220
PZE L(0),,L(STQ) STQ 4)-2 F1B57230
PZE P(,,DECMI2 F1B57240
TSX CIT00,4 F1B57250
PZE L(0),,L(LDQ) LDQ 4)-1 F1B57260
PZE P(,,DECMI1 F1B57270
TSX CIT00,4 F1B57280
PZE L(0),,L(STQ) STQ 4)-3 F1B57290
PZE P(,,DECMI3 F1B57300
TRA 1,2 F1B57310
REM F1B57320
REM SUBROUTINE TO COMPILE SEQUENCE TO MOVE MQ TO AC. F1B57330
CPMQAC TSX CIT00,4 F1B57340
PZE L(0),,L(CLA) CLA 4)-2 F1B57350
PZE P(,,DECMI2 F1B57360
TSX CIT00,4 F1B57370
PZE L(0),,L(STO) STO 4) F1B57380
PZE P(,,L(0) F1B57390
TSX CIT00,4 F1B57400
PZE L(0),,L(CLA) CLA 4)-3 F1B57410
PZE P(,,DECMI3 F1B57420
TSX CIT00,4 F1B57430
PZE L(0),,L(STO) STO 4)-1 F1B57440
PZE P(,,DECMI1 F1B57450
TRA 1,2 F1B57460
REM F1B57470
REM SUBROUTINE TO COMPILE THE DP SEQUENCE FOR FAD F1B57480
CPDFAD CLA (DFAD) GET NAME OF SUBROUTINE F1B57490
STO G AND PREPARE TO ENTER IT IN CLOSUB TABLE. F1B57500
NZT *+2 TEST WHETHER FIRST TIME THIS CALLING F1B57510
TRA DPSUB2 NOT FIRST TIME, SKIP CLOSUB ENTRY. F1B57520
STZ * FIRST TIME, RESET TEST FOR ALL LATER TIMES.F1B57530
TRA DPSUB1 FIRST TIME, MAKE CLOSUB ENTRY F1B57540
REM F1B57550
REM SUBROUTINE TO COMPILE THE DP SEQUENCE FOR FSB F1B57560
CPDFSB CLA (DFSB) GET NAME OF SUBROUTINE F1B57570
STO G AND PREPARE TO ENTER IT IN CLOSUB TABLE. F1B57580
NZT *+2 TEST WHETHER FIRST TIME THIS CALLING F1B57590
TRA DPSUB2 NOT FIRST TIME, SKIP CLOSUB ENTRY. F1B57600
STZ * FIRST TIME, RESET TEST FOR ALL LATER TIMES.F1B57610
TRA DPSUB1 FIRST TIME, MAKE CLOSUB ENTRY F1B57620
REM F1B57630
REM SUBROUTINE TO COMPILE THE DP SEQUENCE FOR FMP F1B57640
CPDFMP CLA (DFMP) GET NAME OF SUBROUTINE F1B57650
STO G AND PREPARE TO ENTER IT IN CLOSUB TABLE. F1B57660
NZT *+2 TEST WHETHER FIRST TIME THIS CALLING F1B57670
TRA DPSUB2 NOT FIRST TIME, SKIP CLOSUB ENTRY. F1B57680
STZ * FIRST TIME, RESET TEST FOR ALL LATER TIMES.F1B57690
TRA DPSUB1 FIRST TIME, MAKE CLOSUB ENTRY F1B57700
REM F1B57710
REM SUBROUTINE TO COMPILE THE DP SEQUENCE FOR FDP F1B57720
CPDFDP CLA (DFDP) GET NAME OF SUBROUTINE F1B57730
STO G AND PREPARE TO ENTER IT IN CLOSUB TABLE. F1B57740
NZT *+2 TEST WHETHER FIRST TIME THIS CALLING F1B57750
TRA DPSUB2 NOT FIRST TIME, SKIP CLOSUB ENTRY. F1B57760
STZ * FIRST TIME, RESET TEST FOR ALL LATER TIMES.F1B57770
TRA DPSUB1 FIRST TIME, MAKE CLOSUB ENTRY F1B57780
REM F1B57790
REM SUBROUTINE TO COMPILE THE CA SEQUENCE FOR FDP F1B57800
CPIFMP CLA (IFMP) GET NAME OF SUBROUTINE F1B57810
STO G AND PREPARE TO ENTER IT IN CLOSUB TABLE. F1B57820
NZT *+2 TEST WHETHER FIRST TIME THIS CALLING F1B57830
TRA DPSUB2 NOT FIRST TIME, SKIP CLOSUB ENTRY. F1B57840
STZ * FIRST TIME, RESET TEST FOR ALL LATER TIMES.F1B57850
TRA DPSUB1 FIRST TIME, MAKE CLOSUB ENTRY F1B57860
REM F1B57870
REM SUBROUTINE TO COMPILE THE CA SEQUENCE FOR FMP F1B57880
CPIFDP CLA (IFDP) GET NAME OF SUBROUTINE F1B57890
STO G AND PREPARE TO ENTER IT IN CLOSUB TABLE. F1B57900
NZT *+2 TEST WHETHER FIRST TIME THIS CALLING F1B57910
TRA DPSUB2 NOT FIRST TIME, SKIP CLOSUB ENTRY. F1B57920
STZ * FIRST TIME, RESET TEST FOR ALL LATER TIMES.F1B57930
REM F1B57940
REM COMMON PART OF SUBROUTINE FOR ABOVE SIX ENTRIES... F1B57950
DPSUB1 SXA *+3,1 F1B57960
TSX TET00,1 F1B57970
PZE 9 F1B57980
AXT ..,1 F1B57990
REM F1B58000
DPSUB2 TRA PCH8 GO SAVE CURRENT OPERATION NAME $F1B58010
CAS TRAPCL COMPARE TO LAST NAME IN LOC. 2 F1B58020
TRA *+2 F1B58030
TRA DPSUB4 SAME NAME, DO NOT COMPILE CAL (...), SLW 2F1B58040
STO TRAPCL DIFFERENT NAME, CHANGE INDICATOR F1B58050
TSX CIT00,4 F1B58060
PZE L(0),,L(CLA) $F1B58070
PZE G,,L(0) F1B58080
TSX CIT00,4 F1B58090
PZE L(0),,L(STO) $F1B58100
PZE L(0),,2E19 F1B58110
DPSUB4 TSX CIT00,4 F1B58120
PZE L(0),,L(STR) F1B58130
PZE CW+2,,CW+3 F1B58140
TSX CIT00,4 F1B58150
PZE L(0),,L(PZE) F1B58160
PZE CW+2,,DPCW F1B58170
TRA 1,2 SEQUENCE HAS BEEN COMPILED. F1B58180
REM F1B58190
TRAPCL PZE 0 INDICATOR OF CONTENTS OF LOC. 2 F1B58200
(DFAD) BCD 1(DFAD) F1B58210
(DFSB) BCD 1(DFSB) F1B58220
(DFMP) BCD 1(DFMP) F1B58230
(DFDP) BCD 1(DFDP) F1B58240
(IFMP) BCD 1(IFMP) F1B58250
(IFDP) BCD 1(IFDP) F1B58260
REM F1B58270
DPCW PZE F1B58280
DECMI3 MZE ,,3 F1B58290
REM F1B58300
REM SUBROUTINE TO COMPILE SEQUENCE TO SET UP AN ARGUMENT FOR F1B58310
REM EITHER ARITHMETIC STATEMENT FUNCTIONS OR FOR CLOSED (LIBRARY)F1B58320
REM FUNCTIONS. F1B58330
REM F1B58340
CPDARG ZAC (22)F1B58350
LDQ SCRIPL+2,1 OBTAIN OPERAND (22)F1B58360
LGL 1 (22)F1B58370
LBT TEST FOR VARIABLE (22)F1B58380
TQP DARG03 LEVEL NUMBER (22)F1B58390
LGL 5 VARIABLE, TEST TYPE (22)F1B58400
CAS L(H) (26)F1B58410
CAS L(O) (26)F1B58420
TRA DARGFL FLOATING (22)F1B58430
TRA DARGFL FLOATING (22)F1B58440
TRA DARGFX FIXED (22)F1B58450
DARGFL TSX CIT00,4 MOVE HIGH ORDER (REAL) PART (22)F1B58460
CW,,L(CLA) (22)F1B58470
CW+2,,CW+3 (22)F1B58480
TSX CIT00,4 (22)F1B58490
L(0),,L(STO) (22)F1B58500
ARGORG,,COUNT1 (22)F1B58510
TSX CIT00,4 MOVE LOW ORDER (IMAGINARY) PART (22)F1B58520
L(0),,L(CLA) (22)F1B58530
CW+2,,DPCW (22)F1B58540
TSX CIT00,4 (22)F1B58550
L(0),,L(STO) (22)F1B58560
ARGORG,,COUNT2 (22)F1B58570
REM REENTRY TO UPDATE ARGUMENT COUNT CELLS (22)F1B58580
DARG02 CAL COUNT1 F1B58590
ADD 2E19 F1B58600
SLW COUNT1 F1B58610
CAL COUNT2 F1B58620
ADD 2E19 F1B58630
SLW COUNT2 F1B58640
TRA 1,2 F1B58650
REM F1B58660
REM SUBROUTINE TO COMPILE STZ IN LEAST SIGN) (REAL) PART. F1B58670
CPSTZ1 TSX CIT00,4 F1B58680
PZE L(0),,L(STZ) F1B58690
PZE CW+2,,CW+3 F1B58700
TRA 1,2 F1B58710
REM F1B58720
REM SUBROUTINE TO COMPILE CLA OF MOST SIGN) (REAL) AC. F1B58730
CPCLA1 TSX CIT00,4 F1B58740
PZE L(0),,L(CLA) F1B58750
PZE P(,,L(0) F1B58760
TRA 1,2 F1B58770
REM F1B58780
REM SUBROUTINE TO COMPILE CLA OF MOST SIGN. (REAL) PART OF MQ. F1B58790
CPCLA2 TSX CIT00,4 F1B58800
PZE L(0),,L(CLA) F1B58810
PZE P(,,DECMI2 F1B58820
TRA 1,2 F1B58830
REM F1B58840
REM SUBROUTINE TO COMPILE SEQUENCE TO FIX A FLOATING POINT RESULTF1B58850
CPFIX TSX CIT00,4 F1B58860
PZE L(0),,L(UFA) F1B58870
PZE O(,,L(0) F1B58880
TSX CIT00,4 F1B58890
PZE L(0),,L(LRS) F1B58900
PZE L(0),,L(0) F1B58910
TSX CIT00,4 F1B58920
PZE L(0),,L(ANA) F1B58930
PZE O(,,2E18 F1B58940
TSX CIT00,4 F1B58950
PZE L(0),,L(LLS) F1B58960
PZE L(0),,L(0) F1B58970
TSX CIT00,4 F1B58980
PZE L(0),,L(ALS) F1B58990
PZE L(0),,DEC18 F1B59000
TRA 1,2 F1B59010
REM F1B59020
REM SUBROUTINE TO COMPILE FLOATING SEQUENCE F1B59030
CFLOAT TSX CIT00,4 F1B59040
PZE L(0),,L(LRS) F1B59050
PZE L(0),,DEC18 F1B59060
TSX CIT00,4 F1B59070
PZE L(0),,L(ORA) F1B59080
PZE O(,,L(0) F1B59090
TSX CIT00,4 F1B59100
PZE L(0),,L(FAD) F1B59110
PZE O(,,L(0) F1B59120
TRA 1,2 F1B59130
COUNT1 PZE 0 F1B59140
COUNT2 PZE 0 F1B59150
REM F1B59160
REM SUBROUTINE TO COMPILE SEQUENCE FOR DABS FUNCTION F1B59170
CPDABS TSX CIT00,4 F1B59180
PZE L(0),,L(CLA) F1B59190
PZE P(,,L(0) F1B59200
TSX CIT00,4 F1B59210
PZE L(0),,L(SLW) F1B59220
PZE P(,,L(0) F1B59230
TSX CIT00,4 F1B59240
PZE L(0),,L(CLA) F1B59250
PZE P(,,DECMI1 F1B59260
TSX CIT00,4 F1B59270
PZE L(0),,L(SLW) F1B59280
PZE P(,,DECMI1 F1B59290
TRA ES000D F1B59300
REM F1B59310
REM SUBROUTINE TO COMPILE SEQUENCE FOR DSIGN FUNCTION F1B59320
REM OR ISIGN FUNCTION. F1B5932A
REM F1B5932B
CISIGN STL CAFLG SET SWITCH TO COMPILE ISIGN. F1B5932C
TRA CDSIGN+1 F1B5932D
REM F1B5932E
CAFLG PZE ** CA OR DP FLAG. F1B5932F
REM F1B5932G
CDSIGN STZ CAFLG SET SWITCH TO COMPILE DSIGN. F1B5932H
TSX CIT00,4 F1B59330
PZE L(0),,L(CLA) F1B59340
PZE P(,,L(0) F1B59350
TSX CIT00,4 F1B59360
PZE L(0),,L(LDQ) F1B59370
PZE P(,,DECMI2 F1B59380
TSX CIT00,4 F1B59390
PZE L(0),,L(LLS) F1B59400
PZE L(0),,L(0) F1B59410
TSX CIT00,4 F1B59420
PZE L(0),,L(STO) F1B59430
PZE P(,,L(0) F1B59440
NZT CAFLG IS THIS COMPLEX OR DP. F1B59441
TRA *+4 DOUBLE PRECISION. F1B59442
TSX CIT00,4 COMPLEX. F1B59443
PZE L(0),,L(LDQ) F1B59444
PZE P(,,DECMI3 F1B59445
TSX CIT00,4 F1B59450
PZE L(0),,L(CLA) F1B59460
PZE P(,,DECMI1 F1B59470
TSX CIT00,4 F1B59480
PZE L(0),,L(LLS) F1B59490
PZE L(0),,L(0) F1B59500
TSX CIT00,4 F1B59510
PZE L(0),,L(STO) F1B59520
PZE P(,,DECMI1 F1B59530
TRA ES000D F1B59540
REM F1B59550
REM F1B59560
REM F1B59570
DARG03 SXA DARG05,2 OPERAND IS LEVEL NUMBER (22)F1B59580
AXT 0,2 FIND MATCHING LEVEL (26)F1B59590
LXD 3LBAR,4 (22)F1B59600
DARG04 SXD *+1,2 BUMP TO BEGINNING OF (22)F1B59610
TXI *+1,4,** NEXT LEVEL (22)F1B59620
CAL SCRIPL,4 OBTAIN ITS LEVEL NUMBER (22)F1B59630
ANA MASK2 ISOLATE IT AND (22)F1B59640
LAS SCRIPL+2,1 COMPARE WITH DESIRED (22)F1B59650
TRA *+2 OPERAND (22)F1B59660
TRA DARG05 FOUND (22)F1B59670
PAX ,2 NOT FOUND, OBTAIN SEGMENT (22)F1B59680
CLA CPBETA,2 LENGTH FROM CORRESPONDING (22)F1B59690
PAX CPBETA,2 BETA ENTRY, AND THEN (22)F1B59700
TRA DARG04 LOOK AT NEXT LEVEL (22)F1B59710
REM (22)F1B59720
REM SUBROUTINE TO COMPILE SEQUENCE FOR DFLOAT, IFLOAT IN LINE(22)F1B59730
REM (22)F1B59740
CDFLOT TSX CFLOAT,2 COMPILE FLOATING SEQUENCE (22)F1B59750
TSX CIT00,4 F1B59760
PZE L(0),,L(STO) F1B59770
PZE P(,,L(0) F1B59780
TSX CIT00,4 F1B59790
PZE L(0),,L(STZ) F1B59800
PZE P(,,DECMI1 F1B59810
TRA ES000D F1B59820
REM F1B59830
REM F1B59840
REM SUBROUTINE TO ENTER DOUBLE PRECISION FLOATING POINT CONSTANT F1B59850
REM IN FLOCON TABLE. F1B59860
REM F1B59870
REM THIS ROUTINE ASSUMES THE MOST SIGNIFICANT PART IN G+1, THE F1B59880
REM LEAST SIGNIFICANT PART IN G. IT SCANS THE FLOCON TABLE AND I F1B59890
REM NOT FOUND ENTERS AS A TWO WORD ENTRY WITH THE LEAST SIGN. F1B59900
REM PART FIRST, WHETHER FOUND OR ENTERED IT RETURNS A TAG IN AC F1B59910
REM WHICH IS THE RELATIVE POSITION OF THE MOST SIGN. PART IN THE F1B59920
REM TABLE. F1B59930
REM F1B59940
DFLCON SXA XR1,1 SAVE INDEX REGISTERS. F1B59950
SXA XR2,2 F1B59960
SXA XR4,4 F1B59970
LXA L(0),3 SET FOR FORWARD SCAN. F1B59980
CLA G GET LEAST SIGN. PART. F1B59990
LXD FLCNIX-2,4 GET AND TEST NUMBER OF ENTRIES IN FLOCON. F1B60000
TXL ENFC05,4,0 0 MEANS NO PREVIOUS DP-CA ENTRIES, GO ENTERF1B60010
ENFC01 CAS **,2 SCAN FLOCON TABLE FOR MATCH TO LEAST SIGN. F1B60020
TXI *+3,2,-1 PART OF AGRUMENT. F1B60030
TXI ENFC04,1,1 MATCH FOUND. F1B60040
TXI *+1,2,-1 NO MATCH, GO TO NEXT ENTRY. F1B60050
ENFC02 TXI *+1,1,1 KEEP IR1 UPDATED AS TAG TO BE RETURNED. F1B60060
TIX ENFC01,4,1 TEST FOR LAST ENTRY IN TABLE. F1B60070
ENFC05 STO **,2 STORE LEAST SIGN. PART IN FLOCON TABLE. F1B60080
CLA G+1 F1B60090
ENFC06 STO **,2 NOW STORE MOST SIGN. PART IN NEXT PLACE. F1B60100
CLA FLCNIX-2 F1B60110
ADD 2AND2 F1B60120
STO FLCNIX-2 F1B60130
TXI *+1,1,1 READJUST TAG FOR EXIT. F1B60140
ENFC03 PXA ,1 TAG TO AC. F1B60150
XR1 AXT **,1 RESTORE INDEX REGISTERS. F1B60170
XR2 AXT **,2 F1B60180
XR4 AXT **,4 F1B60190
TRA 1,4 RETURN TO CALLER. F1B60200
ENFC04 TXL ENFC07+3,4,2 *IS THERE ANOTHER ENTRY IN FLOCON, NO. $F1B60210
CLA G+1 YES, COMPARE MOST MOST SIGNIFICANT PART. F1B60211
ENFC07 SUB **,2 PART AGAINST NEXT WORD OF FLOCON. F1B60220
TZE ENFC03 MATCH, THEREFORE THIS DP FLOCON INTABLE, F1B60230
CLA G NO MATCH, CONTINUE SEARCH. F1B60240
TXI ENFC02+1,2,-1 F1B60250
REM F1B60260
REM F1B60270
REM END OF ARITHMETIC PROCESSOR. F1B60280
REM F1B60290
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B60300
REM F1B60310
REM F1B60320
REM PASS 2/5-PATCH AREA= F1B60330
BEGP2P SYN * BEGINNING OF PASS 2 PATCHING AREA. F1B60340
P1B00B STZ TRAPCL RESET LAST OP-CODE *F1B60341
LGL 7 OP1(S(I)) = SPOP (RESTORE OP) *F1B60342
TRA CP204D+1 RETURN FROM PATCH *F1B60343
REM *F1B60344
CPPCH STZ XCAIND $F1B60345
STZ PHI(I) $F1B60346
TRA CP0000+3 $F1B60347
PCH1 CLA SIG1ST $F1B60348
STZ DBRCP SET SWITCH FOR DP OR I ROUTINES $F1B60349
TRA ARITH+2 $F1B60350
PCH2 SXA *+2,4 SAVE RETURN FOR CIT00 $F1B60351
TSX DBCHK,4 PUTS IN LDQ6)+5 STQ2 IF DP OR COMPLEX $F1B60352
AXT **,4 $F1B60353
TRA CIT00 $F1B60354
PCH4 TSX TET00,1 GO TO PROGRAM TO ENTER 1C,1C+1 $F1B60360
PZE 2 INTO TIFGO TABLE (TABLE 2) $F1B60361
TRA ES1500+1 $F1B60362
PCH5 TSX DBCHK,4 GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX $F1B60368
TRA 1,2 $F1B60369
REM F1B60370
PCH7 TXH ES130D,4,0 YES WILL TRA NO WILL NOP $F1B60373
STO DBSAC SAVE AC $F1B60374
TSX DBCHK,4 COMPILE LDQ6)+5 STQ2 IF NECESSARY $F1B60375
CLA DBSAC RESTORE AND CONTINUE $F1B60376
TRA ES016D+11 $F1B60377
PCH8 CLA G GET CURRENT OPERATION NAME $F1B60378
STL DBRCP SET NON ZERO FOR DP OR I ROUTINES $F1B60379
TRA DPSUB2+1 $F1B60380
PCH9 TSX CIT00,4 COMPILE $F1B60381
PZE CW,,L(SXD) SXD 6)+4,4 $F1B60382
PZE O(,,D4A4 $F1B60383
TRA 1,2 $F1B60390
DBCHK NZT DBRCP SEE IF ANY DP OR I ROUTINES WERE COMPILED$F1B60392
TRA 1,4 NO $F1B60393
SXA DBRTN,4 $F1B60400
REM F1B60410
TSX CIT00,4 COMPILE $F1B60419
PZE L(0),,L(LDQ) LDQ 6)+5 $F1B60420
PZE O(,,DEC5 $F1B60421
TSX CIT00,4 COMPILE $F1B60422
PZE L(0),,L(STQ) STQ 2 $F1B60423
PZE L(0),,D2 $F1B60424
DBRTN AXT **,4 $F1B60425
TRA 1,4 $F1B60426
DBSAC PZE SAVE AC $F1B60427
DBRCP PZE $F1B60429
PCH10 TSX CIT00,4 COMPILE $F1B6042A
PZE CW,,L(SXD) SXD 7),4 $F1B6042B
PZE X(,,L(4) $F1B6042C
TRA 1,2 $F1B6042D
1D1P ALS 4 TAKE RESULT $F1B60430
ARS 4 MODULO 32,768 $F1B60431
STO GTAG $F1B60432
TRA 1D1+2 RETURN FROM PATCH AREA $F1B60433
PFTAG STL ACFTG SET SWITCH FOR ARITH. (23)F1B60434
TRA PCH1 (23)F1B60435
LSCP AXT NXS,4 $F1B60436
SXA CMASW,4 $F1B60437
CAL SPC4 $F1B60438
SSM $F1B60439
STO SPC4 $F1B6043A
STZ GTAG CLEAR GENERALIZED TAG. $F1B6043B
TRA LSC $F1B6043C
EXPCH CAL SCRIPL+4,A $F1B6043D
ERA STRSTR $F1B6043E
ANA EXPCH2 IS SECOND OP ** $F1B6043F
TNZ EXPCH1 TRA IF NOT - NO ERROR $F1B6043G
CAL SCRIPL+7,A $F1B6043H
ERA STRSTR $F1B6043I
ANA EXPCH2 IS THIRD OP ** $F1B6043J
TNZ EXPCH1 TRA IF NOT - NO ERROR $F1B6043K
TXH EXPCH1,C,-8 ARE THERE THREE OPS IN SEGMENT $F1B6043L
ER0082 TSX DIAG,4 YES, DOUBLE EXPONENTIATION ERROR $F1B6043M
EXPCH1 CAL SCRIPL+2,A $F1B6043N
TRA PL0680+2 $F1B6043O
EXPCH2 OCT 777700000000 $F1B6043P
ARITH1 CLA MODECL CHECK FOR CA MODE $F1B60440
SUB L(I) $F1B60441
TZE ARITH2 $F1B60442
CAL TXHOP NOT CA MODE $F1B60443
TRA *+2 $F1B60444
ARITH2 CAL TXLOP CA MODE, DO NOT SCAN FOR ILLEGAL COMMA $F1B60445
STP CMPCH $F1B60446
TRA PFTAG TO SET ARITH COMPILER SWITCH. (23)F1B60447
REM $F1B60448
CMPCH TXH CMPCH1+2,0,0 TRANSFER IF CA MODE $F1B6044C
AXT 0,2 INITIALIZE XR2 $F1B6044D
TXI *+1,1,3 BUMP BACK TO LAST ENTRY IN IN LAMBDA TBL $F1B6044E
TXL *+2,1,0 TABLE EXHAUSTED,NO FUNCTION AT LEVEL $F1B6044F
CAS LAMBDA,1 SEARCH FOR MATCHING LEVEL $F1B6044G
TRA ER0002 HIGHER LEVEL FOUND,NO FUNCTION AT LEVEL $F1B6044H
TXI CMPCH1,2,1 SAME LEVEL FOUND-CHECK FOR FUNCTION $F1B6044I
TRA CMPCH+1 NOT FOUND, LOOK HIGHER IN TABLE $F1B6044J
CMPCH1 TXL CMPCH+2,2,1 TRA IF THIS NOT DUPLICATE ENTRY $F1B6044K
LXD 3LBAR,1 DUPLICATE ENTRY AT SAME LEVEL FOUND $F1B6044L
CAL ADSPOP COMMA SEPARATES FUNCTION ARGUMENTS-OK $F1B6044M
TRA MS210+6 RETURN $F1B6044N
PDFN2 TOV *+1 TURN OFF OVERFLOW. (20)F1B6044O
TQP DFN3 TO THE RIGHT OR TO THE LEFT OF DP. (20)F1B6044P
TRA DFN2+2 RETURN. (20)F1B6044Q
CFTAG LDC INTETE-3,1 COUNT OF WORDS IN FORTAG (23)F1B60450
TXL *+4,1,0 BUFFER.. IS IT ZERO (23)F1B60451
CAL FRTGBF-1,1 NO, COMPARE LAST ENTRY (23)F1B60452
ERA G WITH NEW ONE (23)F1B60453
TZE 1,2 SAME (23)F1B60454
TSX TET00,1 NO, MAKE FORTAG ENTRY (23)F1B60455
PZE 4 (23)F1B60456
TRA 1,2 (23)F1B60457
ACFTG ** FLAG FOR ARITHMETIC COMPILATION (23)F1B60458
ES1595 STZ ACFTG RESET ARITHMETIC COMPILER FLAG (23)F1B60459
TZE PASS2 WAS AN EXTRA IFN GENERATED (23)F1B6045A
TRA ES1590+3 YES, ENTER IN CALLFN TABLE (23)F1B6045B
CP5221 PXD 0,C STORE SUPP IFN (23)F1B6045C
SLW FNSW2 FOR LATER (23)F1B6045D
TRA CP5222 (23)F1B6045E
CP5521 TSX JIF,4 CREATE SUPPLEMENTARY IFN. (23)F1B6045F
STD 1C KEEP PENDING TIFGO ENTRY UPDATED. (23)F1B6045G
STO FNSW SIGNAL CALLFN ENTRY NEEDED. (23)F1B6045H
TRA CP5520+3 (23)F1B6045I
ACDP08 TMI ACDP05 *YES (25)F1B6045J
CAL CW+2 GET VARIABLE NAME. (25)F1B6045K
ARS 30 (25)F1B6045L
CAS L(H) COMPARE WITH H. (25)F1B6045M
CAS L(O) IF GREATER, COMPARE WITH O. (25)F1B6045N
TRA ERDP01 FLOATING POINT VARIABLE (25)F1B6045O
TRA ERDP01 TAKE ERROR EXIT. (25)F1B6045P
TRA ACDP05 FIXED POINT, OKAY. (25)F1B6045Q
MS238 CLA MS093 CHECK = SWITCH (29)F1B6045R
TMI MS040 NEG OKAY, GO COLLECT SYMBOL (29)F1B6045S
TRA ER0073 WRONG SIDE GIVE DIAGNOSTIC (29)F1B6045T
MS239 CLA MS093 TEST = SWITCH (29)F1B6045U
TPL ER0073 WRONG SIDE GIVE DIAGNOSTIC (29)F1B6045V
TSX C0190,4 GET NEXT CHARACTER,CHECK EXPONENTIATION(29)F1B6045W
TRA TRBLKA+2 (29)F1B6045X
C3302 STO C3303 SAVE ARGUMENT INDICATOR (29)F1B6045Y
CAL 1G GET SUBROUTINE NAME (29)F1B6045Z
SLW E+2 PREPARE FOR TABLE CHECK (29)F1B60460
TSX DIM1SR,4 CHECK ONE DIMENSIONAL ENTRIES (29)F1B60461
TRA *+2 NO ENTRY, CHECK TWO DIMENSIONAL TABLE (29)F1B60462
TRA ER0031 ERROR, SUBROUTINE NAME IS DIMENSIONED (29)F1B60463
TSX DIM2SR,4 CHECK TWO DIMENSIONAL ENTRIES (29)F1B60464
TRA *+2 NO ENTRY, CHECK THREE DIMENSIONAL TABLE(29)F1B60465
TRA ER0031 ERROR, SUBROUTINE NAME IS DIMENSIONED (29)F1B60466
TSX DIM3SR,4 CHECK THREE DIMENSIONAL ENTRIES (29)F1B60467
TRA *+2 NO ENTRY, CONTINUE WITH CALL PROCESSING(29)F1B60468
ER0031 TSX DIAG,4 WRITE ERROR MESSAGE FOR DIMENSIONED SUB(29)F1B60469
CLA C3303 RESTORE ARGUMENT INDICATOR (29)F1B6046A
TZE C3301 NO ARGUMENTS (29)F1B6046B
TRA C3300+4 CALL STATEMENT HAS ARGUMENTS (29)F1B6046C
C3303 PZE STORAGE FOR ARGUMENT INDICATOR (29)F1B6046D
C0501 STO 2H SET 2H FOR SENSE LIGHT (30)F1B6046E
TSX C0180X,2 OBTAIN LIGHT NO. (30)F1B6046F
TSX TESTF0,4 CHECK FOR RIGHT PAREN (30)F1B6046G
CLA 1G CHECK LIGHT NUMBER (30)F1B6046H
CAS L(0) TO BE SURE THAT IT IS (30)F1B6046I
CAS L(4) VALID(BETWEEN 1 + 4, INCLUSIVE) (30)F1B6046J
ER0018 TSX DIAG,4 INVALID LIGHT NUMBER, WRITE DIAGNOSTIC (30)F1B6046K
NOP (30)F1B6046L
TRA C0401+3 RETURN TO SENSE LIGHT PROCESSING (30)F1B6046M
BSS 245 ***PATCH SPACE (30)F1B6046N
REM F1B60470
ENDP2P SYN * END OF PASS 2 PATCHING AREA. $F1B60472
REM $F1B60473
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * $F1B60474
REM $F1B60475
ENDP2C SYN * $F1B60476
REM $F1B60477
ORG FLTR00 PATCH TO ELIMINATE THE COMPILATION $F1B60478
LBL 9F14FLOW,X (23)F1B60479
TRA CIT00 OF FLOW TRACING INSTRUCTIONS. (23)F1B6047A
EJECT F1B60480
REM F1B60490
REM SECTION 1 / ERASABLE STORAGE, BUFFERS AND CORE TABLES= F1B60500
REM F1B60510
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B60520
REM F1B60530
REM ERASABLE USED ONLY BY PASS 2. F1B60540
LBL 9F14CIT1,THE WORKS F1B60550
ORG ENDP2C ORIGIN OF CIT BUFFER. F1B60560
CITBUF SYN * COMPILED INSTRUCTION BUFFER. F1B60570
REM FIRST ENTRY IN EVERY PROGRAM $F1B60580
BCD 1$$ F1B60590
BCD 1CLA000 F1B60600
BCD 1000000 $F1B60610
PZE ,,2 $F1B60620
REM SECOND ENTRY IN EVERY PROGRAM $F1B60630
BCD 1000000 F1B60640
BCD 1STO000 F1B60650
BCD 1600000 $F1B60660
PZE ,,5 $F1B60670
REM ASSUMED THIRD ENTRY $F1B60680
BCD 1000000 $F1B60690
BCD 1CLA000 $F1B60700
BCD 1(FPT) $F1B60710
BCD 1000000 $F1B60720
REM ASSUMED FOURTH ENTRY $F1B60721
BCD 1000000 $F1B60722
BCD 1STO000 $F1B60723
BCD 1000000 $F1B60724
PZE ,,8 $F1B60725
REM ASSUMED FIFTH ENTRY $F1B60726
BCD 1000000 $F1B60727
BCD 1STZ000 $F1B60728
BCD 1400000 $F1B60729
MZE ,,205 $F1B60730
REM $F1B60731
BSS CITSIZ-20 $F1B60740
BSS CITSIZ LENGTH OF SECOND CIT BUFFER. F1B60750
ENDCIT SYN * END OF CIT BUFFER. F1B60760
REM F1B60770
ENDONE BSS 0 RECORD LIMIT FOR PASS TWO. F1B60780
REM F1B60790
REM F1B60800
COMERA ORG ENDCIT F1B60810
REM F1B60820
2H BSS 1 F1B60830
3LBAR BSS 1 STORAGE USED BY ARITHMETIC. F1B60840
ARERAS BSS 1 STORAGE USED BY ARITHMETIC. F1B60850
ARGCTR BSS 1 STORAGE USED BY ARITHMETIC. F1B60860
DIMSAV BSS 1 WORKING STORAGE USED BY SS000. F1B60870
EPSM3 BSS 3 F1B60880
EPS BSS 1 EPSILON - VARIABLE USED BY RA000. F1B60890
GTAG BSS 1 VARIABLE USED BY IOT, RA. F1B60900
I BSS 1 F1B60910
LENGTH BSS 1 F1B60920
NBAR BSS 1 STORAGE USED BY ARITHMETIC. F1B60930
N2 BSS 1 F1B60940
PHI(I) BSS 1 F1B60950
SL BSS 1 F1B60960
SYMBOL BSS 1 WORKING STORAGE USED BY SS000. F1B60970
SYN * END OF ERASABLE COMMON TO STATES A,B,C,D. F1B60980
REM F1B60990
REM *************************************************************F1B61000
REM F1B61010
EJECT F1B61020
REM TABLE BUFFER RESERVATIONS. F1B61030
REM F1B61040
REM *************************************************************F1B61050
REM F1B61060
REM ERASABLE/1-PASS1 SPECIFICATION TABLE BUFFERS= F1B61070
REM ERASABLE USED ONLY BY PASS 1. F1B61080
REM F1B61090
ORG TABORG-BFSZ TEMPORARY FORMAT BUFFER. F1B61100
BSS 0 EXTENDS UP TO TABORG. F1B61110
REM F1B61120
REM F1B61130
REM F1B61140
REM ERASABLE/ PASS 1 AND PASS 2 COMMON TABLE BUFFERS. F1B61150
REM F1B61160
REM F1B61170
ORG TABORG ORIGIN FOR TABLE BUFFERS. F1B61180
SIGMA1 BSS SGMASZ SIGMA TABLE. F1B61190
FLCNBF BSS FLCNSZ FLOCON TABLE. F1B61200
DIM1BF BSS DIM1SZ*2 DIM1 TABLE. F1B61210
DIM2BF BSS DIM2SZ*2 DIM2 TABLE. F1B61220
DIM3BF BSS DIM3SZ*3 DIM3 TABLE. F1B61230
DLT1BF BSS DLT1SZ*2 DLST1 TABLE. F1B61240
DLT2BF BSS DLT2SZ DLST2 TABLE. F1B61250
FMTNBF BSS FMTNSZ FMTEFN BUFFER. F1B61260
ENDIBF BSS ENDISZ END TABLE. F1B61270
TRADBF BSS TRADSZ TRAD BUFFER. F1B61280
CALLBF BSS CALLSZ CALLFN BUFFER. F1B61290
FRVLBF BSS FRVLSZ*2 FORVAL BUFFER F1B61300
FRVRBF BSS FRVRSZ*2 FORVAR BUFFER. F1B61310
FRTGBF BSS FRTGSZ FORTAG BUFFER. F1B61320
EQITBF BSS EQITSZ*2 EQUIT BUFFER. F1B61330
FRMTBF BSS FRMTSZ FORMAT STATEMENT BUFFER. F1B61340
SBDFBF BSS SBDFSZ SUBDEF BUFFER. F1B61350
STOPBF BSS STOPSZ TSTOPS BUFFER. F1B61360
NONXBF BSS NONXSZ NONEXC BUFFER. F1B61370
BSS 1 RESERVATION FOR FRET WORD COUNT. F1B61380
TIFGBF BSS TIFGSZ*2 TIFGO BUFFER. F1B61390
CLSBBF BSS CLSBSZ CLOSUB BUFFER. F1B61400
TEIFBF BSS TEIFSZ TEIFNO BUFFER. F1B61410
DOLPBF BSS DOLPSZ*5 TDO BUFFER. F1B61420
CMMNBF BSS CMMNSZ COMMON BUFFER. F1B61430
HLRGBF BSS HLRGSZ HOLARG BUFFER. F1B61440
FRETBF BSS FRETSZ FRET BUFFER. F1B61450
OTHRBF BSS OTHRSZ VARIABLE FOR ADJUSTING BUFFER POSITIONS. F1B61460
TAU1BF BSS TAU1SZ*2 TAU1 TABLE. F1B61470
TAU2BF BSS TAU2SZ*4 TAU2 TABLE. F1B61480
TAU3BF BSS TAU3SZ*6 TAU3 TABLE. F1B61490
FXCNWC BSS 1 WORD COUNT OF FIXCON TABLE. F1B61500
FXCNBF BSS FXCNSZ FIXCON TABLE. F1B61510
ELSEBF BSS ELSESZ VARIABLE FOR ADJUSTING BUFFER POSITIONS. F1B61520
FRSBBF BSS FRSBSZ*2 FORSUB BUFFER. F1B61530
BSS 1 F1B61540
REM F1B61550
REM F1B61560
GERASE SYN * F1B61570
REM F1B61580
REM *************************************************************F1B61590
REM F1B61600
REM SECTION I INTERNAL TABLES, BUFFERS AND ERASABLE. F1B61610
REM F1B61620
REM *************************************************************F1B61630
REM F1B61640
REM F1B61650
ORG GERASE F1B61660
REM GENERAL ERASABLE AS USED BY STATE A. F1B61670
OP BSS 1 F1B61680
SA BSS 1 F1B61690
RA BSS 1 F1B61700
BIN BSS 1 F1B61710
SYM BSS 1 F1B61720
CHR BES 6 F1B61730
BSS 250 F1B61740
DOLEV BSS 1 F1B61750
TLDOS BSS 1000 DO TABLE USED BY IOT. F1B61760
TLINE BSS 1 F1B61770
SYN * END OF STATE A ERASABLE. F1B61780
REM F1B61790
REM *************************************************************F1B61800
REM F1B61810
REM GENERAL ERASABLE AS USED BY STATE B. F1B61820
REM F1B61830
ORG GERASE F1B61840
LAMBDA BSS LAMBSZ LAMBDA TABLE. F1B61850
CBAR BSS 1 F1B61860
ABAR BSS 1 F1B61870
FSTYPE BSS 1 F1B61880
FSBITS BSS 1 F1B61890
FNBITS BSS 1 F1B61900
CHSAVE BSS 1 WORKING STORAGE USED BY ROYCNV. F1B61910
DOE BSS 1 F1B61920
EKE BSS 1 F1B61930
H BSS 1 F1B61940
N BSS 1 F1B61950
ARGREG BSS RGRGSZ ARGREG TABLE. F1B61960
ALPHA BSS ALPHSZ ALPHA TABLE. F1B61970
SYN * END OF STATE B ERASABLE. F1B61980
REM F1B61990
REM *************************************************************F1B62000
REM F1B62010
REM GENERAL ERASABLE AS USED BY STATE C. F1B62020
REM F1B62030
ORG GERASE+LAMBSZ-SCRPSZ F1B62040
SCRIPL BSS SCRPSZ OPTIMIZED LAMBDA TABLE. F1B62050
BETA BSS BETASZ BETA TABLE. F1B62060
CPBETA SYN BETA F1B62070
SYN * END OF STATE C ERASABLE. F1B62080
REM F1B62090
REM *************************************************************F1B62100
REM F1B62110
REM GENERAL ERASABLE AS USED BY STATE D. F1B62120
REM F1B62130
ORG SCRIPL-20 F1B62140
FNSW BSS 1 F1B62150
P(CNTR BSS 1 F1B62160
ARGORG BSS 1 F1B62170
XRSAVE BSS 1 F1B62180
CW BSS 4 F1B62190
TAGWRD BSS 1 F1B62200
OPWORD BSS 1 F1B62210
SYMWRD BSS 1 F1B62220
TAGPRT BSS 1 F1B62230
XCAIND BSS 1 F1B62240
SYN * END OF STATE D ERASABLE. F1B62250
REM F1B62260
REM F1B62270
FORSUB SYN FRSBBF FORSUB TABLE ORIGIN CAN ONLY BE DEFINED F1B62280
REM AT TIME OF ASSEMBLY. F1B62290
REM F1B62300
REM F1B62310
REM OTHER TABLES WHICH CAN ONLY BE DEFINED AT ASSEMBLY F1B62320
REM TIME ARE ....... ALHPA, BETA, LAMBDA, SCRIPL, AND ANY F1B62330
REM OTHERS NOT DEFINED BY / OR HANDLED F1B62340
REM BY A GENERALIZED ROUTINE. F1B62350
REM F1B62360
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B62370
REM F1B62380
REM END OF SECTION ONE. F1B62390
REM F1B62400
REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B62410
TCD -1 $F1B62420
TTL * SECTION ONE * DIAGNOSTIC * RECORD 9F15 * F1C00000
REM SECTION ONE DIAGNOSTIC ROUTINE. F1C00010
REM F1C00020
REM F1C00030
LBL 9F15,THE WORKS F1C00050
REM F1C00060
ORG SYSCUR $F1C00070
BCI 1,9F1500 $F1C00080
ORG (LODR) $F1C00090
TXI DIAG00,,150 ENTRY POINT,,RECORD NUMBER F1C00100
REM F1C00110
REM F1C00120
REM THIS RECORD IS CALLED IN FROM TAPE ONCE FOR EACH ERROR IN F1C00130
REM SECTION ONE AND ONCE AT THE END OF SECTION ONE. F1C00140
REM F1C00150
ABS F1C00160
ORG GERASE DIAGNOSTIC OCCUPIES GENERAL ERASABLE. F1C00170
REM F1C00180
DIAG00 LDC ONLINE,4 F1C00190
TXH DIAG06,4,0 F1C00200
REM F1C00210
REM TERMINAL ROUTINE FOR DIAGNOSTIC. F1C00220
REM ALSO END OF SECTION ONE WHEN THERE HAS BEEN A SOURCE F1C00230
REM PROGRAM ERROR. F1C00240
AXT 3,1 WRITE END OF DIAGNOSTIC COMMENT, F1C00250
TSX (TAPE),4 AN END-OF-FILE, F1C00260
PZE DIAGA,1,-1 AND REWIND SCRATCH TAPE. F1C00270
PZE DLBL,,BUFTAP F1C00280
TIX *-3,1,1 F1C00290
TSX (TAPE),4 POSITION INPUT TAPE TO END OF F1C00300
PZE BSPCF,,(SKBP) SOURCE PROGRAM. F1C00310
PZE ,,INPUTP F1C00320
LDI* (FGBX) LOAD MONITOR FLAGS. F1C00330
LNT 400000 IS THIS MONITOR MODE. F1C00340
TRA *+3 NO, SINGLE COMPILE. F1C00350
CAL* (LNCT) YES, GET LINE COUNT AND NUMBER OF F1C00360
LXD (PGCT),1 LINES PER PAGE. F1C00370
DIAG01 TSX (TAPE),4 READ A RECORD FROM THE SCRATCH TAPE. F1C00380
PZE RDIAG,,(RBEC) F1C00390
PZE DLBL,,BUFTAP F1C00400
PZE DIAGER ERROR RETURN. F1C00410
LXA (SCHU)+BUFTAP,4 GET RESULT OF SCHX. F1C00420
TXL DIAG05,4,0 *EOF READ, MESSAGES TRANSFERRED. F1C00430
TXI *+1,4,-DIGBUF COMPUTE WORD COUNT OF RECORD. F1C00440
SXD DIAG03,4 SET WORD COUNT IN I/O COMMAND. F1C00450
SXD DIAGN3,4 $F1C00455
DIAG02 NZT ONLINE SHOULD MESSAGE BE PRINTED ON-LINE. F1C00460
TRA *+3 *NO, JUST WRITE ON OUTPUT TAPE. F1C00470
TSX (PRNT),4 YES, PRINT ON-LINE. F1C00480
DIAG03 PZE DIGBUF,,** F1C00490
LNT 400000 IS THIS MONITOR MODE. F1C00500
TRA DIAG04 *NO, WRITE ON INPUT TAPE. F1C00510
REM F1C00520
NZT *+2 IS THIS FIRST LINE OF OUTPUT. F1C00530
TRA *+8 NO, DO NOT MODIFY. F1C00540
STZ * YES, RESET SWITCH. F1C00550
LDQ DIGBUF DELETE PROGRAM CONTROL CHARACTER. F1C00560
LGL 6 F1C00570
CAL BLANK REPLACE WITH BLANK. F1C00580
LGR 6 F1C00590
STQ DIGBUF REPLACE FIRST WORD. F1C00600
CAL* (LNCT) RESTORE LINE COUNT. F1C00610
TSX (TAPE),4 YES, WRITE MESSAGES ON MONITOR OUTPUT F1C00620
PZE DIAGN3,,(WDNC) TAPE. $F1C00630
PZE ,,MLSTAP F1C00640
ADD L(1) INCREMENT LINES OUTPUT THIS JOB. F1C00650
TIX DIAG01,1,1 IS THE PAGE FULL. F1C00660
LXD (PGCT),1 YES, RELOAD NUMBER OF LINES PER PAGE. F1C00670
TSX (TAPE),4 WRITE PAGE EJECT WORD. F1C00680
PZE EJECT,,(WDNP) F1C00690
PZE ,,MLSTAP F1C00700
TRA DIAG01 GET NEXT LINE. F1C00710
REM F1C00720
DIAG04 LDQ DIGBUF REPLACE FIRST CHARACTER WITH BLANK F1C00730
LGL 6 BEFORE WRITING LINE ON INPUT TAPE. F1C00740
CAL BLANK F1C00750
LGR 6 F1C00760
STQ DIGBUF SET LINE FOR SINGLE SPACE PRINTING. F1C00770
TSX (TAPE),4 WRITE LINE ON INPUT TAPE. F1C00780
PZE DIAGN3,,(WDNC) $F1C00790
PZE ,,INPUTP F1C00800
PZE DIAGER ERROR RETURN. F1C00810
TRA DIAG01 GET NEXT LINE. F1C00820
REM F1C00830
REM ENTRY TO TERMINATE DIAGNOSTIC ON MACHINE ERROR. F1C00840
REM F1C00850
DIAGER TSX (PRNT),4 PRINT APPROPRIATE COMMENT ABOUT F1C00860
IOCT GOOFUP,,11 MACHINE ERROR. $F1C00870
AXT INPUTP,4 PRESUME SINGLE COMPILE OUTPUT. F1C00880
LFT 400000 IS THIS MONITOR MODE. F1C00890
AXT MLSTAP,4 YES, LOAD MONITOR OUTPUT TAPE ADDRESS. F1C00900
SXD *+3,4 SET TAPE ADDRESS. F1C00910
TSX (TAPE),4 WRITE COMMENT ON OUTPUT TAPE. F1C00920
PZE GFUPMS,,(WDNP) $F1C00930
PZE ,,** F1C00940
ADD L(1) INCREMENT LINE COUNT. F1C00950
REM F1C00960
DIAG05 LFT 400000 IS THIS MONITOR MODE. F1C00970
STA* (LNCT) YES, SAVE COUNT OF LINES OUTPUT. F1C00980
LFT 400000 IS THIS MONITOR MODE. F1C00990
TRA *+4 YES, NO NEED TO WRITE AN EOF F1C01000
TSX (TAPE),4 AFTER DIAGNOSTIC MESSAGES ON F1C01010
PZE ,,(WEFP) INPUT TAPE. F1C01020
PZE ,,INPUTP F1C01030
TSX (TAPE),4 REWIND INPUT TAPE. F1C01040
PZE REWD,,(SKDP) F1C01050
PZE ,,INPUTP F1C01060
TRA (SECL) GO TO SOURCE PROGRAM ERROR RECORD. F1C01070
REM F1C01080
DIAG06 PXA ,4 SAVE LOCATION OF CALL TO DIAGNOSTIC. F1C01090
STO OCTNUM F1C01100
LGR 15 CONVERT TO BCD FORM FOR PRINTING. F1C01110
AXT 5,1 LOAD LOOP COUNT. F1C01120
CAL BLANK LEAD OFF WITH A BLANK. F1C01130
ALS 3 F1C01140
LGL 3 F1C01150
TIX *-2,1,1 F1C01160
SLW XCOM BE A PESSIMIST, SAVE IN NOT LISTED MESSAGEF1C01170
ZET DGFLAG IS THIS FIRST CALL TO DIAGNOSTIC. F1C01180
TRA DIAG07 *NO, SKIP HEADING. F1C01190
REM F1C01200
REM F1C01210
SXA DGFLAG,4 RESET FIRST CALL FLAG. F1C01220
STZ DGX1 SET TAPE POSITIONING FLAG. F1C01230
TSX (TAPE),4 REWIND SCRATCH TAPE. F1C01231
PZE REWD,,(SKBP) F1C01232
PZE DLBL,,BUFTAP F1C01233
AXT 3,1 LOAD PARAMETER MODIFIER. F1C01240
TSX (TAPE),4 WRITE PAGE EJECT, F1C01250
PZE DIAGHD,1,(WBNP) BLANKS, F1C01260
PZE DLBL,,BUFTAP AND DIAGNOSTIC HEADING. F1C01270
TIX *-3,1,1 F1C01280
REM F1C01290
REM WRITE OUT THE STATEMENT IN ERROR FROM CURRENT F-REGION. F1C01300
REM F1C01310
DIAG07 LXD DCF,1 LOAD 2S COMPLEMENT OF F-REGION ORIGIN. F1C01320
CLA FIRST5 MOVE FIRST FIVE CHARACTERS OF STATEMENT F1C01330
STO -2,1 (MODE INDICATOR AND EFN - IF ANY). F1C01340
CAL BLANKS GET A WORD OF BLANKS AND SET FIRST F1C01350
STP -2,1 CHARACTER OF STATEMENT TO A BLANK. F1C01360
CLA BLANKS SEPARATE FROM REST OF STATEMENT WITH A F1C01370
STO -1,1 WORD OF BLANKS TO MAKE IT LOOK PRETTY. F1C01380
SXD DIAG08,1 SET -ORIGIN FOR WORD COUNT COMPUTATION. F1C01390
CAL ALL1 SEARCH FOR END MARKER. F1C01400
LAS 0,1 LOOK FOR WORD OF ALL BINARY ONES. F1C01410
TXI *-1,1,-1 NOT END OF STATEMENT, CONTINUE SEARCH. F1C01420
TXI *+2,1,-2 END OF STATEMENT FOUND. F1C01430
TXI *-3,1,-1 SAME AS *-2. F1C01440
PXD ,1 GET TRUE ADDRESS OF END OF STATEMENT F1C01450
PDC ,1 (INCLUDES COUNT OF 2 ADDITIONAL WORDS). F1C01460
DIAG08 TXI *+1,1,** COMPUTE WORD COUNT OF STATEMENT PLUS F1C01470
SXD STATE,1 FIRST FIVE PLUS WORD OF BLANKS. F1C01480
LDC DCF,4 GET TRUE ORIGIN OF F-REGION. F1C01490
TXI *+1,4,-2 REDUCE TO INCLUDE FIRST 5 CHARACTERS AND F1C01500
SXA STATE,4 WORD OF BLANKS. SET PARAMETER. F1C01510
TSX (TAPE),4 WRITE A LINE OF BLANKS F1C01520
PZE LOOKS,,(WBNP) FOR APPEARANCE. F1C01530
PZE DLBL,,BUFTAP F1C01540
REM F1C01550
REM F1C01560
REM THERE ARE TWO FORTRAN LANGUAGE STATEMENTS.. F1C01570
REM F1C01580
REM IF(...) N1, N2, N3 AND CALL NAME(ARG1,...,ARGN) F1C01590
REM F1C01600
REM WHICH ARE MODIFIED BY SECTION ONE INTO QUASI-ARITHMETIC F1C01610
REM STATEMENTS IN ORDER TO PROCESS BY THE ARITHMETIC TRANSLATOR. F1C01620
REM IT IS NOW NECESSARY TO SCAN THE PRESENT STATEMENT FOR EITHER F1C01630
REM OF THESE AND IF SO CONVERT IT BACK TO ITS ORIGINAL FORM. F1C01640
REM F1C01650
TSX C0190X,4 SET SCAN TO FIRST CHARACTER. F1C01660
TSX C0190,4 MOVE SCAN TO SECOND CHARACTER. F1C01670
CAL LEFT+2 TEST FOR IF OR CALL STATEMENT. F1C01680
LGR 24 F1C01690
CAS CALLER IS THIS A CALL STATEMENT. F1C01700
TRA DIAG11 F1C01710
TRA DIAG14 YES, GO TO RECONVERT TO ORIGINAL FORM. F1C01720
DIAG11 SUB IFSYM IS THIS AN IF STATEMENT. F1C01730
TNZ DIAG16 NEITHER, GO PRINT AS IS. F1C01740
LDQ L(I) F1C01750
TSX C0390,4 RESTORE I. F1C01760
LDQ L(F) F1C01770
TSX C0390,4 RESTORE F. F1C01780
SUB EQUAL TEST THIRD CHAR FOR EQUAL. F1C01790
TNZ DIAG16 NOT EQUAL, STATEMENT GARBLED, PRINT AS IS. F1C01800
LDQ OPEN F1C01810
TSX C0390,4 RESTORE ( F1C01820
TRA DIAG13 F1C01830
DIAG12 TSX C0190,4 SEARCH FOR ENDMK CHARACTER AND IF FOUND F1C01840
DIAG13 SUB ENDMK RESTORE TO ) IF NOT FOUND PRINT AS IS. F1C01850
TNZ DIAG12 F1C01860
LDQ CLOS F1C01870
TRA DIAG15 F1C01880
REM F1C01890
DIAG14 LDQ L(C) F1C01900
TSX C0390,4 RESTORE C. F1C01910
LDQ L(A) F1C01920
TSX C0390,4 RESTORE A. F1C01930
LDQ L(L) F1C01940
TSX C0390,4 RESTORE FIRST L. F1C01950
LDQ L(L) F1C01960
DIAG15 TSX C0390,4 RESTORE SECOND L. F1C01970
REM F1C01980
REM F1C01990
DIAG16 TSX WRDG0,4 WRITE STATEMENT ON SCRATCH TAPE. F1C02000
STATE PZE **,,** F1C02010
REM F1C02020
AXT ENDIAG-TABLE,1 SET LOOP SAFETY COUNT. F1C02030
AXC TABLE,2 GET TABLE BEGINNING ADDRESS IN IR2. F1C02040
DIAG17 CLA 1BAR F1C02050
CAS 0,2 TEST FOR END OF TABLE OF MESSAGES. F1C02060
TRA DIAG18 F1C02070
TRA DIAG24 YES, EXIT AND PRINT UNLISTED ERROR MESSAGE.F1C02080
DIAG18 ADD OCTNUM FORM LABEL OF MESSAGE BEING SEARCHED FOR. F1C02090
CAS 0,2 F1C02100
TXI DIAG19,2,-1 NO F1C02110
TXI DIAG20,1,-1 FOUND, EXIT. F1C02120
TXI DIAG19,2,-1 NO F1C02130
DIAG19 TIX DIAG17,1,1 CONTINUE SEARCH IF ANY TABLE REMAINS. F1C02140
TRA DIAG24 TABLE EXHAUSTED, NO END SIGNAL, EXIT. F1C02150
DIAG20 TXI *+1,2,1 GET ADDRESS OF MESSAGE MINUS 2 WORDS. F1C02160
SXD DIAG23,2 SET FOR WORD COUNT COMPUTATION. F1C02170
LDC DIAG23,4 GET TRUE ADDRESS. F1C02180
SXA COMM,4 SET IN I/O COMMAND. F1C02190
CLA XCOM GET LOCATION OF CALL. F1C02200
STO 0,2 INSERT AHEAD OF MESSAGE AND SEPARATE F1C02210
CLA BLANKS FROM MESSAGE WITH BLANKS. F1C02220
STO 1,2 F1C02230
TXI *+2,2,-2 RESET INDEX AND SEARCH FOR END OF MESSAGE.F1C02240
DIAG21 TXI *+1,2,-1 SEARCH FOR END OF MESSAGE. F1C02250
CAL 0,2 GET NEXT WORD OF MESSAGE AREA. F1C02260
ANA 1BAR GET DECREMENT FIELD. F1C02270
ERA 1BAR IS THIS AN END MARK. F1C02280
TZE *+2 *YES. F1C02290
TIX DIAG21,1,1 NO, CONTINUE SEARCH OR QUIT. F1C02300
PXD ,2 GET TRUE ADDRESS OF END OF MESSAGE. F1C02310
PDC ,2 F1C02320
DIAG23 TXI *+1,2,** SUBTRACT THE FIRST ADDRESS. F1C02330
SXD COMM,2 SET WORD COUNT OF PARAMETER. F1C02340
DIAG24 TSX WRDG0,4 WRITE MESSAGE ON SCRATCH TAPE. F1C02350
COMM PZE XCOM,,XXCOM-XCOM PRESET TO NOT LISTED MESSAGE. F1C02360
TSX (TAPE),4 REPOSITION SYSTEM TAPE IN FRONT OF F1C02370
PZE BKSP,,(SKBP) DIAGNOSTIC. F1C02380
PZE ,,SYSTAP F1C02390
ZAC SET ERROR FLAG FOR F1C02400
SSM INPUT ROUTINE. F1C02410
STO TLABEL F1C02420
TRA PASS1 RETURN TO PASS 1 OR PASS 2. F1C02430
REM F1C02440
WRDG0 SXA WRDG3,1 SAVE INDEX REGISTERS. F1C02450
SXA WRDG3+1,2 F1C02460
SXA WRDG3+2,4 F1C02470
CLA 1,4 GET I/O COMMAND (PARAMETERS). F1C02480
PDX ,1 LOAD WORD COUNT. F1C02490
TXL WRDG3,1,0 IS WORD COUNT ZERO. F1C02500
TSX (TAPE),4 NO, WRITE A LINE OF BLANKS F1C02510
PZE LOOKS,,(WBNP) FOR APPEARANCE. F1C02520
PZE DLBL,,BUFTAP F1C02530
PAX ,2 LOAD FIRST ADDRESS. F1C02540
SXA WRDG4,2 SET FIRST ADDRESS IN I/O COMMAND. F1C02550
WRDG1 TXL WRDG2,1,20 IS IT GREATER THAN A FULL LINE. F1C02560
TSX (TAPE),4 YES, WRITE IT OUT IN 20 WORD SEGMENTS. F1C02570
PZE WRDG4,,(WBNC) F1C02580
PZE DLBL,,BUFTAP F1C02590
TXI *+1,1,-18 REDUCE WORD COUNT, ALLOW FOR INSERTING F1C02600
TXI *+1,2,18 BLANKS, AND UPDATE ADDRESS. F1C02610
SXA WRDG4,2 SET NEW ADDRESS IN I/O COMMAND. F1C02620
CAL BLANKS INSERT TWO WORDS OF BLANKS AHEAD OF F1C02630
SLW* WRDG4 THIS SEGMENT. F1C02640
TXI *+1,2,1 ADD 1 TO NEW FIRST ADDRESS FOR INSERTING F1C02650
SXA *+1,2 SECOND WORD OF BLANKS. F1C02660
SLW ** F1C02670
TXI WRDG1,2,-1 RESET FIRST ADDRESS, TEST FOR FULL LINE. F1C02680
REM F1C02690
WRDG2 SXA WRDG5,2 SET FIRST ADDRESS OF I/O COMMAND AND F1C02700
SXD WRDG5,1 WORD COUNT FOR FULL OR PARTIAL LINE. F1C02710
TSX (TAPE),4 WRITE REMAINDER ON SCRATCH TAPE. F1C02720
PZE WRDG5,,(WBNC) F1C02730
PZE DLBL,,BUFTAP F1C02740
WRDG3 AXT **,1 RELOAD INDEX REGISTERS. F1C02750
AXT **,2 F1C02760
AXT **,4 F1C02770
TRA 2,4 RETURN TO CALLER. F1C02780
REM F1C02790
WRDG4 IORT **,,20 I/O COMMAND TO WRITE FULL LINE. F1C02800
WRDG5 IORT **,,** I/O COMMAND TO WRITE PARTIAL LINE. F1C02810
REM F1C02820
EJECT IORT UPPAGE,,3 I/O COMMAND TO WRITE PAGE EJECT. F1C02830
LOOKS IORT START,,3 I/O COMMAND TO WRITE A BLANK LINE. F1C02840
IORT START,,STOP-START I/O COMMAND TO WRITE DIAGNOSTIC TITLE. F1C02850
DIAGHD SYN * F1C02860
REM F1C02870
IOCT STOPM,,(WBNP) PARAMETER FOR WRITING END OF DIAGNOSTIC. $F1C02880
PZE ,,(WEFP) PARAMETER FOR WRITING END OF FILE. F1C02890
PZE REWD,,(SKDP) PARAMETER FOR REWINDING SCRATCH TAPE. F1C02900
DIAGA SYN * F1C02910
STOPM IORT STOP,,XCOM-STOP I/O COMMAND FOR WRITING END DIAGNOSTIC. F1C02920
REM F1C02930
BSPCF MZE ,,1 I/O COMMAND TO BACKSPACE ONE FILE. F1C02940
RDIAG IORT DIGBUF,,21 I/O COMMAND TO READ A RECORD (LINE) F1C02950
REM FROM THE SCRATCH TAPE. F1C02960
REM F1C02970
OCTNUM PZE ** LOCATION OF CALLER (TSX) TO DIAGNOSTIC. F1C02980
DLBL BCI 1,ERRCOM DIAGNOSTIC MESSAGE LABEL. F1C02981
REM F1C02982
UPPAGE BCI 1,1 F1C02990
START BCI 7, F1C03000
BCI 8,709/7090 FORTRAN DIAGNOSTIC PROGRAM RESULTS F1C03010
STOP BCI 7, F1C03020
BCI 6,END OF DIAGNOSTIC PROGRAM RESULTS. F1C03030
REM F1C03040
XCOM BCI 2, F1C03050
BCI 9,THIS ERROR IS NOT LISTED IN THE DIAGNOSTIC PROGRAM ERR F1C03060
BCI 2,OR LIST. F1C03070
XXCOM SYN * F1C03080
REM F1C03090
GOOFUP BCI 9,0 DIAGNOSTIC PROGRAM RESULTS DISCONTINUED DUE TO A MAC F1C03100
BCI 2,HINE ERROR. F1C03110
REM F1C03120
DIGBUF BSS 21 INPUT BUFFER FROM SCRATCH TAPE. F1C03130
REM F1C03140
DIAGN3 IOCT DIGBUF,,** $F1C03141
GFUPMS IOCT GOOFUP,,11 $F1C03142
SYN * BEGINNING OF DIAGNOSTIC PATCH AREA. F1C03150
BSS 50 PATCH AREA. F1C03160
SYN * END OF DIAGNOSTIC PATCH AREA. F1C03170
REM F1C03180
REM F1C03190
REM TABLE OF DIAGNOSTIC COMMENTS, SECTION ONE OF 709 FORTRAN II. F1C03200
REM F1C03210
TABLE BSS 0 F1C03220
REM F1C03230
PZE 1,,-1 F1C03240
BCD 4DIM3 TABLE EXCEEDED. F1C03250
REM F1C03260
PZE 2,,-1 F1C03270
BCD 4DIM2 TABLE EXCEEDED. F1C03280
REM F1C03290
PZE 3,,-1 F1C03300
BCD 4DIM1 TABLE EXCEEDED. F1C03310
REM F1C03320
PZE 6,,-1 F1C03330
BCD 4SIGMA TABLE EXCEEDED. F1C03340
REM F1C03350
PZE 7,,-1 F1C03360
BCD 4TAU3 TABLE EXCEEDED. F1C03370
REM F1C03380
PZE 8,,-1 F1C03390
BCD 4TAU2 TABLE EXCEEDED. F1C03400
REM F1C03410
PZE 9,,-1 F1C03420
BCD 4TAU1 TABLE EXCEEDED. F1C03430
REM F1C03440
PZE 10,,-1 F1C03450
BCD 4FLOCON TABLE EXCEEDED. F1C03460
REM F1C03470
PZE 11,,-1 F1C03480
BCD 4FIXCON TABLE EXCEEDED. F1C03490
REM F1C03500
PZE ER0001,,-1 F1C03510
BCD 7MORE THAN SIX CHARACTERS IN SOME SYMBOL. F1C03520
REM F1C03530
PZE ER0002,,-1 F1C03540
BCD 5ILLEGAL USE OF PUNCTUATION. F1C03550
REM F1C03560
PZE ER0004,,-1 F1C03570
BCD NON-NUMERIC CHARACTER IN NUMERIC FIELD OR MISSING PUNCTUATIOF1C03580
BCD 1N. F1C03590
REM F1C03600
PZE ER0005,,-1 F1C03610
BCD 7A SUBSCRIPT IS NOT A FIXED POINT VARIABLE. F1C03620
REM F1C03630
PZE ER0006,,-1 F1C03640
BCD 6A SUBSCRIPT HAS A DOUBLE MULTIPLIER. F1C03650
REM F1C03660
PZE ER0007,,-1 F1C03670
BCD 7A SUBSCRIPT MULTIPLIER IS NOT A CONSTANT. F1C03680
REM F1C03690
PZE ER0008,,-1 F1C03700
BCD MORE THAN SIX CHARACTERS IN A SYMBOL WITHIN A SUBSCRIPT OR MF1C03710
BCD 4ISSING PUNCTUATION. F1C03720
REM F1C03730
PZE ER0009,,-1 F1C03740
BCD 8THERE IS AN ILLEGAL CHARACTER IN SOME SUBSCRIPT. F1C03750
REM F1C03760
PZE ER0010,,-1 F1C03770
BCD 6A SUBSCRIPT HAS A DOUBLE ADDEND. F1C03780
REM F1C03790
PZE ER0011,,-1 F1C03800
BCD 7A SUBSCRIPT ADDEND IS NOT A CONSTANT. F1C03810
REM F1C03820
PZE ER0012,,-1 F1C03830
BCD 9PARENTHESIS MISSING IN SOME SUBSCRIPT COMBINATION. F1C03840
REM F1C03850
PZE ER0013,,-1 F1C03860
BCD A 3 DIMENSIONAL SUBSCRIPTED VARIABLE DOES NOT HAVE A DIMENSIF1C03870
BCD 4ON STATEMENT ENTRY. F1C03880
REM F1C03890
PZE ER0014,,-1 F1C03900
BCD A 2 DIMENSIONAL SUBSCRIPTED VARIABLE DOES NOT HAVE A DIMENSIF1C03910
BCD 4ON STATEMENT ENTRY. F1C03920
REM F1C03930
PZE ER0015,,-1 F1C03940
BCD 7PROGRAM EXPECTS COMMA OR END OF STATEMENT. F1C03950
REM F1C03960
PZE ER0016,,-1 F1C03970
BCD 8PROGRAM EXPECTS COMMA OR RIGHT PARENTHESIS. F1C03980
REM F1C03990
PZE ER0017,,-1 F1C04000
BCD 9PROGRAM EXPECTS LEFT PARENTHESIS OR END OF STATEMENT. F1C04010
REM F1C04020
PZE ER0019,,-1 F1C04030
BCD 6PROGRAM EXPECTS END OF STATEMENT. F1C04040
REM F1C04050
PZE ER0020,,-1 F1C04060
BCD 6PROGRAM EXPECTS LEFT PARENTHESIS. F1C04070
REM F1C04080
PZE ER0021,,-1 F1C04090
BCD 6PROGRAM EXPECTS RIGHT PARENTHESIS. F1C04100
REM F1C04110
PZE ER0022,,-1 F1C04120
BCD 4PROGRAM EXPECTS COMMA. F1C04130
REM F1C04140
PZE ER0023,,-1 F1C04150
BCD SYMBOL BEGINS NUMERIC WHICH IS ILLEGAL IN THIS CONTEXT. F1C04160
REM F1C04170
PZE ER0024,,-1 F1C04180
BCD SYMBOL BEGINS NON-NUMERIC WHICH IS ILLEGAL IN THIS CONTEXT. F1C04190
REM F1C04200
PZE ER0026,,-1 F1C04210
BCD THE CHARACTER $ OCCURS SOMEWHERE OTHER THAN IN HOLLERITH TEXF1C04220
BCD 1T. F1C04230
REM F1C04240
PZE ER0027,,-1 F1C04250
BCD 7ILLEGAL CHARACTER +0 (12-8-2 PUNCH). F1C04260
REM F1C04270
PZE ER0028,,-1 F1C04280
BCD 7ILLEGAL CHARACTER -0 (11-8-2 PUNCH). F1C04290
REM F1C04300
PZE ER0029,,-1 F1C04310
BCD 6ILLEGAL CHARACTER (0-8-2 PUNCH). F1C04320
REM F1C04330
PZE ER0030,,-1 F1C04340
BCI 6,ILLEGAL CHARACTER ' (8-4 PUNCH). F1C04350
REM F1C04360
PZE ER0032,,-1 F1C04370
BCD 5TOO MANY RIGHT PARENTHESIS. F1C04380
REM F1C04390
PZE ER0033,,-1 F1C04400
BCD NON-ARITHMETIC STATEMENT OF A TYPE WHICH IS NOT IN DICTIONARF1C04410
BCD 1Y. F1C04420
REM F1C04430
PZE ER0034,,-1 F1C04440
BCD 5TOO FEW RIGHT PARENTHESIS. F1C04450
REM F1C04460
PZE ER0035,,-1 F1C04470
BCD 4PROGRAM EXPECTS WORD TO. F1C04480
REM F1C04490
PZE ER0036,,-1 F1C04500
BCD A VARIABLE IN THIS LIST APPEARED PREVIOUSLY IN A DIMENSION SF1C04510
BCD 2TATEMENT. F1C04520
REM F1C04530
PZE ER0037,,-1 F1C04540
BCD 9MORE THAN 3 DIMENSIONS OR MISSING RIGHT PARENTHESIS. F1C04550
REM F1C04560
PZE ER0038,,-1 F1C04570
BCD A SUBROUTINE OR FUNCTION STATEMENT APPEARS LATER THAN THE FIF1C04580
BCD 5RST STATEMENT OF THE PROGRAM. F1C04590
REM F1C04600
PZE ER0039,,-1 F1C04610
BCD A RETURN STATEMENT HAS OCCURED IN A PROGRAM NOT DEFINED TO F1C04620
BCD 7BE A SUBROUTINE OR FUNCTION SUBPROGRAM. F1C04630
REM F1C04640
PZE ER0040,,-1 F1C04650
BCD 7SENSE SWITCH SETTING OTHER THAN 0, 1 OR 2. F1C04660
REM F1C04670
PZE ER0041,,-1 F1C04680
BCD 7MORE THAN SIX CHARACTERS IN SOME SYMBOL. F1C04690
REM F1C04700
PZE ER0042,,-1 F1C04710
BCD 6ILLEGAL CHARACTER IN THIS LIST. F1C04720
REM F1C04730
PZE ER0043,,-1 F1C04740
BCD 7ILLEGAL USE OF CONSTANT IN LIST. F1C04750
REM F1C04760
PZE ER0044,,-1 F1C04770
BCD MORE THAN THREE LEVELS IN THIS LIST (NESTED PARENTHESIS). F1C04780
REM F1C04790
PZE ER0045,,-1 F1C04800
BCD ATTEMPT TO SPECIFY A SUBSCRIPT RANGE WITHOUT USE OF PARENTHEF1C04810
BCD 1SIS. F1C04820
REM F1C04830
PZE ER0046,,-1 F1C04840
BCD 6MISSING ) IN CONTROL FOR LIST DO. F1C04850
REM F1C04860
PZE ER0047,,-1 F1C04870
BCD 6ILLEGAL CONTROL CHAR IN LIST DO. F1C04880
REM F1C04890
PZE ER0048,,-1 F1C04900
BCD 5TOO MANY ) IN LIST CONTROL. F1C04910
REM F1C04920
PZE ER0049,,-1 F1C04930
BCD 7ILLEGAL USE OF CONSTANT IN LIST. F1C04940
REM F1C04950
PZE ER0050,,-1 F1C04960
BCD 5TOO MANY ( IN LIST CONTROL. F1C04970
REM F1C04980
PZE ER0051,,-1 F1C04990
BCD 6ILLEGAL CHARACTER IN THIS STATEMENT. F1C05000
REM F1C05010
PZE ER0053,,-1 F1C05020
BCD 7NO DIMENSION ENTRY FOR VARIABLE FORMAT. F1C05030
REM F1C05040
PZE ER0054,,-1 F1C05050
BCD 3NO FORMAT NUMBER. F1C05060
REM F1C05070
PZE ER0055,,-1 F1C05080
BCD 7ILLEGAL USE OF FLOATING POINT VARIABLE. F1C05090
REM STATE B. F1C05100
REM F1C05110
PZE ER0056,,-1 F1C05120
BCD 5TOO MANY CHARACTERS IN SYMBOL. F1C05130
REM F1C05140
PZE ER0072,,-1 F1C05150
BCD SUBSCRIPTED VARIABLE ON LEFT OF = NOT DEFINED IN DIMENSION SF1C05160
BCD 2TATEMENT. F1C05170
PZE ER0057,,-1 F1C05180
BCD 5MULTIPLE FUNCTION DEFINITION. F1C05190
REM F1C05200
PZE ER0058,,-1 F1C05210
BCD 8MORE THAN 50 FUNCTION DEFINITIONS IN PROGRAM. F1C05220
REM F1C05230
PZE ER0059,,-1 F1C05240
BCD 7ILLEGAL FORTRAN FUNCTION ARGUMENT NAME. F1C05250
REM F1C05260
PZE ER0060,,-1 F1C05270
BCD 4ARGREG SIZE EXCEEDED. F1C05280
REM F1C05290
PZE ER0061,,-1 F1C05300
BCD 9FLOATING POINT CONSTANT IN HOLLERITH SPECIFICATION. F1C05310
REM F1C05320
PZE ER0062,,-1 $F1C05330
BCD 9PARENTHESES DO NOT BALANCE WITHIN A LEVEL. $F1C05340
REM F1C05350
PZE ER0063,,-1 F1C05360
BCD 4ILLEGAL USE OF = SIGN. F1C05370
REM F1C05380
PZE ER0064,,-1 F1C05390
BCD 5ILLEGAL USE OF . CHARACTER. F1C05400
REM F1C05410
PZE ER0065,,-1 F1C05420
BCD THE NUMERIC CONTROL OF A HOLLERITH TEXT IS LARGER THAN THE NF1C05430
BCD 6UMBER OF CHARACTERS FOLLOWING THE H. F1C05440
REM F1C05450
PZE ER0066,,-1 F1C05460
BCD 5LAMDA TABLE SIZE EXCEEDED. F1C05470
REM F1C05480
PZE ER0067,,-1 F1C05490
BCD 5BETA TABLE SIZE EXCEEDED. F1C05500
REM F1C05510
PZE ER0068,,-1 F1C05520
BCD 9ALPHA TABLE SIZE EXCEEDED OR EXCESS RIGHT PARENTHESIS. F1C05530
REM F1C05540
PZE ER0069,,-1 F1C05550
BCD FLOATING POINT CONSTANT OUTSIDE FLOATING POINT RANGE OF MACHF1C05560
BCD 1INE. F1C05570
REM F1C05580
PZE ER0070,,-1 F1C05590
BCD 3MIXED EXPRESSION. F1C05600
REM F1C05610
PZE ER0071,,-1 F1C05620
BCD 6SUBSCRIPTED VARIABLE IN FUNCTION. F1C05630
REM F1C05640
REM F1C05650
PZE ER1002,,-1 F1C05660
BCD 7FORMAT STATEMENT IS INCORRECTLY WRITTEN. F1C05670
REM F1C05680
PZE ER1003,,-1 F1C05690
BCD 6NON-NUMERICS FOUND IN NUMERIC FIELD. F1C05700
REM F1C05710
PZE ER1005,,-1 F1C05720
BCD 6DECIMAL NUMBER IN AN OCTAL FIELD. F1C05730
REM F1C05740
REM F1C05750
PZE ER1007,,-1 F1C05760
BCI 7,STATEMENT HAS TOO MANY CONTINUATION CARDS. F1C05770
REM F1C05780
PZE ER1008,,-1 F1C05790
BCD 5END CARD OUT OF SEQUENCE. F1C05800
REM F1C05810
PZE BER001,,-1 F1C05820
BCD IMPROPER BOOLEAN STATEMENT. F1C05830
REM F1C05840
PZE DCER,,-1 F1C05850
BCD DOUBLE PRECISION CONSTANT LIES OUTSIDE OF RANGE 10**-38 F1C05860
BCD 2TO 10**+38 F1C05870
REM F1C05880
PZE ICM6,,-1 F1C05890
BCD 7INCORRECT FORMAT FOR COMPLEX NUMBER $F1C05900
REM F1C05910
PZE ICER,,-1 F1C05920
BCD COMPLEX CONSTANT LIES OUTSIDE OF RANGE 10**-38 TO 10**+38 F1C05930
REM F1C05940
PZE ER0073,,-1 F1C05950
BCD EXPRESSION OR ILLEGAL PUNCTUATION ON LEFT OF EQUAL SIGN. F1C05960
REM F1C05970
PZE OCTERR,,-1 F1C05980
BCD 7MORE THAN TWELVE DIGITS IN OCTAL FIELD. F1C05990
REM F1C06000
PZE 12,,-1 F1C06010
BCD LIST OF DP - CA ARRAYS EXCEEDED. F1C06020
REM F1C06030
REM F1C06040
PZE 13,,-1 F1C06050
BCD LIST OF DP - CA NON-SUBSCRIPTED VARIABLES EXCEEDED. F1C06060
REM F1C06070
PZE ERDP02,,-1 F1C06080
BCD FIXED POINT NAMED FUNCTION IN A DP - CA STATEMENT. F1C06090
REM F1C06100
PZE ERDP01,,-1 F1C06110
BCD SUBSCRIPTED VARIABLE IN DP - CA STATEMENT NOT DEFINED IN DP F1C06120
BCD - CA DIMENSION STATEMENT. F1C06130
REM F1C06140
PZE ES136D,,-1 F1C06150
BCD 7FIXED POINT FUNCTION DEFINITION ILLEGAL F1C06160
REM F1C06170
PZE ERDP03,,-1 F1C06180
BCD 8NAME OF DP-CA FUNCTION EXCEEDS 5 CHARACTERS F1C06190
REM F1C06200
PZE ER2001,,-1 F1C06210
BCI 9,VARIABLE PARAMETER DOES NOT HAVE FIXED POINT NAME. F1C06220
REM F1C06230
PZE ER1009,,-1 F1C06240
BCD 4NO STATEMENT NUMBER. F1C06250
REM F1C06260
PZE NOXEQR,,-1 F1C06270
BCI 9,PROGRAM DOES NOT HAVE ANY EXECUTABLE STATEMENTS. F1C06280
REM F1C06290
PZE ER2002,,-1 F1C06300
BCI 7,UNIT DESIGNATION EITHER MISSING OR ZERO. F1C06310
REM F1C06320
PZE ER0074,,-1 F1C06330
BCI 5,TOO MANY LEFT PARENTHESIS. F1C06340
REM F1C06350
PZE ER0075,,-1 F1C06360
BCI 9,THE NUMERIC CONTROL OF A HOLLERITH TEXT IS LARGER THAN F1C06370
BCI 8, THE NUMBER OF CHARACTERS FOLLOWING THE H. F1C06380
REM F1C06381
PZE ER2003,,-1 F1C06382
BCI 5, PROGRAM EXPECTS EQUALS SIGN. F1C06383
REM F1C06384
REM F1C06390
PZE ER0080,,-1 $F1C06400
BCI 4,ILLEGAL DOUBLE OPERATOR. $F1C06410
REM $F1C06420
PZE ER0081,,-1 $F1C06430
BCI 4,ILLEGAL USE OF OPERATOR $F1C06440
REM $F1C06450
PZE ER0082,,-1 $F1C06460
BCI 5,INVALID DOUBLE EXPONENTIATION. $F1C06470
REM $F1C06480
PZE ER0031,,-1 (29)F1C06490
BCI 8,SUBROUTINE NAME APPEARS IN DIMENSION STATEMENT. (29)F1C06500
PZE ER0018,,-1 (30)F1C06510
BCI 8,SENSE LIGHT NUMBER IN IF STATEMENT IS INVALID. (30)F1C06520
PZE ,,-1 CURRENT END OF TABLE SIGNAL (30)F1C06530
BSS 66 SPACE FOR ADDITIONAL DIAGNOSTICS (30)F1C06540
REM $F1C99000
REM $F1C99010
REM $F1C99020
REM $F1C99030
ENDIAG SYN * END OF SECTION ONE DIAGNOSTIC. $F1C99040
REM $F1C99050
ENDF12 PZE ,,-1 END OF TABLE SIGNAL. $F1C99060
REM $F1C99070
TCD -1 $F1C99075
TTL * SECTION ONE PRIME * RECORD 9F16 * F1D00000
REM F1D00010
REM SECTION ONE PRIME CONSOLIDATES CORE AND TAPE BUFFERS F1D00020
REM LEFT BY SECTION ONE INTO COMPLETE TABLES. F1D00030
REM F1D00040
REM *************************************************************F1D00050
REM F1D00060
EJECT F1D00070
REM F1D00080
REM DEFINITIONS OF SECTION 1 PRIME TABLE ASSEMBLY BUFFERS. F1D00090
REM F1D00100
REM F1D00110
CCCC SYN FRETMX F1D00120
BBBB SYN 2*TAU1MX+4*TAU2MX+6*TAU3MX+NONXMX+STOPMX+2 F1D00130
AAAA SYN 5*DOLPMX+2*TIFGMX+TRADMX+FXCNMX+4+2 F1D00140
REM F1D00150
LWBF1O ORG TABORG-1-2*EQITMX-1 F1D00160
BSS 1 F1D00170
LWBF1 SYN * ASSEMBLY BUFFER ONE. F1D00180
REM F1D00190
LWBF2O ORG TABORG-1 F1D00200
BSS 1 F1D00210
LWBF2 SYN * ASSEMBLY BUFFER TWO. F1D00220
REM F1D00230
ORG TOPTAB-AAAA-BBBB-CCCC F1D00240
BSS 1 F1D00250
LWBF3 SYN * ASSEMBLY BUFFER THREE. F1D00260
REM F1D00270
REM F1D00280
ORG GERASE-1 F1D00290
BSS 1 F1D00300
UPBF1 SYN * ASSEMBLY BUFFER FOUR. F1D00310
EJECT F1D00320
REM ASSEMBLY BUFFER ASSIGNMENTS. F1D00330
REM F1D00340
FORVAL SYN LWBF2 F1D00350
FORMAT SYN UPBF1 F1D00360
FMTEFN SYN LWBF1 F1D00370
ENDTAB SYN LWBF1 F1D00380
SUBDEF SYN SBDFBF F1D00390
COMMON SYN UPBF1 F1D00400
HOLARG SYN LWBF1 F1D00410
TEIFNO SYN LWBF2 F1D00420
FORVAR SYN LWBF1 F1D00430
FORTAG SYN LWBF2 F1D00440
EQUITT SYN LWBF1 F1D00450
CALLFN SYN LWBF1 F1D00460
CLOSUB SYN LWBF1 F1D00470
REM F1D00480
REM THE FOLLOWING ARE LEFT IN MEMORY FOR F1D00490
REM SECTION ONE DOUBLE PRIME AND SECTION TWO. F1D00500
REM F1D00510
REM F1D00520
ORG LWBF3-1 F1D00530
STOPWC BSS 1 F1D00540
TSTOPS BSS STOPMX F1D00550
NONXWC BSS 1 F1D00560
NONEXC BSS NONXMX F1D00570
FRETWC BSS 1 F1D00580
FRETTB BSS FRETMX F1D00590
TAU1TB BSS TAU1MX*2 F1D00600
TAU2TB BSS TAU2MX*4 F1D00610
TAU3TB BSS TAU3MX*6 F1D00620
FIXCWC BSS 1 F1D00630
FIXCON BSS FXCNMX F1D00640
BSS 2 COMPENSTAING RESERVATION. F1D00650
TRADWC BSS 1 F1D00660
TRADTB BSS TRADMX F1D00670
TFGOWC BSS 1 F1D00680
TIFGOT BSS TIFGMX*2 F1D00690
TDOWC BSS 1 F1D00700
TDOTAB BSS DOLPMX*5 F1D00710
TIPTOP SYN * TOP OF TABLE MERGING AREA FOR 1 PRIME. F1D00720
EJECT F1D00730
REM F1D00740
REM *************************************************************F1D00750
REM F1D00760
REM F1D00770
LBL 9F16,THE WORKS F1D00780
REM F1D00790
ORG SYSCUR $F1D00800
BCI 1,9F1600 $F1D00810
ORG (LODR) $F1D00820
TXI BEGF13,,160 ENTRY POINT,,RECORD NUMBER F1D00830
REM F1D00840
REM *********************************************************F1D00850
REM F1D00860
ABS F1D00870
ORGF13 ORG PASS1 F1D00880
REM F1D00890
REM SECTION 1 PRIME DIAGNOSTIC CALLS. F1D00900
REM F1D00910
1PER1 TXI (DIAG),,-1 *PROGRAMMER ERROR. THERE ARE NOT ANY F1D00920
REM EXECUTABLE STATEMENTS IN THE SOURCE F1D00930
REM PROGRAM. F1D00940
REM F1D00950
1PER2 TXI (DIAG),,0 *MACHINE ERROR. THE NAME OF A DP-CA ARRAY F1D00960
REM CANNOT BE FOUND IN THE SIZ TABLE. F1D00970
REM SIMULTANEOUS ENTRIES OF THE NAME ARE F1D00980
REM MADE IN DLSIT1 AND THE APPROPRIATE DIM F1D00990
REM TABLE IN PASS1 OF SECTION I WHEN F1D01000
REM PROCESSING DIMENSION STATEMENTS. F1D01010
REM F1D01020
1PER3 TXI (DIAG),,-2 *PROGRAMMER ERROR. NONE OF THE SOURCE F1D01030
REM PROGRAM STATEMENTS HAVE BEEN ASSIGNED F1D01040
REM STATEMENT NUMBERS (EFNS). AT LEAST ONE F1D01050
REM EFN IS REQUIRED DUE TO THE EXISTENCE OF A F1D01060
REM DO, IF, GO TO, OR FREQUENCY STATEMENT. F1D01070
REM F1D01080
1PER4 TXI (DIAG),,0 *MACHINE ERROR. THE TIFGO TABLE HAS A F1D01090
REM ONE WORD ENTRY AS THE LAST ONE IN THE F1D01100
REM TABLE. TIFGO IS A TWO WORD ENTRY. F1D01110
REM F1D01120
1PER5 TXI (DIAG),,0 *MACHINE ERROR. FREQUENCY TABLE HAS BEEN F1D01130
REM EXHAUSTED IN THE MIDDLE OF AN ENTRY. F1D01140
REM F1D01150
1PER6 TXI (DIAG),,-3 *PROGRAMMER ERROR. A FREQUENCY STATEMENT F1D01160
REM DOES NOT CONTAIN ANY FREQUENCIES. F1D01170
REM NOTE-THERE IS A POSSIBILITY OF MACHINE ERROR. F1D01180
REM F1D01190
1PER7 TXI (DIAG),,-4 *PROGRAMMER ERROR. A TABLE HAS OVERFLOWED.F1D01200
TABNM BCI 1, THE NAME OF THE TABLE APPEARS IN THE F1D01210
REM LOCATION - TABNM. F1D01220
REM F1D01230
1PER8 TXI (DIAG),,-5 *PROGRAMMER ERROR. MORE THAN ONE F1D01240
STATN PZE ** FREQUENCY STATEMENT HAS BEEN MADE F1D01250
REM FOR THE STATEMENT NUMBER IN STATN. F1D01260
REM F1D01270
1PER9 TXI (DIAG),, NOT PRESENTLY USED. F1D01280
REM F1D01290
REM *************************************************************F1D01300
REM F1D01310
REM TAP - TABLE ASSEMBLY PROGRAM. ASSEMBLES TABLES FROM F1D01320
REM TAPE RECORDS AND CORE BUFFERS. F1D01330
REM F1D01340
TAP00 SXA TAPJ0,1 SAVE CONTENTS OF INDEX REGISTERS. F1D01350
SXA TAPJ1,2 F1D01360
SXA TAPJ2,4 F1D01370
LDQ 1,1 GET THE IDENTIFICATION NUMBER OF THE F1D01380
STQ TABLN TABLE TO BE ASSEMBLED AND SAVE. F1D01390
MPY (6)L COMPUTE INTET INDEX VALUE. F1D01400
XCA MOVE TO AC. F1D01410
PAC ,1 LOAD INTET REFERENCE. F1D01420
CAL INTETX+3,1 GET TABLE ORIGIN AND MAXIMUM LENGTH. F1D01430
STA TAPIO+1 SET ASSEMBLY ORIGIN IN I/O COMMAND. F1D01440
STD TAPAA SET TABLE OVERFLOW TEST. (34)F1D01450
CAL INTETX,1 GET CORE BUFFER WORD COUNT (34)F1D01460
PDX ,2 AND SAVE IT (34)F1D01465
SXA TAPF0,2 FOR LATER USE WHEN MERGING. (34)F1D01470
PXD ,2 SAVE DECREMENT ONLY (WORD COUNT) (35)F1D01475
ADD INTETX+4,1 ADD TAPE RECORD AND WORD COUNT (35)F1D01480
PDX ,4 GET ASSEMBLED TABLE WORD COUNT. (35)F1D01485
TAPAA TXL TAPG0,4,** *WILL TABLE OVERFLOW,NO. (35)F1D01490
CAL INTETX+5,1 YES,GET THE TABLE NAME AND (35)F1D01495
SLW TABNM SAVE IT FOR THE GENERAL DIAGNOSTIC. (35)F1D01496
TSX 1PER7,4 *GO TO DIAGNOSTIC. (35)F1D01497
TAPG0 PAX ,2 GET COUNT OF RECORDS ON TAPE. (35)F1D01500
PXD ,4 PUT ASSEMBLED TABLE WORD COUNT ALONE (35)F1D01505
STO INTETX+4,1 BACK INTO CONTROL BLOCK AND AT THE (35)F1D01510
AXT 1,4 TABLE ORIGON MINUS ONE FOR (35)F1D01512
STO* INTETX+3,1 SECTION TWOS USE,IF ANY. (35)F1D01514
TXL TAPF0,2,0 *NOTHING ON TAPE (35)F1D01516
SXD TAPD0,2 SET COUNT OF RECORDS TO READ. (35)F1D01518
CAL INTETX+2,1 GET RECORD LENGTH AND TAPE ADDRESS. F1D01520
STD TAPC0 SET TAPE ADDRESS IN CALLING SEQUENCES. F1D01530
STD TAPE0 F1D01540
PAX ,4 LOAD RECORD LENGTH. F1D01550
SXD TAPIO+1,4 SET IN I/O COMMAND. F1D01560
AXT 1,2 INITIALIZE RECORD NUMBER. F1D01570
TAPA0 SXD TABLN,2 SET RECORD NUMBER IN TABLE IDENTIFICATION.F1D01580
TAPB0 TSX (TAPE),4 READ A RECORD FROM TAPE. F1D01590
PZE TAPIO,,(RBNC) F1D01600
TAPC0 MZE INTETX+5,1,** F1D01610
CAL RECID GET LABEL READ. F1D01620
ERA TABLN IS THIS THE RECORD BEING SEARCHED FOR. F1D01630
TNZ TAPB0 *NO, TRY AGAIN. F1D01640
LDC TAPC0,4 YES, LOAD 2S COMPLIMENT OF LIGICAL TAPE F1D01650
CAL (SCHU),4 NUMBER AND GET THE CONTENTS OF THE SCHX. F1D01660
STA TAPIO+1 SET NEW LOAD ADDRESS FOR BUILDING TABLE. F1D01670
TXI *+1,2,1 INCREMENT RECORD COUNT. F1D01680
TAPD0 TXL TAPA0,2,** *HAVE RECORDS BEEN FOUND, NO CONTINUE. F1D01690
TSX (TAPE),4 YES, REWIND DUMP TAPE. F1D01700
PZE REWND,,(SKBP) F1D01710
TAPE0 PZE ,,** F1D01720
REM F1D01730
REM ALL TAPE BUFFERS HAVE BEEN MERGED INTO F1D01740
REM CONSECUTINE LOCATIONS. NOW PICK UP ANY F1D01750
REM TABLE ENTRIES IN THE CORE BUFFER AND F1D01760
REM MERGE THEN AT THE END. F1D01770
REM F1D01780
TAPF0 AXT **,2 GET COUNT OF WORDS LEFT IN CORE BUFFER (35)F1D01900
TXL TAPJ0,2,0 *ANYTHING IN THE CORE BUFFER, NO. F1D01910
PXA ,2 YES, COMPUTE LAST ADDRESS PLUS ONE F1D01920
ADD INTETX,1 OF CORE BUFFER. F1D01930
STA TAPI0 INITIALIZE MOVING LOOP. F1D01940
PXA ,2 COMPUTE LAST ADDRESS PLUS ONE OF F1D01950
ADD TAPIO+1 TABLE IN ASSEMBLY AREA. F1D01960
STA TAPI1 INITIALIZE MOVEING LOOP F1D01970
TAPI0 CAL **,2 GET A WORD FROM THE CORE BUFFER. F1D01980
TAPI1 SLW **,2 STORE IT IN THE TABLE. F1D01990
TIX TAPI0,2,1 *ALL CORE ENTRIES MOVED, NO CONTINUE. F1D02000
REM F1D02010
REM THE TABLE (IF ANY) HAS BEEN ASSEMBLED. F1D02020
REM F1D02030
TAPJ0 AXT **,1 RESTORE THE CONTENTS OF THE F1D02040
TAPJ1 AXT **,2 INDEX REGISTERS. F1D02050
TAPJ2 AXT **,4 F1D02060
TRA 2,1 *RETURN TO CALLER. F1D02070
REM F1D02080
REM F1D02090
REM CONSTANTS, ERASABLE AND I/O COMMANDS. F1D02100
REM F1D02110
(6)L DEC 6 CONSTANT FOR COMPUTING INTET INDEX. F1D02120
AXT 0,0 ( NOT USED ) (34)F1D02130
RECID PZE **,,** RECORD LABEL READ FROM TAPE. F1D02140
TABLN PZE **,,** RECORD LABEL BEING SEARCHED FOR. F1D02150
REM F1D02160
REWND PZE ,,-1 I/O COMMAND TO REWIND THE DUMP TAPE. F1D02170
BSR MZE 1,,0 BACKSPACE COUNT. F1D02180
REM F1D02190
TAPIO IOCP RECID,,1 I/O COMMAND TO READ RECORD LABEL. F1D02200
IORT **,,** I/O COMMAND TO READ TAPE BUFFER. F1D02210
REM F1D02220
REM END OF TAP ROUTINE. F1D02230
REM F1D02240
REM *************************************************************F1D02250
REM F1D02260
REM F1D02270
REM WAT - WRITE ASSEMBLED TABLE PROGRAM. F1D02280
REM WRITE AN ASSEMBLED TABLE ON THE TABLE TAPE F1D02290
REM PRECEDED BY ITS IDENTIFICATION AND WORD COUNT. F1D02300
REM F1D02310
WAT00 SXA WAT01,1 SAVE CONTENTS OF INDEX REGISTERS. F1D02320
SXA WAT02,4 F1D02330
SXA WAT03,2 F1D02340
AXC 2,2 LOAD FLIP-FLOP SWITCH. F1D02350
SXA *-1,2 RESET IT FOR NEXT TIME THROUGH. F1D02360
LDQ 1,1 GET TABLE IDENTIFICATION NUMBER. F1D02370
STQ WATA0,2 SAVE TABLE IDENTIFICATION NUMBER. F1D02380
MPY (6)L COMPUTE INTETX INDEX. F1D02390
XCA MOVE TO AC. F1D02400
PAC ,1 LOAD INTETX INDEX. F1D02410
CAL INTETX+3,1 GET ORIGIN OF TABLE TO BE WRITTEN. F1D02420
STA WATB2,2 SET TABLE ORIGIN IN I/O COMMAND. F1D02430
CAL INTETX+4,1 GET TABLE WORD COUNT. F1D02440
STD WATA1,2 SAVE TABLE WORD COUNT FOR WRITING ON TAPE.F1D02450
STD WATB2,2 SET IN I/O COMMAND FOR WRITING TABLE. F1D02460
TSX (TAPE),4 WRITE TABLE. F1D02470
PZE WATB0,2,(WBNP) F1D02480
PZE INTETX+5,1,TABTAP F1D02490
WAT01 AXT **,1 RESTORE INDEX REGISTERS. F1D02500
WAT02 AXT **,4 F1D02510
WAT03 AXT **,2 F1D02520
TRA 2,1 *RETURN TO CALLER. F1D02530
REM F1D02540
REM F1D02550
REM CONSTANTS, ERASABLE AND I/O COMMANDS. F1D02560
REM F1D02570
PZE **,,0 FLIP TABLE IDENTIFICATION. F1D02580
PZE ,,** FLIP TABLE WORD COUNT. F1D02590
REM F1D02600
WATA0 IOCP *-2,,2 FLIP ID AND WORD COUNT I/O COMMAND. F1D02610
WATA1 IOCT **,,** FLIP TABLE I/O COMMAND. $F1D02620
REM F1D02630
WATB0 PZE **,,0 FLOP TABLE IDENTIFICATION. F1D02640
WATB2 PZE ,,** FLOP TABLE WORD COUNT. F1D02650
REM F1D02660
IOCP *-2,,2 FLOP ID AND WORD COUNT I/O COMMAND. F1D02670
IOCT **,,** FLOP TABLE I/O COMMAND. $F1D02680
REM F1D02690
REM END OF WAT ROUTINE. F1D02700
REM F1D02710
REM *************************************************************F1D02720
EJECT F1D02730
REM F1D02740
BEGF13 AXT 4,4 SET ERROR FLAG FOR MONITOR ERROR RECORDS. F1D02750
SXA (MSLN),4 F1D02760
SLF TURN OFF SENSE LITES. F1D02770
DCT TURN OFF DIVIDE CHECK F1D02780
NOP AND F1D02790
TQO *+1 MQ OVERFLOW TRIGGERS. F1D02800
REM F1D02810
REM F1D02820
REM ROUTINE TO WRITE FORSUB AS RECORD AS RECORD 1 OF FILE 3. F1D02830
REM F1D02840
TSX (TAPE),4 WRITE END-OF-FILE AFTER COMPAIL RECORDS. F1D02850
PZE ,,(WEFP) F1D02860
PZE 2NDEOF,,CITTAP FIRST FILE IS THE SOURCE PROGRAM. F1D02870
REM F1D02880
NZT CITCNT WERE ANY CITS COMPILED. F1D02890
TSX 1PER1,4 NO, SOURCE PROGRAM IS NOT EXECUTABLE. F1D02900
SXD CITCNT,0 SET CIT WORD COUNT TO ZERO, SAVE RECORD CTF1D02910
LDC BK,4 GET TRUE VALUE OF FORSUB WORD COUNT. F1D02920
SXD IOCM2,4 SET IN I/O COMMAND. F1D02930
TSX (TAPE),4 WRITE CIT RECORD COUNT AND FORSUB TABLE, F1D02940
PZE IOCM1,,(WBNP) (IF ANY). F1D02950
PZE LABL1,,TABTAP F1D02960
REM F1D02970
TSX (TAPE),4 WRITE AN END-OF-FILE AFTER LAST RECORD. F1D02980
PZE ,,(WEFP) F1D02990
PZE 3RDEOF,,TABTAP F1D03000
REM F1D03010
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D03020
REM F1D03030
REM ROUTINE TO WRITE FLOCON AS RECORD 1 OF FILE 4. F1D03040
REM F1D03050
LXD FLCNIX-2,4 GET FLOCON WORD COUNT. F1D03060
SXA FLOCNT,4 SAVE IN ZERO WORD. F1D03070
SXD FLOCOM+1,4 SET IN I/O COMMAND. F1D03080
CLA FLCNIX-1 GET ADDRESS OF FLOCON TABLE F1D03090
STA FLOCOM+1 AND SET IN I/O COMMAND. F1D03100
TSX (TAPE),4 WRITE FLOCON WORD COUNT AND FLOCON F1D03110
PZE FLOCOM,,(WBNP) TABLE (IF ANY). F1D03120
PZE LABL2,,TABTAP F1D03130
REM F1D03140
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D03150
REM F1D03160
TSX TAP00,1 ASSEMBLE TABLE OF FORMAT STATEMENTS. F1D03170
PZE 10 F1D03180
REM F1D03190
TSX WAT00,1 WRITE FORMAT TABLE AS RECORD 2 OF FILE 4. F1D03200
PZE 10 F1D03210
REM F1D03220
REM F1D03230
REM ROUTINE TO CHECK FOR MISSING FORMAT STATEMENTS. F1D03240
REM F1D03250
LAC INTETR,2 LOAD 2S COMPLEMENT OF FMTEFN TABLE ORIGIN.F1D03260
TXI *+1,2,-1 ALLOW FOR WORD COUNT FROM TAP00. F1D03270
SXD FRCKE,2 SET ORIGIN IN WORD COUNT COMPUTATION. F1D03280
LAC INTETK,1 LOAD 2S COMPLEMENT OF FORMAT TABLE ORIGIN.F1D03290
LDC INTETK+1,4 LOAD 2S COMPLEMENT OF WORD COUNT. F1D03300
TXL FRCKF,4,0 *SKIP SCAN FOR FORMULA NUMBERS IF NO TABLE.F1D03310
SXD *+1,4 SET 2S COMPLEMENT OF F1D03320
TXI *+1,1,** LAST ADDRESS OF TABLE F1D03330
SXD FRCKB,1 TO STOP SEARCH. F1D03340
SXD FRCKC,1 F1D03350
LAC INTETK,1 RESTORE IR1. F1D03360
CLS FRCON GET END OF ENTRY (STATEMENT) FLAG. F1D03370
TRA FRCKC+1 MOVE FIRST WORD OF TABLE. F1D03380
FRCKA CAS 0,1 IS THIS AN END OF ENTRY MARKER. F1D03390
TXI *+3,1,-1 NO, LOOK AT NEXT WORD. F1D03400
TXI FRCKC,1,-1 F1D03410
TXI *+1,1,-1 NO, LOOK AT NEXT WORD. F1D03420
FRCKB TXH FRCKA,1,** IS THIS THE END OF THE FORMAT TABLE. F1D03430
TRA FRCKD *YES. F1D03440
REM F1D03450
FRCKC TXL FRCKD,1,** *IS THIS THE END OF THE FORMAT TABLE, YES. F1D03460
LDQ 0,1 SAVE FORMULA NUMBER OF FORMAT STATEMENT F1D03470
STQ 0,2 IN CONDENSED TABLE. F1D03480
TXI FRCKA,2,-1 INCREMENT CONDENSED INDEX, CONTINUE SCAN. F1D03490
REM F1D03500
FRCKD PXA ,2 GET TRUE VALUE OF LAST ADDRESS PLUS ONE F1D03510
PAC ,2 OF CONDENSED FORMAT TABLE (ONLY FORMULA F1D03520
SXA FRCKH,2 NUMBERS) AND SET IN COMPARE LOOP. F1D03530
SXA FRCKL,2 SET IN MASKING LOOP. F1D03540
TXI *+1,2,1 ALLOW FOR WORD COUNT FROM TAP00. F1D03550
SXA INTETR,2 SET NEW ORIGIN FOR FMTEFN TABLE. F1D03560
FRCKE TXI *+1,2,** COMPUTE WORD COUNT OF TABLE. F1D03570
SXA FRCKG,2 SAVE WORD COUNT. F1D03580
CAL ADMSK LOAD AC WITH ADDRESS MASK. F1D03590
FRCKL ANS **,2 CLEAR HASH FROM CONDENSED FORMAT TABLE. F1D03600
TIX *-1,2,1 F1D03610
REM F1D03620
FRCKF TSX TAP00,1 ASSEMBLE FMTEFN TABLE, TABLE OF FORMAT F1D03630
PZE 17 REFERENCES. F1D03640
REM F1D03650
STZ ELSEBF INITIALIZE ERROR CELL TO ZERO. F1D03660
LXD INTETR+1,4 LOAD WORD COUNT OF FMTEFN TABLE. F1D03670
TXL FRCKK+1,4,0 *NO REFERENCES TO FORMAT STATEMENTS. F1D03680
PXA ,4 PLACE WORD COUNT IN AC. F1D03690
PAX ,1 LOAD FMTEFN WORD COUNT. F1D03700
ADD INTETR COMPUTE LAST ADDRESS PLUS ONE OF FMTEFN. F1D03710
STA FRCKG+1 SET ADDRESS FOR TIX LOOP. F1D03720
STA *+2 SET IN MASKING LOOP. F1D03730
CAL ADMSK LOAD ADDRESS MASK. F1D03740
ANS **,1 CLEAR HASH FROM FMTEFN TABLE. F1D03750
TIX *-1,1,1 F1D03760
AXT 0,1 INITIALIZE ERROR COUNTER. F1D03770
FRCKG AXT **,2 LOAD FORMAT WORD COUNT. F1D03780
CAL **,4 GET A REFERENCE TO A FORMAT STATEMENT. F1D03790
FRCKH LAS **,2 DOES THIS FORMAT STATEMENT EXIST. F1D03800
TRA *+2 NO. F1D03810
TRA FRCKJ YES, GET NEXT REFERENCE OR QUIT. F1D03820
TIX FRCKH,2,1 *NO, CONTINUE SEARCH. F1D03830
STZ ELSEBF-1,1 SAVE EXTERNAL FORMULA NUMBER IN ERROR F1D03840
STA ELSEBF-1,1 LIST FOR 1 DOUBLE PRIME. F1D03850
TXI *+1,1,1 INCREMENT ERROR LIST INDEX. F1D03860
REM F1D03870
FRCKJ TIX FRCKG,4,1 *CONTINUE, OR QUIT IF AT END OF REFERENCE F1D03880
REM F1D03890
TXL FRCKK,1,0 *NO ERRORS. F1D03900
PXA ,1 SOME ERROR, PLACE COUNT IN AC. F1D03910
ORA FRTSG ADD THE MISSING FORMAT STATEMENT FLAG. F1D03920
SLW ELSEBF STORE AT TOP OF ERROR LIST. F1D03930
TXI *+1,1,1 ADD FLAG TO COUNT OF WORDS IN ERROR LIST. F1D03940
FRCKK SXD GOOFCT,1 SAVE ERROR LIST WORD COUNT. F1D03950
REM F1D03960
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D03970
REM F1D03980
REM ROUTINE TO ELIMINATE DUPLICATE ENTRIES FROM THE CLOSUB F1D03990
REM TABLE AND THE NAMES OF DUMMY FUNCTION NAMES. DUMMY F1D04000
REM NAMES APPEAR IN THE ARGUMENT LISTS OF FUNCTION AND/OR F1D04010
REM SUBROUTINE STATEMENTS, THAT IS IN THE SUBDEF TABLE. F1D04020
REM F1D04030
TSX TAP00,1 ASSEMBLE SUBDEF TABLE FOR USE WITH CLOSUB.F1D04040
PZE 11 F1D04050
REM F1D04060
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D04070
REM F1D04080
TSX TAP00,1 ASSEMBLE CLOSUB TABLE. F1D04090
PZE 9 F1D04100
REM F1D04110
LXD INTETJ+1,4 LOAD WORD COUNT OF CLOSUB TABLE. F1D04120
TXL DMSZA,4,0 *CLOSUB TABLE IS EMPTY. F1D04130
PXA ,4 SOME TABLE, PLACE WORD COUNT IN AC. F1D04140
ADD INTETJ COMPUTE LAST ADDRESS PLUS ONE. F1D04150
STA MCLSB INITIALIZE ADDRESSES IN ROUTINE. F1D04160
STA MCLSC F1D04170
CLA INTETJ INITIALIZE ADDRESSES IN ROUTINE TO F1D04180
STA MCLSD ORIGIN OF CLOSUB TABLE. F1D04190
STA MCLSJ F1D04200
STA MCLSH F1D04210
LXD INTETL+1,1 LOAD WORD COUNT OF SUBDEF TABLE. F1D04220
PXA ,1 PLACE WORD COUNT IN AC AND F1D04230
ADD INTETL COMPUTE LAST ADDRESS PLUS ONE F1D04240
STA MCLSG OF SUBDEF TABLE. F1D04250
TNX MCLSA,1,1 SKIP FIRST NAME IN SUBDEF, MAY BE THE F1D04260
SXA MCLSF,1 NAME OF THE SUBPROGRAM BEING COMPILED. F1D04270
REM F1D04280
MCLSA AXT 0,2 INITIALIZE SORTED CLOSUB INDEX. F1D04290
MCLSB CAL **,4 GET A CLOSUB ENTRY. F1D04300
MCLSC STZ **,4 RESET VACATED CELL. F1D04310
MCLSD NZT **,2 IS THIS THE END OF THE SORTED CLOSUB TABLEF1D04320
MCLSE TXI MCLSF,,** *YES, NAME IS NOT A DUPLICATE. F1D04330
MCLSJ LAS **,2 NO, IS THIS NAME ALREADY IN THE SORTED F1D04340
TXI MCLSD,2,-1 CLOSUB. MAY BE, CONTINUE SCAN. F1D04350
TRA MCLSI *YES, DELETE IT. F1D04360
TXI MCLSD,2,-1 MAY BE, CONTINUE SCAN. F1D04370
MCLSF AXT **,1 LOAD WORD COUNT OF SUBDEF TABLE. F1D04380
TXL MCLSH,1,0 *NO TABLE. F1D04390
MCLSG LAS **,1 IS THIS NAME IN SUBDEF. F1D04400
TRA *+2 F1D04410
TRA MCLSI *YES, DO NOT ENTER IN SORTED CLOSUB. F1D04420
TIX MCLSG,1,1 *COULD BE, CONTINUE SCAN. F1D04430
MCLSH SLW **,2 IS REAL, UNIQUE SUBPROGRAM NAME, ENTER F1D04440
SXD MCLSE,2 IN SORTED CLOSUB AND SAVE COUNTER. F1D04450
REM F1D04460
MCLSI TIX MCLSA,4,1 *IS UNSORTED CLOSUB EXHAUSTED, NO CONTINUE.F1D04470
REM F1D04480
LXD MCLSE,6 CLOSUB HAS BEEN PROCESSED, ARE THERE ANY F1D04490
TXH MCLSK,2,0 *ENTRIES LEFT. YES. F1D04500
NZT* MCLSH A SINGLE ENTRY WILL NOT SHOW IN COUNTER. F1D04510
TRA MCLSL *NOTHING AT ALL. F1D04520
MCLSK LDC MCLSE,4 AT LEAST ONE ENTRY, LOAD TRUE COUNTER. F1D04530
TXI *+1,4,1 ADD THE COUNT OF ONE THAT GOT LOST. F1D04540
MCLSL SXD INTETJ+1,4 SAVE NEW WORD COUNT. F1D04550
TXL DMSZA,4,0 *SKIP REST OF ROUTINE, NO CLOSUB LEFT. F1D04560
SXD CLSIO,4 SET WORD COUNT IN I/O COMMAND. F1D04570
CLA INTETJ SET ADDRESS IN I/O COMMAND. F1D04580
STA CLSIO F1D04590
PXA ,4 COMPUTE LAST ADDRESS PLUS ONE OF SORTED F1D04600
ADD INTETJ CLOSUB TABLE FOR THE DIM TO SIZ ROUTINE F1D04610
STA DMSZN AND INITIALIZE ADDRESS. F1D04620
TSX (TAPE),4 WRITE SORTED CLOSUB TABLE ON SCRATCH TAPE.F1D04630
PZE CLSIO,,(WBNP) F1D04640
PZE TCLOS,,EXEQTP F1D04650
REM F1D04660
REM THE CLOSUB TABLE HAS BEEN MODIFIED, AND IF ANY TABLE F1D04670
REM REMAINED IT HAS BEEN WRITTEN AS THE FIRST RECORD ON F1D04680
REM A SCRATCH TAPE. F1D04690
REM F1D04700
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D04710
REM F1D04720
REM ROUTINE FOR CONVERTING THE DIMENSION TABLES F1D04730
REM (DIM1, DIM2, DIM3, DLST1, AND DLST2) TO THE SIZ TABLE. F1D04740
REM F1D04750
DMSZA LAC ORGDM1-1,1 LOAD 2S COMPLIMENT OF NEXT ENTRY ADDRESS F1D04760
TXI DMSZB,1,2 IN DIM1 AND REDUCE TO NEXT CORE ADDRESS. F1D04770
REM F1D04780
DMSZB LXD ORGDM2-1,4 LOAD COUNT OF ENTRIES IN DIM2. F1D04790
TXL DMSZD,4,0 *NO ENTRIES IN DIM2 TABLE. F1D04800
LAC ORGDM2,2 LOAD 2S COMPLIMENT OF ORIGIN OF DIM2. F1D04810
DMSZC CAL 0,2 MOVE VARIABLE NAME FROM DIM2 BEHIND F1D04820
SLW 0,1 DIM1 TABLE (PACK DIM2 TABLE BEHIND DIM1). F1D04830
CLA 1,2 GET DIMENSIONS OF THIS VARIABLE. F1D04840
STA ERASA1 SAVE SECOND DIMENSION. F1D04850
LRS 53 SHIFT FIRST DIMENSION INTO RIGHT MOST F1D04860
MPY ERASA1 PART OF MQ AND MULTIPLY BY SECOND. F1D04870
STQ 1,1 SAVE PRODUCT (LINEAR DIMENSION OF THIS F1D04880
TXI *+1,1,-2 ARRAY) IN PACKED TABLE. F1D04890
TXI *+1,2,-2 UPDATE INDICES. F1D04900
TIX DMSZC,4,1 *IS DIM2 EXHAUSTED, NO CONTINUE. F1D04910
REM F1D04920
REM COMPUTE THE LINEAR LENGTH OF THE VARIABLESF1D04930
REM IN THE DIM3 TABLE AND PACK BEHIND DIM2 F1D04940
REM IN THE COMBINED DIM1-DIM2 TABLE (SIZ). F1D04950
REM F1D04960
DMSZD LXD DIM3IX-2,4 LOAD COUNT OF ENTRIES IN DIM3 TABLE. F1D04970
TXL DMSZF,4,0 *DIM3 TABLE EMPTY. F1D04980
LAC DIM3IX-1,2 LOAD 2S COMPLIMENT OF DIM3 ORIGIN. F1D04990
DMSZE CAL 0,2 GET VARIABLE NAME FROM DIM3 AND PACK F1D05000
SLW 0,1 BEHIND SIZ TABLE. F1D05010
CLA 1,2 GET DIMENSIONS. F1D05020
STA ERASA1 SAVE SECOND DIMENSION. F1D05030
LRS 53 SHIFT FIRST DIMENSION INTO ADDRESS OF MQ. F1D05040
MPY ERASA1 MULTIPLY BY SECOND DIMENSION. F1D05050
MPY 2,2 MULTIPLY PRODUCT OF D1*D2 BY THIRD F1D05060
STQ 1,1 DIMENSION AND SAVE PRODUCT(LINEAR DIM.). F1D05070
TXI *+1,1,-2 UPDATE INDICES. F1D05080
TXI *+1,2,-3 F1D05090
TIX DMSZE,4,1 *IS DIM3 TABLE EXHAUSTED, NO CONTINUE. F1D05100
REM F1D05110
REM THIS PART OF THE DIM TO SIZ ROUTINE F1D05120
REM DOUBLES THE STORAGE ASSIGNMENT FOR DP F1D05130
REM AND CA ARRAYS. NAMES OF ARRAYS ARE F1D05140
REM ENTERED IN DLST1 WHEN THEY APPEAR IN A F1D05150
REM DIMESION STATEMENT HAVING A D OR I IN F1D05160
REM CARD COLUMN ONE. F1D05170
REM F1D05180
DMSZF LXD DLIST1-2,4 LOAD COUNT OF ENTRIES IN DLIST1 TABLE. F1D05190
TXL DMSZK,4,0 *TABLE EMPTY. F1D05200
SXD DMSZI,1 SAVE SIZ TABLE INDEX IN TEST INSTRUCTION. F1D05210
LAC DLIST1-1,2 LOAD 2S COMPLIMENT OF DLST1 TABLE ORIGIN. F1D05220
DMSZG LAC ORGDM1,1 LOAD 2S COMPLIMENT OF SIZ TABLE ORIGIN. F1D05230
CAL 0,2 GET AN ARRAY NAME FROM DLST1 AND F1D05240
DMSZH LAS 0,1 SEARCH FOR IT IN SIZ. F1D05250
TXI DMSZI,1,-2 NOT FOUND YET, INCREMENT SIZ INDEX. F1D05260
TXI DMSZJ,2,-2 NAME FOUND IN SIZ, UPDATE DLST1 INDEX. F1D05270
TXI DMSZI,1,-2 NOT FOUND YET, INCREMENT SIZ INDEX. F1D05280
DMSZI TXH DMSZH,1,** *IS SIZ TABLE EXHAUSTED, NO CONTINUE. F1D05290
TSX 1PER2,4 YES, WE HAVE A MACHINE ERROR. F1D05300
DMSZJ CAL 1,1 GET DIMENSION OF ARRAY IN SIZ AND F1D05310
ALS 1 MULTIPLY BY 2. F1D05320
SLW 1,1 THEN, STORE BACK IN SIZ. F1D05330
TIX DMSZG,4,1 *IS DLST1 TABLE EXHAUSTED, NO CONTINUE. F1D05340
LXD DMSZI,1 YES, RESTORE SIZ INDEX. F1D05350
REM F1D05360
REM THIS PART OF THE DIM TO SIZ ROUTINE F1D05370
REM ASSIGNS 2 WORDS OF STORAGE FOR NON- F1D05380
REM SUBSCRIPTED VARIABLES APPEARING IN DP F1D05390
REM AND CA ARITHMETIC, IF AND CALL STATEMENTS.F1D05400
REM F1D05410
DMSZK LXD DLIST2-2,4 LOAD COUNT OF ENTRIES IN DLST2 TABLE. F1D05420
TXL DMSZR,4,0 *TABLE EMPTY. F1D05430
PXA ,4 PLACE COUNT OF ENTRIES (DLST2 IS A 1 WORD F1D05440
ADD DLIST2-1 ENTRY) IN AC AND COMPUTE LAST ADDRESS F1D05450
STA DMSZM PLUS ONE OF TABLE. F1D05460
LDQ (2)L LOAD A DIMENSION OF TWO INTO MQ. F1D05470
DMSZL LXD INTETJ+1,2 LOAD WORD COUNT OF CLOSUB TABLE. F1D05480
DMSZM CAL **,4 GET AN ENTRY FROM DLST2 AND SEARCH FOR F1D05490
TXL DMSZP,2,0 *THAT NAME IN CLOSUB. NO CLOSUB TABLE. F1D05500
DMSZN LAS **,2 IF THE NAME APPEARS IN CLOSUB, THEN F1D05510
TRA *+2 SECTION ONE HAS MISTAKENLY THOUGHT IT TO F1D05520
TRA DMSZQ BE A NON-SUBSCRIPTED VARIABLE NAME IN THE F1D05530
TIX DMSZN,2,1 ARGUMENT LIST OF A CALL STATEMENT. F1D05540
DMSZP SLW 0,1 SYMBOL NOT IN CLOSUB, IS REAL NON- F1D05550
STQ 1,1 SUBSCRIPTED VARIABLE NAME, ASSIGN A F1D05560
TXI *+1,1,-2 DIMENSION OF TWO. F1D05570
DMSZQ TIX DMSZL,4,1 *IS DLST2 EXHAUSTED, NO CONTINUE. F1D05580
REM F1D05590
REM THE SIZ TABLE CONSISTING OF TWO WORD ENTRIES F1D05600
REM IS NOW COMPLETE. THE DIM1, DIM2, DIM3, DLST1, F1D05610
REM AND DLST2 TABLES ARE DEAD. F1D05620
REM F1D05630
DMSZR PXD ,1 GET TRU LAST ADDRESS F1D05640
PDC ,1 OF SIZ TABLE. F1D05650
LAC ORGDM1,4 LOAD 2S COMPLIMENT OF SIZ TABLE ORIGIN F1D05660
SXD *+1,4 AND SET IN INSTRUCTION TO COMPUTE F1D05670
TXI *+1,1,** WORD COUNT OF SIZ TABLE. F1D05680
SXD DMIO3,1 SET WORD COUNT IN I/O COMMAND. F1D05690
SXA ERASA1,1 SAVE WORD COUNT TO BE WRITTEN ON TAPE. F1D05700
TSX (TAPE),4 WRITE SIZ TABLE AS RECORD 3 OF FILE 4. F1D05710
PZE DMIO1,,(WBNP) THE SIZ TABLE (IF ANY) IS PRECEDED BY F1D05720
PZE LABL3,,TABTAP EIFNO (LAST IFN IN PROGRAM) AND THE F1D05730
REM F1D05740
TSX (TAPE),4 SIZ WORD COUNT. WRITE AN END-OF-FILE F1D05750
PZE ,,(WEFP) AFTER THE SIZ TABLE. F1D05760
PZE 4THEOF,,TABTAP F1D05770
REM F1D05780
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D05790
REM F1D05800
NZT INTETJ+1 WAS CLOSUB WRITTEN ON SCRATCH TAPE. F1D05810
TRA FXASM NO, THERE IS NO ANY CLOSUB TABLE. F1D05820
TSX (TAPE),4 BACKSPACE SCRATCH TAPE TO BEGINNING OF F1D05830
PZE BSR,,(SKBP) CLOSUB TABLE. F1D05840
PZE TCLOS,,EXEQTP F1D05850
REM F1D05860
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D05870
REM F1D05880
FXASM LXD FXCNIX-2,4 PLACE FIXCON TABLE WORD COUNT IN LOCATION F1D05890
PXA ,4 PRECEDING THE TABLE FOR SECTION TWO. F1D05900
STO FXCNWC F1D05910
REM F1D05920
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D05930
REM F1D05940
REM ASSEMBLE ENDI TABLE (IF NONE, FABRICATE ONE). F1D05950
REM F1D05960
ENDIA LXD INTETT,1 LOAD ENDI TABLE MAXIMUM LENGTH. F1D05970
PXA ,1 PLACE MAXIMUM LENGTH IN AC. F1D05980
ADD INTETT COMPUTE LAST ADDRESS PLUS ONE OF ASSEMBLY F1D05990
STA ENDIB BUFFER AND INITIALIZE ADDRESS. F1D06000
CAL (2)L SET ENTIRE F1D06010
ENDIB SLW **,1 TABLE TO 2S. F1D06020
TIX ENDIB,1,1 F1D06030
REM F1D06040
TSX TAP00,1 ASSEMBLE ENDI TABLE OVER PRE-SET BUFFER. F1D06050
PZE 19 F1D06060
REM F1D06070
AXT 6,1 LOAD SENSE SWITCH COUNT OF SIX. F1D06080
PXA ,1 PLACE IN AC. F1D06090
ADD INTETT COMPUTE ADDRESS OF LAST PHYSICAL SENSE F1D06100
STA ENDIC SWITCH AND INITIALIZE ADDRESS. F1D06110
ENDIC CAL **,1 GET A SETTING FROM THE ASSEMBLED TABLE. F1D06120
SUB (2)L IS IT A SETTING OF TWO. F1D06130
TMI ENDID *NO, 0 OR 1, LEAVE ALONE. F1D06140
ZAC SENSE SWITCH UP, RESET SETTING. F1D06170
SLW* ENDIC SAVE NEW SETTING FOR THIS SENSE SWITCH. F1D06180
ENDID TIX ENDIC,1,1 *ALL TESTED, NO CONTINUE. F1D06190
REM F1D06200
REM THE ENDI TABLE NOW CONTAINS AT LEAST F1D06210
REM SIX ENTRIES. F1D06220
LXD INTETT+1,4 GET ENDI WORD COUNT. WERE THERE ANY F1D06230
TXL *+2,4,6 *SETTINGS IN THE END CARD. NO. F1D06240
SXD ENDIO,4 YES, MORE THAN SIX, RESET I/O COMMAND. F1D06250
CLA INTETT GET ORIGIN OF TABLE. F1D06260
STA ENDIO SET IN I/O COMMAND. F1D06270
TSX (TAPE),4 WRITE ENDI TABLE AS RECORD 1 OF FILE 5. F1D06280
PZE ENDIO,,(WBNP) F1D06290
PZE INTETT+2,,TABTAP F1D06300
REM F1D06310
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D06320
REM F1D06330
REM SUBDEF TABLE IS NO LONGER NEEDED, WRITE IT OUT. F1D06340
REM F1D06350
TSX WAT00,1 NO MODIFICATION, WRITE IT AS RECORD 2 F1D06360
PZE 11 OF FILE 5. F1D06370
REM F1D06380
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D06390
REM F1D06400
TSX TAP00,1 ASSEMBLE COMMON TABLE. F1D06410
PZE 12 F1D06420
REM F1D06430
TSX WAT00,1 NO MODIFICATION, WRITE AS RECORD 3 F1D06440
PZE 12 OF FILE 5. F1D06450
REM F1D06460
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D06470
REM F1D06480
TSX TAP00,1 ASSEMBLE TABLE OF HOLLERITH ARGUMENTS. F1D06490
PZE 13 F1D06500
REM F1D06510
TSX WAT00,1 NO MODIFICATION, WRITE AS RECORD 4 F1D06520
PZE 13 OF FILE 5. F1D06530
REM F1D06540
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D06550
REM F1D06560
TSX TAP00,1 ASSEMBLY TABLE OF EFNS/IFNS - TEIFNO. F1D06570
PZE 0 F1D06580
LXD INTETA+1,4 LOAD TEIFNO WORD COUNT. F1D06590
TXL TEIFG,4,0 *NO TABLE, EXIT. F1D06600
PXA ,4 PLACE WORD COUNT IN AC. F1D06610
ADD INTETA ADD ORIGIN OF TEIFNO TABLE. F1D06620
STA TEIFA SET ADDRESSES IN SEARCH ROUTINE. F1D06630
STA TEIFC F1D06640
LXD GOOFCT,1 LOAD ERROR COUNT. F1D06650
STA EIFLOC INITIALIZE CELL FOR 1 DOUBLE PRIME. F1D06660
SXD EIFLOC,4 F1D06670
TEIFA CLA **,4 GET A TEIFNO ENTRY. F1D06680
TPL TEIFB *CHECK FOR DUPLICATE EFN. F1D06690
SLW* TEIFA SET ENTRY PLUS, MINUS IS FLAG SET BY F1D06700
TIX TEIFA,4,1 SECTION I, IS TABLE EXHAUSTED. F1D06710
TRA TEIFF YES, EXIT. F1D06720
REM F1D06730
TEIFB STA ERASA1 SAVE EFN. FROM ENTRY. F1D06740
TNX TEIFF,4,1 IS TABLE EXHAUSTED, NO BUMP TO GET NEXT. F1D06750
PXA ,4 NO, SHIFT CURRENT TEIFNO INCREMENT F1D06760
PAX ,2 (DECREMENT) TO IR2 FOR SCAN. F1D06770
TEIFC CLA **,2 GET SUCCEEDING TEIFNO ENTRY. F1D06780
TMI TEIFD IS THIS A SPECIAL ENTRY. F1D06790
ANA ADMSK NO, GET ADDRESS FIELD - EFN. F1D06800
LAS ERASA1 DO THESE TWO EFN MATCH. F1D06810
TRA *+2 NO. F1D06820
TRA TEIFE YES, WE HAVE FOUND AN ERROR. F1D06830
TEIFD TIX TEIFC,2,1 AT LEAST NOT YET, BUT LETS CONTINUE. F1D06840
TRA TEIFA IS ALL RIGHT ON THIS ENTRY, GET NEXT. F1D06850
REM F1D06860
TEIFE CLS* TEIFC SET THIS ENTRY MINUS SO THAT IT WILL BE F1D06870
STO* TEIFC IGNORED WHEN WE GET TO IT LATER. F1D06880
TXI *+1,1,1 INCREMENT ERROR LIST INDEX. F1D06890
STO ELSEBF,1 SAVE DUPLICATE EFN. F1D06900
CLA GOOFCT INCREMENT COUNT OF EFN DUPLICATES. F1D06910
ADD (1)L F1D06920
STA GOOFCT SAVE COUNT. F1D06930
TRA TEIFA CONTINUE SEARCH. F1D06940
REM F1D06950
TEIFF LXA GOOFCT,4 LOAD COUNT OF DUPLICATE EFNS. F1D06960
TXL TEIFG,4,0 *NONE, WRITE TABLE. F1D06970
PXA ,4 PLACE ERROR COUNT IN AC. F1D06980
TXI *+1,1,1 INCREMENT ERROR LIST INDEX FOR 1 DP. F1D06990
LXD GOOFCT,2 LOAD OLD ERROR INDEX. F1D07000
SXD GOOFCT,1 SAVE NEW ONE. F1D07010
ORA EIFSG ADD EFN ERROR FLAG. F1D07020
SLW ELSEBF,2 SAVE IN ERROR LIST. F1D07030
REM F1D07040
TEIFG TSX WAT00,1 WRITE TEIFNO TABLE AS RECORD 5 OF FILE 5. F1D07050
PZE 0 F1D07060
REM F1D07070
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D07080
REM F1D07090
REM ROUTINE TO REPLACE EFNS IN THE TIFGO TABLE WITH IFNS F1D07100
REM FROM THE TEIFNO TABLE. F1D07110
REM F1D07120
TSX TAP00,1 ASSEMBLE TABLE OF IFS AND GO TOS (TIFGO). F1D07130
PZE 2 F1D07140
REM F1D07150
REM THE MODIFICATION OF TIFGO, TRAD, TDO AND FRET F1D07160
REM REQUIRE THE EXISTENCE OF A TEIFNO TABLE. F1D07170
REM A CHECK IS THEREFORE MADE AT THIS POINT FOR F1D07180
REM THE NECESSITY OF A TEIFNO TABLE. F1D07190
REM F1D07200
CAL INTETH-3 LOAD FRET BUFFER WORD COUNT. F1D07240
ADD INTETC+1 ADD TIFGO TABLE WORD COUNT. F1D07250
ADD INTETH+1 ADD FRET DUMP WORD COUNT. F1D07260
ANA DCMSK GET ACCUMULATED COUNT. F1D07270
LXD EIFLOC,4 LOAD TEIFNO WORD COUNT. F1D07280
TZE NOTIF+1 *NO TABLES, NO NEED FOR TEIFNO. F1D07290
TXH *+2,4,0 IS THERE A TEIFNO TABLE. F1D07300
NOTIF TSX 1PER3,4 *NO, PROGRAMMER ERROR. F1D07310
SXA FEIFA,4 YES, SAVE WORD COUNT IN SEARCH ROUTINE. F1D07320
CLA EIFLOC GET LAST ADDRESS PLUS ONE OF TEIFNO F1D07330
STA FEIFB AND INITIALIZE TEIFNO SEARCH ROUTINE. F1D07340
STA FEIFC F1D07350
STA MTDOD INITIALIZE TDO TEST ROUTINE. F1D07360
STA MTDOE F1D07370
REM F1D07380
MTIF0 LXD INTETC+1,2 LOAD WORD COUNT OF TIFGO TABLE. F1D07390
PXA ,2 PLACE WORD COUNT IN AC. F1D07400
ADD INTETC COMPUTE LAST ADDRESS PLUS ONE OF TIFGO. F1D07410
STA TIFLOC INITIALIZE CELLS FOR 1 DOUBLE PRIME. F1D07420
SXD TIFLOC,2 F1D07430
TXL MTIFF,2,0 *NO TIFGO TABLE, SKIP THE REST OF THIS F1D07440
STA MTIFA INITIALIZATION JAZZ. F1D07450
STA MTIFG F1D07460
STA MTIFC F1D07470
STA MTIFH F1D07480
STA MTIFD F1D07490
STA MTIFI F1D07500
STA IFRTB F1D07510
REM F1D07520
REM F1D07530
REM ROUTINE TO REPLACE EFNS IN TIFGO BY IFNS FROM TEIFNO. F1D07540
REM F1D07550
MTIFA CLA **,2 GET FIRST WORD OF ENTRY. F1D07560
TMI MTIFB *MINUS TIFGO TYPE. F1D07570
PAX ,1 PLACE TYPE NUMBER IN INDEX REGISTER. F1D07580
TXL *+2,1,6 IS TYPE NUMBER GREATER THAN 6. F1D07590
AXT 7,1 YES, ONE DOUBLE PRIME WILL NOTE ERROR. F1D07600
XEC TIFTR,1 BRANCH ON TYPE NUMBER TO PROPER ENTRY. F1D07610
TSX 1PER4,4 TABLE EXHAUSTED, IMPOSSIBLE. F1D07620
REM F1D07630
TIX MTIFE,2,1 N = 7, NO MODIFICATION. F1D07640
TIX MTIFD,2,1 N = 6 F1D07650
TIX MTIFC,2,1 N = 5 F1D07660
TIX MTIFC,2,1 N = 4 F1D07670
TIX MTIFC,2,1 N = 3 F1D07680
TIX MTIFE,2,1 N = 2, NO MODIFICATION. F1D07690
TIX MTIFE,2,1 N = 1, NO MODIFICATION. F1D07700
TIFTR TIX MTIFD,2,1 N = 0 F1D07710
REM F1D07720
REM GENERAL PROCESSOR FOR TIFGO TABLE, FOUR ENTRY POINTS. F1D07730
REM F1D07740
MTIFB STA ERASA1 SAVE ADDRESS OF FIRST WORD OF ENTRY. F1D07750
TSX FEIFA,1 SEARCH TEIFNO FOR CORRESPONDING F1D07760
ARS 18 IFN AND INSERT IN PLACE OF EFN F1D07770
MTIFG STA **,2 IN TABLE. F1D07780
TNX 1PER4,2,1 *TABLE EXHAUSTED, IMPOSSIBLE. F1D07790
MTIFC CAL **,2 GET BETA1 (BETA2 IF MINUS TYPE) FROM F1D07800
ARS 18 DECREMENT FIELD OF SECOND WORD OF ENTRY. F1D07810
STA ERASA1 SAVE FOR TEIFNO SEARCH. F1D07820
TSX FEIFA,1 SEARCH TEIFNO. F1D07830
MTIFH STD **,2 REPLACE EFN WITH CORRESPONDING IFN. F1D07840
MTIFD CAL **,2 GET BETA2 (BETA3 IF MINUS TYPE) FROM F1D07850
STA ERASA1 ADDRESS FIELD OF SECOND WORD OF ENTRY. F1D07860
TSX FEIFA,1 SEARCH TEIFNO. F1D07870
ARS 18 SHIFT IFN INTO ADDRESS FIELD AND INSERT F1D07880
MTIFI STA **,2 INTO TIFGO IN PLACE OF EFN. F1D07890
REM F1D07900
MTIFE TIX MTIFA,2,1 *HAS ALL OF TIFGO BEEN PROCESSED, NO. F1D07910
REM F1D07920
MTIFF TSX WAT00,1 YES, WRITE MODIFIED TIFGO AS RECORD 6 F1D07930
PZE 2 OF FILE 5. F1D07940
REM F1D07950
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D07960
REM F1D07970
REM ROUTINE TO REPLACE EFNS IN TRAD WITH IFNS FROM TEIFNO. F1D07980
REM F1D07990
TSX TAP00,1 ASSEMBLE TRAD TABLE. F1D08000
PZE 3 F1D08010
REM F1D08020
LXD INTETD+1,2 LOAD TRAD WORD COUNT. F1D08030
TXL MTRDC,2,0 *EMPTY TABLE. F1D08040
PXA ,2 PLACE WORD COUNT IN AC. F1D08050
ADD INTETD ADD ORIGIN OF TABLE. F1D08060
STA TRDLOC INITIALIZE ADDRESSES. F1D08070
STA MTRDA F1D08080
STA MTRDB F1D08090
SXD TRDLOC,2 SAVE WORD COUNT FOR 1 DOUBLE PRIME. F1D08100
MTRDA CAL **,2 GET AN EFN FROM TRAD. F1D08110
STA ERASA1 SAVE FOR SEARCH ROUTINE. F1D08120
TSX FEIFA,1 SEARCH TEIFNO FOR CORRESPONDING IFN. F1D08130
ARS 18 MOVE IFN TO ADDRESS FIELD. F1D08140
MTRDB STA **,2 REPLACE EFN IN TRAD BY IFN. F1D08150
TIX MTRDA,2,1 *IS TRAD EXHAUSTED, NO CONTINUE. F1D08160
REM F1D08170
MTRDC TSX WAT00,1 WRITE TRAD AS RECORD 7 OF FILE 5. F1D08180
PZE 3 F1D08190
REM F1D08200
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D08210
REM F1D08220
REM ROUTINE TO REPLACE EFNS IN TDO WITH IFNS FROM TEIFNO. F1D08230
REM F1D08240
TSX TAP00,1 ASSEMBLE TDO TABLE. F1D08250
PZE 1 F1D08260
REM F1D08270
LXD INTETB+1,2 LOAD WORD COUNT OF TABLE. F1D08280
TXL MTDOH,2,0 *NO ENTRIES IN TDO, EXIT. F1D08290
PXA ,2 PLACE WORD COUNT IN AC. F1D08300
ADD INTETB ADD TABLE ORIGIN TO FORM LAST ADDRESS+1. F1D08310
STA MTDOA INITIALIZE F1D08320
STA MTDOB ADDRESSES IN F1D08330
STA MTDOF MODIFICATION ROUTINE. F1D08340
STA TDOLOC SET INFORMATION FOR SUCCEEDING RECORDS. F1D08350
SXD TDOLOC,2 F1D08360
REM F1D08370
MTDOA CLA **,2 GET FIRST WORD OF A TDO ENTRY. F1D08380
TPL MTDOC *NORMAL DO LOOP. F1D08390
MTDOB SLW **,2 MINUS SIGNIFIES A TDO ENTRY GENERATED BY F1D08400
TRA MTDOG I/O TRANSLATOR, SET PLUS AND CONTINUE. F1D08410
REM F1D08420
MTDOC STA ERASA1 SAVE BETA OF DO FOR TEIFNO SEARCH ROUTINE.F1D08430
TSX FEIFA,1 SEARCH FOR BETA IN TEIFNO. F1D08440
TXL NOTIF,4,0 *IS THERE A TEIFNO TABLE, NO. F1D08441
TZE MTDOF *NOT FOUND IN TEIFNO. F1D08450
TNX MTDOE+1,4,1 *NO MORE ENTRIES IN TEIFNO. F1D08460
MTDOD CAL **,4 GET NEXT TEIFNO ENTRY. F1D08470
ANA ADMSK GET EFN. F1D08480
SUB ERASA1 IS IT THE SAME AS BETA. F1D08490
TZE MTDOE *YES. F1D08500
TXI *+1,4,1 NO, BACK UP TEIFNO INDEX BY ONE. F1D08510
MTDOE CAL **,4 GET TEIFNO ENTRY (BETA). F1D08520
ARS 18 MOVE IFN TO ADDRESS FIELD. F1D08530
MTDOF STA **,2 REPLACE EFN IN TDO BY IFN FROM TEIFNO. F1D08540
REM F1D08550
MTDOG TIX MTDOA,2,5 *IS TDO EXHAUSTED, NO CONTINUE. F1D08560
REM F1D08570
MTDOH TSX WAT00,1 YES, WRITE MODIFIED TDO TABLE AS F1D08580
PZE 1 RECORD 8 OF FILE 5. F1D08590
REM F1D08600
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D08610
REM F1D08620
REM ROUTINE TO REPLACE EFNS IN FRET WITH IFNS FROM TEIFNO. F1D08630
REM THE TABLE IS ALSO SORTED ON THE IFNS AND THOSE F1D08640
REM FREQUENCIES REFERING TO COMPUTED GO TO S AND IF F1D08650
REM STATEMENTS ARE PERMUTED. F1D08660
REM F1D08670
REM F1D08680
TSX TAP00,1 ASSEMBLE FRET TABLE. F1D08690
PZE 7 F1D08700
REM F1D08710
LXD INTETH+1,2 LOAD FRET WORD COUNT. F1D08720
TXL WRFRT,2,0 *NO TABLE, EXIT. F1D08730
PXA ,2 SOME TABLE, PLACE WORD COUNT IN AC. F1D08740
ADD INTETH COMPUTE LAST ADDRESS PLUS ONE. F1D08750
SXD FRTLOC,2 SAVE WORD COUNT FOR 1 DOUBLE PRIME. F1D08760
STA FRTLOC SAVE LAST+1 FOR SAME. F1D08770
STA MFRTA INITIALIZE ADDRESSES IN FRET PROCESSOR. F1D08780
STA MFRTB .. F1D08790
STA SFRTA .. F1D08800
STA SFRTC .. F1D08810
STA SFRTE .. F1D08820
STA SFRTH .. F1D08830
STA SFRTI .. F1D08840
STA SFRTL .. F1D08850
STA IFRTD .. F1D08860
STA IFRTG .. F1D08870
STA IFRTL .. F1D08880
REM F1D08890
REM REPLACE EFNS IN FRET WITH IFNS FROM TEIFNO. F1D08900
REM F1D08910
MFRTA CLA **,2 GET AN ENTRY FROM FRET F1D08920
TPL MFRTC *NOT WORD CONTAINING EFN. F1D08930
STA ERASA1 SAVE EFN FOR TEIFNO SEARCH. F1D08940
TSX FEIFA,1 SEARCH TEIFNO FOR CORRESPONDING IFN. F1D08950
ARS 18 MOVE IFN TO ADDRESS FIELD. F1D08960
MFRTB STA **,2 REPLACE EFN WITH IFN. F1D08970
ANA ADMSK MASK OUT ALL BUT ADDRESS FIELD. F1D0897A
TNZ MFRTC *IS THERE AN IFN, YES. F1D0897B
CLA ERASA1 NO. RETRIEVE EFN. F1D0897C
ORA MFRTE ADD NON-EXIST FLAG. F1D0897D
LXD GOOFCT,4 LOAD ERROR LIST INDEX. F1D0897E
SLW ELSEBF,4 SAVE FOR DIAGNOSTIC. F1D0897F
TXI *+1,4,1 UPDATE ERROR LIST INDEX. F1D0897G
SXD GOOFCT,4 SAVE ERROR COUNT FOR DIAGNOSTIC. F1D0897H
PXD ,4 PLACE ERROR INDEX IN AC AND F1D0897I
ADD ADMSK ADD AN ADDRESS OF ALL ONES SO THAT F1D0897J
SSM ANY COMPARISONS WILL FAIL. F1D0897K
STO* MFRTA STORE DUMMY ENTRY IN FRET. F1D0897L
MFRTC TIX MFRTA,2,1 *ALL EFNS REPLACED, NO CONTINUE. F1D08980
REM F1D08990
REM SORT FRET ON THE IFNS. F1D09000
REM F1D09010
SFRTQ LXD FRTLOC,2 LOAD FRET WORD COUNT. F1D09020
SFRTA CLA **,2 GET A WORD FRET. F1D09030
TMI SFRTB *IS THIS FIRST WORD OF ENTRY, YES. F1D09040
TIX SFRTA,2,1 NO, GET NEXT WORD OF TABLE. F1D09050
TRA SFRTP TABLE EXHAUSTED. F1D09060
SFRTB SXA SFRTD,2 SAVE POSITION OF THIS ENTRY. F1D09070
TNX SFRTP,2,1 DECREMENT INDEX AND SEARCH FOR NEXT F1D09080
SFRTC LDQ **,2 ENTRY IN FRET. F1D09090
TQP *-2 *KEEP LOOKING FOR FIRST WORD OF NEXT ENTRY.F1D09100
TLQ SFRTA *NEXT ENTRY, IS 2ND ENTRY IFN LOWER F1D09110
REM THAN 1ST ENTRY IFN. NO, 2ND IS HIGHER. F1D09120
REM F1D09130
REM THE IFN OF ENTRY 1 IS HIGHER THAN THE IFN OF F1D09140
REM ENTRY 2, INTERCHANGE THE TWO ENTRIES. F1D09150
REM F1D09160
STQ STATN SAVE 2ND IFN FOR COMPARE. F1D09170
CAS STATN ARE THE TWO IFNS EQUAL. F1D09180
TRA SFRTD NO. F1D09190
TSX 1PER8,4 *YES, PROGRAMMER ERROR. F1D09200
SFRTD AXT **,1 LOAD POSITION OF ENTRY 1. F1D09210
AXT 0,4 INITIALIZE INDEX OF TEMPORARY BUFFER. F1D09220
TRA SFRTF STORE FIRST WORD OF ENTRY 1. F1D09230
SFRTE CLA **,1 GET NEXT WORD OF ENTRY 1. F1D09240
TMI SFRTG *IS THIS THE FIRST WORD OF ENTRY 2, YES. F1D09250
SFRTF STO LWBF2,4 NO, SAVE IN TEMPORARY BUFFER. F1D09260
TNX 1PER5X,1,1 *ERROR IF TABLE IS EXHAUSTED. F1D09270
TXI SFRTE,4,-1 UPDATE STORING INDEX AND GET NEXT WORD. F1D09280
REM F1D09290
SFRTG LXA SFRTD,1 LOAD POSITION VACATED BY ENTRY 1. F1D09300
XCA MOVE FIRST WORD OF 2ND ENTRY TO AC. F1D09310
TRA SFRTI STORE FIRST WORD OF ENTRY 2. F1D09320
SFRTH CLA **,2 GET NEXT WORD FROM TABLE. F1D09330
TMI SFRTJ *IS THIS THE FIRST WORD OF NEXT ENTRY, YES.F1D09340
SFRTI STO **,1 NO, MOVE TO SPACE VACATED BY ENTRY 1. F1D09350
TNX 1PER5X,1,1 *MACHINE ERROR IF WORD COUNT IS EXHAUSTED. F1D09360
TIX SFRTH,2,1 *END OF TABLE, NO CONTINUE MOVING WORDS. F1D09370
REM F1D09380
SFRTJ SXD SFRTM,4 SAVE TEMPORARY BUFFER INCREMENT. F1D09390
SXA SFRTN,1 SAVE POSITION OF NEW SECOND ENTRY. F1D09400
AXT 0,4 INITIALIZE TEMPORARY BUFFER INDEX. F1D09410
SFRTK CAL LWBF2,4 GET A WORD OF THE OLD ENTRY 1 AND STORE F1D09420
SFRTL SLW **,1 AS ENTRY 2 IN FRET TABLE. F1D09430
TXI *+1,1,-1 UPDATE STORING INDEX. F1D09440
TXI *+1,4,-1 UPDATE LOADING INDEX. F1D09450
SFRTM TXH SFRTK,4,** *HAVE ALL OWRDS BEEN MOVED FROM TEM, NO. F1D09460
SFRTN AXT **,2 YES, LOAD POSITION OF FIRST WORD OF NEW F1D09470
TRA SFRTA ENTRY 2 AND CONTINUE SORT FROM THERE. F1D09480
REM F1D09490
1PER5X TSX 1PER5,4 *MACHINE ERROR, TABLE CAN NOT BE EXHAUSTED.F1D09500
REM F1D09510
SFRTP LXD SFRTM,4 LOAD COUNT OF WORDS MOVED DURING SORT. F1D09520
ZSD SFRTM RESET OUT OF SORT FLAG. F1D09530
TXH SFRTQ,4,0 *WERE ANY ENTRIES OUT OF ORDER, YES. F1D09540
REM NO, FRET TABLE IS SORTED. F1D09550
REM F1D09560
REM NOW INVERT THOSE FREQUENCIES REFERING F1D09570
REM TO COMPUTED GO TOS AND ARITHMETIC IF F1D09580
REM STATEMENTS. F1D09590
REM F1D09600
IFRTA LXD TIFLOC,2 LOAD TIFGO WORD COUNT. F1D09610
TXL WRFRT,2,0 *TRANSFER IF NO TIFGO TABLE EXISTS. F1D09620
REM F1D09630
IFRTB CLA **,2 GET AN ENTRY FROM TIFGO. F1D09640
PDX ,4 SAVE IFN OF STATEMENT. F1D09650
TMI IFRTC *ARITHMETIC IF, TRANSFER. F1D09660
ANA ADMSK IS THIS A COMPUTED GO TO F1D09670
SUB (2)L F1D09680
TNZ IFRTM *NO, CONTINUE SCAN. F1D09690
IFRTC LXD FRTLOC,1 YES, LOAD FRET WORD COUNT. F1D09700
SXA ERASA1,4 SAVE IFN OF TIFGO STATEMENT. F1D09710
IFRTD CLS **,1 GET A WORD FROM FRET. F1D09720
TMI IFRTE *IS THIS FIRST WORD OF FRET, NO CONTINUE. F1D09730
SUB ERASA1 YES, DO IFNS FROM TIFGO AND FRET MATCH. F1D09740
TZE IFRTF *YES, INVERT THE FREQUENCIES. F1D09750
IFRTE TIX IFRTD,1,1 *IS FRET EXHAUSTED, NO CONTINUE SEARCH. F1D09760
TIX IFRTB,2,2 *YES. IS TIFGO EXHAUSTED, NO CONTINUE. F1D09770
TRA WRFRT *YES, JOB IS ALL DONE. F1D09780
REM F1D09790
IFRTF TNX 1PER5X,1,1 POSITION INDEX AT FIRST FREQUENCY OF F1D09800
SXA IFRTJ,1 THIS ENTRY AND SAVE POSITION. F1D09810
AXT 0,4 INITIALIZE TEMPORARY BUFFER INDEX. F1D09820
IFRTG CLA **,1 MOVE A FREQUENCY TO TEMPORARY BUFFER. F1D09830
TMI IFRTH *IS THIS THE BEGINNING OF THE NEXT ENTRY. F1D09840
TXI *+1,4,1 NO, UPDATE BUFFER INDEX (COUNTER). F1D09850
STO LWBF2,4 STORE FREQUENCY IN TEMPORARY BUFFER. F1D09860
TIX IFRTG,1,1 *IS FRET EXHAUSTED, NO CONTINUE. F1D09870
IFRTH TXH *+2,4,0 YES, IS THERE AT LEAST ONE FREQUENCY. F1D09880
TSX 1PER6,4 *NO, EITHER PROGRAMMER OR MACHINE GOOFED. F1D09890
IFRTJ AXT **,1 RELOAD POSITION OF THIS FREQUENCY ENTRY. F1D09900
IFRTK CAL LWBF2,4 MOVE THE ENTRY FROM THE TEMPORARY BUFFER F1D09910
IFRTL SLW **,1 BACK INTO THE FRET TABLE INVERTED. F1D09920
TXI *+1,1,-1 UPDAT FRET INDEX. F1D09930
TIX IFRTK,4,1 *HAVE ALL WORDS BEEN MOVED, NO CONTINUE. F1D09940
REM F1D09950
IFRTM TIX IFRTB,2,2 *IS TIFGO EXHAUSTED, NO CONTINUE. F1D09960
REM F1D09970
WRFRT SYN * FRET TABLE HAS BEEN PROCESSED. F1D09980
REM F1D09990
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D10000
REM F1D10010
REM ROUTINE TO MODIFY THE FORVAL TABLE. F1D10020
REM F1D10030
TSX TAP00,1 ASSEMBLE THE FORVAL TABLE (TABLE OF F1D10040
PZE 6 NON- SUBSCRIPTED FIXED POINT VARIABLES F1D10050
REM ON THE LEFT OF EQUALS SIGN). F1D10060
REM F1D10070
LXD INTETG+1,2 LOAD FORVAL WORD COUNT. F1D10080
TXL MFVLG,2,0 *NO TABLE, NO POSSIBLE MODIFICATION. F1D10090
REM F1D10100
TSX TAP00,1 FORVAL EXISTS, ASSEMBLE CALLFN TABLE. F1D10110
PZE 16 F1D10120
REM F1D10130
LXD INTETQ+1,4 LOAD CALLFN WORD COUNT. F1D10140
TXL MFVLG,4,0 *NO CALLFN, THEREFORE NO MODIFICATION F1D10150
REM TO FORVAL. F1D10160
REM F1D10170
REM THERE ARE ENTRIES IN BOTH FORVAL AND CALL F1D10180
REM NUMBER (CALLFN) TABLES. THEREFORE, THERE F1D10190
REM MAY BE SOME IFN IN FORVAL WHICH MUST BE F1D10200
REM REPLACED WITH THE LAST IFN RELATED TO A CALL F1D10210
REM STATEMENT. CALLFN CONTAINS THE FIRST AND F1D10220
REM LAST IFNS OF CALL STATEMENTS. THE ROUTINE TO F1D10230
REM SEARCH AND REPLACE IS BASED UPON THE TWO TABLESF1D10240
REM BEING ORDERED BY MAGNITUDE OF INTERNAL FORMULA F1D10250
REM NUMBERS (IFNS). THE TWO TABLES ARE BUILT BY F1D10260
REM MAGNITUEDE OF IFNS IN SECTION ONE DURING F1D10270
REM PROCESSING. THIS PERMITS A SINGLE PASS F1D10280
REM OVER BOTH TABLES. F1D10290
REM F1D10300
PXA ,2 PLACE FORVAL WORD COUNT IN AC. F1D10310
ADD INTETG COMPUTE LAST ADDRESS PLUS ONE. F1D10320
STA MFVLC INITIALIZE ADDRESSES. F1D10330
STA MFVLE F1D10340
PXA ,4 PLACE CALLFN WORD COUNT IN AC. F1D10350
ADD INTETQ COMPUTE LAST ADDRESS PLUS ONE. F1D10360
STA MFVLA INITIALIZE ADDRESSES. F1D10370
STA MFVLD F1D10380
REM F1D10390
MFVLA CLA **,4 GET AN ENTRY FROM CALLFN. F1D10400
PAX ,1 MOVE FIRST IFN TO DECREMENT FIELD OF AC. F1D10410
MFVLB PXD ,1 RE-ENTRY FOR ANOTHER LOOK AT FORVAL. F1D10420
MFVLC LAS **,2 COMPARE IFN FROM CALLFN TO FORVAL IFN. F1D10430
TRA MFVLF *CALLFN IFN GREATER THAN FORVAL IFN. F1D10440
TRA MFVLD *CALLFN AND FORVAL IFNS EQUAL. F1D10450
TIX MFVLA,4,1 CALLFN IFN LESS THAN FORVAL IFN. GET NEXTF1D10460
TRA MFVLG IFN FROM CALLFN, IF EXHAUSTED, ALL DONE. F1D10470
REM F1D10480
MFVLD CAL **,4 GET ENTRY FROM CALLFN TABLE AND REPLACE F1D10490
MFVLE STD **,2 IFN IN FORVAL BY LAST IFN FROM CALLFN. F1D10500
MFVLF TIX MFVLB,2,2 *IS FORVAL EXHAUSTED, NO CONTINUE. F1D10510
REM F1D10520
MFVLG TSX WAT00,1 WRITE FORVAL AS RECORD 9 OF FILE 5. F1D10530
PZE 6 F1D10540
REM F1D10550
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D10560
REM F1D10570
TSX TAP00,1 ASSEMBLE TABLE OF NON-SUBSCRIPTED FIXED F1D10580
PZE 5 POINT VARIABLES ON RIGHT OF EQUALS SIGN F1D10590
REM (FORVAR TABLE) F1D10600
REM F1D10610
TSX WAT00,1 WRITE FORVAR AS RECORD 10 OF FILE 5. F1D10620
PZE 5 F1D10630
REM F1D10640
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D10650
REM F1D10660
TSX TAP00,1 ASSEMBLE TABLE OF TAU USAGES (FORTAG). F1D10670
PZE 4 F1D10680
REM F1D10690
TSX WAT00,1 WRITE FORTAG AS RECORD 11 OF FILE 5. F1D10700
PZE 4 F1D10710
REM F1D10720
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D10730
REM F1D10740
TSX WAT00,1 WRITE FRET AS RECORD 12 OF FILE 5. F1D10750
PZE 7 F1D10760
REM F1D10770
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D10780
REM F1D10790
TSX TAP00,1 ASSEMBLE TABLE OF EQIVALENCE STATEMENTS F1D10800
PZE 8 (EQIT) FROM TAPE AND CORES. F1D10810
REM F1D10820
LXD INTETI+1,3 LOAD WORD COUNT OF EQUIT TABLE. F1D10830
TXL CLEQF1,2,0 *NO TABLE, EXIT. F1D10840
REM F1D10850
REM THERE IS SOME EQUIT TABLE PRESENT, SO PROCESS IT... F1D10860
REM INITIALIZATION F1D10870
MEQUIT LAC L(FEQ),4 SET ERROR COUNT. F1D10880
PXA ,2 COMPUTE LAST ADDRESS PLUS ONE. F1D10890
ADD L(FEQ) LOCATION OF FINAL EQUIT TABLE. F1D10900
STA *+1 F1D10910
STZ **,2 F1D10920
TIX *-1,2,1 F1D10930
PXA ,1 PLACE WORD COUNT IN AC. F1D10940
ADD L(OEQ) COMPUTE LAST ADDRESS PLUS ONE. F1D10950
PAC ,1 GET 2S COMPLIMENT OF END OF TABLE. F1D10960
SXD CLEQA0,1 INITIALIZE END TESTS. F1D10970
SXD CLEQB2+1,1 F1D10980
LXD XCOUNT,2 GET COPY COUNT OF FIRST SYMBOL FIRST SENTENCE F1D10990
LXD OCOUNT,1 F1D11000
REM (LOC OF LAST SUBSCRIPT COPIED IN ORDER FROM OEQ)F1D11010
OCOUNT TXI CLEQA0+1,,-LWBF1 F1D11020
REM F1D11030
REM FIND NEXT SENTENCE IN OEQ TO BE COPIED IN ORDER F1D11040
CLEQA0 TXL CLEQF0,1,** WAS FINAL SENTENCE IN OEQ PROCESSED F1D11050
CLA OEQ,1 NO, HAS SENTENCE IN OEQ BEEN COPIED OUT OF ORDERF1D11060
TNZ CLEQA1+1 NO, SKIP TO COPY SENTENCE F1D11070
TXI *+1,1,-1 YES, BUMP OEQ COUNT TO NEXT SUBSCRIPT F1D11080
CLA OEQ,1 F1D11090
TMI *+2 IS THIS FINAL SUBSCRIPT IN SENTENCE F1D11100
TXI *-2,1,-2 NO, BUMP OEQ COUNT TO NEXT SUBSCRIPT THIS SET F1D11110
TXI CLEQA0,1,-1 YES, BUMP OEQ COUNT TO FIRST SYMBOL NEXT SET F1D11120
REM F1D11130
REM COPY ONE EQUIVALENCE SENTENCE FROM OEQ TO FEQ F1D11140
CLEQA1 CLA OEQ,1 MOVE NEXT SYMBOL FROM OEQ F1D11150
STO FEQ,2 TO FEQ F1D11160
TXI *+1,1,-1 BUMP COUNTS TO NEXT SUBSCRIPT F1D11170
TXI *+1,2,-1 F1D11180
CLA OEQ,1 GET NEXT SUBSCRIPT F1D11190
STA FEQ,2 COPY SUBSCRIPT IN FEQ F1D11200
TMI *+3 IS THIS FINAL SUBSCRIPT IN SENTENCE F1D11210
TXI *+1,1,-1 NO, BUMP COUNTS TO NEXT SYMBOL F1D11220
TXI CLEQA1,2,-1 AND GO COPY NEXT SYMBOL F1D11230
REM F1D11240
REM SCAN FEQ AND OEQ FOR SYMBOLS MATCHING ANY SYMBOL IN THIS SET F1D11250
SXD OCOUNT,1 SAVE COUNT OF LAST SUBSCRIPT COPIED IN ORDER F1D11260
SXD XCOUNT,2 FROM OEQ TO FEQ F1D11270
LXD YCOUNT,2 GET FIXED COUNT OF NEXT SYMBOL IN FEQ F1D11280
REM F1D11290
REM ONE SENTENCE HAS BEEN COPIED IN ORDER FROM OEQ TO FEQ. F1D11300
REM NOW THIS SENTENCE MUST BE SCANNED TO SEE IF ANY SYMBOLS ARE F1D11310
REM REPEATED WITHIN THIS SENTENCE. IF ANY SUCH SYMBOLS ARE F1D11320
REM REPEATED, THEY ARE EXAMINED FOR REDUNDANCY OR INCONSISTENCY. F1D11330
REM IN CASE OF REDUNDANCY, THE REDUNDANT SYMBOL IS ERASED. F1D11340
REM IN CASE OF INCONSISTENCY, AN ERROR SITUATION IS CREATED. F1D11350
REM AFTER SCANNING WITHIN THE SENTENCE FOR REDUNDANCIES OR F1D11360
REM INCONSISTENCIES, THE REMAINING SENTENCES IN OEQ WHICH HAVE F1D11370
REM NOT YET BEEN COPIED ARE SCANNED TO SEE IF ANY MATCHING SYMBOLF1D11380
REM EXISTS. IF NO SYMBOL IS FOUND IN THE REMAINDER OF OEQ WHICH F1D11390
REM MATCHES THE SYMBOL SCANNED FOR, REENTRY IS MADE AT THIS POINTF1D11400
REM TO SCAN WITHIN THE SENTENCE AND THEN THE REST OF OEQ FOR THE F1D11410
REM NEXT SYMBOL. F1D11420
REM F1D11430
CLEQA2 LXD YCOUNT,1 GET FLOATING COUNT IN FEQ F1D11440
TXI *+1,1,-2 BUMP FLOATING COUNT TO NEXT SYMBOL F1D11450
REM F1D11460
REM LATER, ADDITIONS TO THIS SENTENCE MAY BE COPIED. IN THIS CASEF1D11470
REM REENTRY IS MADE AT THIS POINT TO SCAN WITHIN THOSE PORTIONS F1D11480
REM OF THE ADDED SENTENCE FOR REDUNDANCY OR INCONSISTENCY. F1D11490
REM F1D11500
CLEQA3 CLA XCOUNT SET END OF SENTENCE TESTS TO COUNT OF LAST F1D11510
STD CLEQA4 SUBSCRIPT COPIED INTO FEQ F1D11520
STD *+1 F1D11530
TXL CLEQB1,1,** IS THIS LAST FLOATING SYMBOL IN FEQ F1D11540
CLA FEQ,1 NO, GET FLOATING SYMBOL F1D11550
CAS FEQ,2 IS THIS SYMBOL IDENTICAL TO FIXED SYMBOL F1D11560
TXI *-3,1,-2 NO, BUMP FLOATING COUNT TO NEXT SYMBOL F1D11570
TXI *+2,1,-1 YES, BUMP FLOATING COUNT TO ITS SUBSCRIPT F1D11580
TXI *-5,1,-2 NO, BUMP FLOATING COUNT TO NEXT SYMBOL F1D11590
REM F1D11600
REM MATCHING SYMBOL FOUND F1D11610
TXI *+1,2,-1 BUMP FIXED COUNT TO SUBSCRIPT F1D11620
SXD E4,1 SAVE FLOATING COUNT OF SUBSCRIPTS OF MATCHING F1D11630
REM SYMBOL F1D11640
CLA FEQ,1 GET FLOATING SUBSCRIPT F1D11650
SUB FEQ,2 F1D11660
TXI *+1,1,1 BUMP COUNTS BACK TO MATCHING SYMBOL F1D11670
TXI *+1,2,1 F1D11680
TNZ CLEQA5 ARE SUBSCRIPTS IDENTICAL F1D11690
REM F1D11700
REM REDUNDANCY F1D11710
CLA FEQ+2,1 YES, ERASE REDUNDANT SYMBOL F1D11720
STO FEQ,1 AND MOVE ALL FOLLOWING WORDS UP TWO F1D11730
TXI *+1,1,-1 BUMP COPY COUNT TO NEXT WORD F1D11740
CLEQA4 TXH *-3,1,** IS THIS LAST WORD IN FEQ F1D11750
TXI *+1,1,2 YES, BUMP END COUNT BACK TWO WORDS F1D11760
SXD XCOUNT,1 AND SAVE NEW COPY COUNT OF END OF SENTENCE F1D11770
LXD E4,1 RESUME SCAN WITH SAME FIXED SYMBOL F1D11780
TXI CLEQA3,1,1 BUT WITH FLOATING SYMBOL WHICH REPLACED F1D11790
REM REDUNDANT SYMBOL F1D11800
REM F1D11810
REM INCONSISTENCY F1D11820
CLEQA5 CLA FRCON REPLACE FIRST WORD IN FEQ WITH WORD OF ALL F1D11830
STO* L(FEQ) SET ERROR FLAG. F1D11840
REM ERROR EXISTS. F1D11850
CLA FEQ,2 MOVE SYMBOL F1D11860
STO FEQ+1,4 TO ERROR LIST F1D11870
TXI CLEQB4,4,-1 BUMP ERROR COUNT AND GO CHECK FOR END OF SET F1D11880
REM F1D11890
REM SEARCH REMAINDER OF OEQ FOR SYMBOLS MATCHING ANY SYMBOL IN F1D11900
REM THIS SENTENCE. IF FOUND, COPY SENTENCE OUT OF ORDER FROM OEQ F1D11910
REM AND ADD IT TO THE SENTENCE NOW BEING SCANNED IN FEQ. THEN F1D11920
REM NORMALIZE THE SUBSCRIPTS, AND CONTINUE SCANNING. F1D11930
REM F1D11940
CLEQB1 LXD OCOUNT,1 START SEARCH WITH FIRST SYMBOL FOLLOWING F1D11950
REM SENTENCE LAST COPIED IN ORDER FROM OEQ F1D11960
CLS WCOUNT IS THIS A SCAN SUBSEQUENT TO COPYING A SENTENCE F1D11970
REM OUT OF ORDER F1D11980
TMI CLEQB2 NO, SKIP TO START SEARCH WITH NO CHANGE TO F1D11990
REM COUNT OF FLOATING SYMBOL F1D12000
LXD QCOUNT,1 YES, START SEARCH WITH FLOATING SYMBOL FOLLOWINGF1D12010
REM SENTENCE COPIED OUT OF ORDER FROM OEQ F1D12020
STO WCOUNT RESET SWITCH F1D12030
REM F1D12040
REM FIND NEXT SENTENCE IN OEQ THAT IS NOT YET COPIED OUT OF ORDERF1D12050
CLEQB2 TXI *+1,1,-1 BUMP COUNT TO SYMBOL F1D12060
TXL CLEQB4,1,** WAS THAT FINAL SENTENCE IN OEQ F1D12070
SXD PCOUNT,1 NO, SAVE COUNT OF FIRST SYMBOL NEXT SENTENCE F1D12080
REM WHICH MAY BE COPIED OUT OF ORDER FROM OEQ F1D12090
CLA OEQ,1 HAS THIS SENTENCE BEEN COPIED OUT OF ORDER F1D12100
TNZ CLEQB3+1 NO, SKIP TO CHECK SENTENCE F1D12110
TXI *+1,1,-1 YES, BUMP OEQ COUNT TO NEXT SUBSCRIPT F1D12120
CLA OEQ,1 F1D12130
TMI CLEQB2 IS THIS FINAL SUBSCRIPT IN SENTENCE F1D12140
TXI *-2,1,-2 NO, BUMP OEQ COUNT TO NEXT SUBSCRIPT F1D12150
REM F1D12160
REM SCAN THIS SENTENCE FOR ANY SYMBOL MATCHING FIXED SYMBOL F1D12170
CLEQB3 CLA OEQ,1 GET FLOATING SYMBOL IN OEQ F1D12180
SUB FEQ,2 IS OEQ SYMBOL IDENTICAL TO FEQ SYMBOL F1D12190
TZE CLEQC0 YES, GO ADD SENTENCE IN WHICH THIS SYMBOL F1D12200
REM APPEARS TO SENTENCE ALREADY COPIED IN FEQ F1D12210
TXI *+1,1,-1 NO, BUMP OEQ COUNT TO NEXT SUBSCRIPT F1D12220
CLA OEQ,1 GET NEXT SUBSCRIPT F1D12230
TMI CLEQB2 IS THIS FINAL SUBSCRIPT IN SENTENCE F1D12240
TXI CLEQB3,1,-1 NO, GO CHECK NEXT SYMBOL IN OEQ F1D12250
REM F1D12260
REM THIS FIXED SYMBOL WAS NOT MATCHED IN THE REMAINDER OF OEQ F1D12270
REM OR AN INCONSISTENT MATCH WAS FOUND WITHIN THE FEQ SENTENCE F1D12280
CLEQB4 TXI *+1,2,-2 BUMP FIXED COUNT TO NEXT SYMBOL IN FEQ F1D12290
SXD YCOUNT,2 SAVE SCAN COUNT OF NEW FIXED SYMBOL F1D12300
REM WAS THIS END OF SENTENCE IN FEQ BEING SEARCHED F1D12310
XCOUNT TXH CLEQA2,2,-LWBF2 F1D12320
REM (LOC OF LAST SUBSCRIPT COPIED INTO FEQ) F1D12330
REM F1D12340
REM NO MATCHING SYMBOL FOUND IN REMAINDER OF OEQ TABLE F1D12350
LXD XCOUNT,2 YES, GET COUNT OF LAST SUBSCRIPT COPIED INTO FEQF1D12360
CLS FEQ,2 SET END OF SENTENCE MARKER IN LAST SUBSCRIPT F1D12370
STO FEQ,2 COPIED INTO FEQ F1D12380
TXI *+1,2,-1 BUMP FEQ COUNT TO FIRST SYMBOL OF NEXT SENTENCE F1D12390
SXD YCOUNT,2 SET BEGINNING OF SCAN TO COUNT OF FIRST SYMBOL F1D12400
REM NEXT SENTENCE F1D12410
SXD ZCOUNT,2 SET BEGINNING OF NORMALIZATION COUNT TO FIRST F1D12420
REM SYMBOL NEXT SENTENCE F1D12430
LXD OCOUNT,1 GET COUNT OF LAST SUBSCRIPT COPIED IN ORDER FROMF1D12440
TXI CLEQA0,1,-1 FEQ, BUMP TO NEXT SYMBOL, AND GO COPY SENTENCE F1D12450
REM F1D12460
REM OEQ SYMBOL FOUND MATCHING SYMBOL IN LAST SENTENCE COPIED F1D12470
REM F1D12480
CLEQC0 SXD CLEQC3,1 SET END OF COPY LOOP TO OEQ COUNT OF MATCHING F1D12490
REM SYMBOL F1D12500
SXD YCOUNT,2 SET RESUMPTION OF SCAN TO MATCHING SYMBOL F1D12510
TXI *+1,1,-1 BUMP COUNTS TO SUBSCRIPT OF MATCHING SYMBOL F1D12520
TXI *+1,2,-1 F1D12530
CLA FEQ,2 F1D12540
SBM OEQ,1 F1D12550
STO E4 COMPUTE DIFFERENCE BETWEEN SUBSCRIPTS AND SAVE F1D12560
LXD XCOUNT,2 GET COUNT OF LAST SUBSCRIPT COPIED INTO FEQ F1D12570
SXD WCOUNT,2 SET RESUMPTION OF SCAN TO FIRST SYMBOL COPIED F1D12580
REM OUT OF ORDER INTO FEQ F1D12590
SXD CLEQD4,2 SET END OF NORMALIZATION LOOP FOR PRECEEDING F1D12600
REM SENTENCE TO SUBSCRIPT PRECEDING MATCHING SYMBOL F1D12610
REM F1D12620
REM COPY OUT OF ORDER THAT PORTION OF SENTENCE IN OEQ IN WHICH F1D12630
REM MATCHED SYMBOL APPEARS FROM SYMBOL FOLLOWING MATCHED SYMBOL F1D12640
REM TO END OF SENTENCE AND ADD IT TO SENTENCE IN FEQ CURRENTLY F1D12650
REM BEING SCANNED. F1D12660
REM F1D12670
CLA OEQ,1 GET SUBSCRIPT OF MATCHING SYMBOL IN OEQ F1D12680
TMI CLEQC2 IS THIS FINAL SUBSCRIPT IN SENTENCE F1D12690
CLEQC1 TXI *+1,1,-1 NO, COPY REMAINDER OF SENTENCE INTO FEQ F1D12700
TXI *+1,2,-1 BUMP COUNTS TO NEXT SYMBOL F1D12710
CLA OEQ,1 MOVE SYMBOL FROM OEQ F1D12720
STO FEQ,2 TO FEQ F1D12730
TXI *+1,1,-1 BUMP COUNTS TO NEXT SUBSCRIPT F1D12740
TXI *+1,2,-1 F1D12750
CLA OEQ,1 MOVE SUBSCRIPT FROM OEQ F1D12760
STA FEQ,2 TO FEQ F1D12770
TPL CLEQC1 IS THIS FINAL SUBSCRIPT IN SENTENCE F1D12780
REM F1D12790
REM SENTENCE IN OEQ IN WHICH MATCHING SYMBOL APPEARED HAS BEEN F1D12800
REM ADDED TO SENTENCE IN FEQ FROM SYMBOL FOLLOWING MATCHING F1D12810
REM SUBSCRIPT TO END. NOW ADD REMAINDER OF SENTENCE, FROM F1D12820
REM BEGINNING TO SUBSCRIPT PRECEDING MATCHING SYMBOL. MATCHING F1D12830
REM SYMBOL IS NOT COPIED. F1D12840
REM F1D12850
CLEQC2 SXD QCOUNT,1 SET RESUMPTION OF SCAN COUNT TO FINAL SUBSCRIPT F1D12860
REM IN SENTENCE COPIED OUT OF ORDER FROM OEQ F1D12870
LXD PCOUNT,1 SET BEGINNING OF OUT-OF-ORDER COPY LOOP COUNT F1D12880
REM TO FIRST SYMBOL THIS SENTENCE F1D12890
CLEQC3 TXL CLEQC4,1,** IS THIS MATCHED SYMBOL F1D12900
TXI *+1,2,-1 NO, BUMP FEQ COUNT TO NEXT WORD F1D12910
CLA OEQ,1 MOVE WORD FROM OEQ F1D12920
STO FEQ,2 TO FEQ F1D12930
TXI CLEQC3,1,-1 BUMP OEQ COUNT TO NEXT WORD AND GO CHECK COUNT F1D12940
CLEQC4 SXD XCOUNT,2 SAVE COUNT OF LAST SUBSCRIPT COPIED INTO FEQ F1D12950
LXD PCOUNT,1 SET INDICATOR THAT THIS SENTENCE HAS BEEN COPIEDF1D12960
STZ OEQ,1 OUT OF ORDER F1D12970
REM F1D12980
REM NORMALIZATION OF SUBSCRIPTS IN SENTENCE AND ITS ADDITIONS F1D12990
REM IF SUBSCRIPT IN OEQ WAS LARGER THAN THAT IN FEQ F1D13000
REM NORMALIZE THE SUBSCRIPTS BY ADDING THE DIFFERENCE TO THE F1D13010
REM WORDS ORIGINALLY IN FEQ, IE, FROM THE BEGINNING TO THE F1D13020
REM LAST SUBSCRIPT BEFORE THE PORTION FROM OEQ WAS ADDED. F1D13030
REM IF SUBSCRIPT IN FEQ WAS LARGER THAN THAT IN OEQ F1D13040
REM ADD THE DIFFERENCE TO THE WORDS IN THE ADDED PORTION OF F1D13050
REM THE SENTENCE JUST WRITTEN IN FEQ F1D13060
REM F1D13070
CLA E4 GET DIFFERENCE BETWEEN SUBSCRIPTS F1D13080
TZE CLEQD5 IF ZERO, NO NORMALIZATION IS NECESSARY F1D13090
TMI CLEQD3 IF MINUS, SUBSCRIPT IN OEQ WAS GREATER THAN FEQ F1D13100
REM F1D13110
REM FEQ SUBSCRIPT GREATER THAN OEQ SUBSCRIPT F1D13120
LXD CLEQD4,2 START NORMALIZATION FIRST SS IN ADDED PORTION F1D13130
CLA XCOUNT END NORMALIZATION LAST SS ADDED PORTION F1D13140
STD CLEQD4 F1D13150
TXI CLEQD3+2,2,-2 F1D13160
REM F1D13170
REM OEQ SUBSCRIPT GREATER THAN FEQ SUBSCRIPT F1D13180
CLEQD3 LXD ZCOUNT,2 START NORMALIZATION FIRST SS ORIGINAL PORTION F1D13190
TXI *+1,2,-1 F1D13200
CLA FEQ,2 GET SUBSCRIPT F1D13210
ADM E4 NORMALIZE TO SAME SCALE AS IN OTHER F1D13220
STA FEQ,2 PORTION OF SENTENCE F1D13230
CLEQD4 TXL CLEQD5,2,** WAS THIS LAST SUBSCRIPT TO BE NORMALIZED F1D13240
TXI *-4,2,-2 NO, BUMP FEQ COUNT TO NEXT SUBSCRIPT F1D13250
CLEQD5 LXD YCOUNT,2 YES, RESUME SCAN WITH SAME FIXED SYMBOL IN FEQ F1D13260
LXD WCOUNT,1 BUT WITH FLOATING COUNT, FIRST SYMBOL JUST F1D13270
CLS WCOUNT COPIED OUT OF ORDER INTO FEQ F1D13280
STO WCOUNT SET SWITCH TO SKIP OVER PORTION OF OEQ PRECEDINGF1D13290
TXI CLEQA3,1,-1 SENTENCE JUST COPIED OUT OF ORDER F1D13300
REM F1D13310
REM TABLE IS NOW COMPLETELY PROCESSED. WE CAN NOW GO HOME. F1D13320
CLEQF0 TXH *+3,4,-LWBF2-1 WERE THERE ANY ERRORS. F1D13330
CLA FRCON YES, ADD WORD OF ALL ONES F1D13340
STO FEQ+1,4 TO END OF ERROR LIST F1D13350
PXD ,2 COMPUTE NUMBER OF WORDS IN FEQ. F1D13360
PDC ,2 GET TRUE LAST ADDRESS PLUS ONE. F1D13370
TIX *+1,2,LWBF2 COMPUTE WORD COUNT OF SORTED EQUIT TABLE. F1D13380
CLEQF1 CLA L(FEQ) UPDATE INTET ORIGIN OF EQUIT TABLE. F1D13390
STA INTETI F1D13400
PXD ,2 F1D13410
STO INTETI+1 SAVE WORD COUNT IN INTETI ENTRY. F1D13420
AXT 1,4 LOAD INDEX FOR INDIRECT ADDRESSING. F1D13430
STO* INTETI SAVE WORD COUNT AHEAD OF TABLE. F1D13440
SXD EQTLOC,2 SAVE EQUIT WORD COUNT FOR ONE DOUBLE PRIMEF1D13450
PXA ,2 COMPUTE LAST ADDRESS PLUS ONE. F1D13460
ADD L(FEQ) F1D13470
STA EQTLOC SAVE LAST ADDRESS PLUS ONE . F1D13480
REM F1D13490
REM F1D13500
TSX WAT00,1 *WRITE OUT EQUIT TABLE ASSEMBLED IN FEQ ON TAPE F1D13510
PZE 8 AS RECORD 13 OF FILE 5. F1D13520
REM F1D13530
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D13540
REM F1D13550
NZT INTETJ+1 IS THERE A CLOSUB TABLE. F1D13560
TRA WRCLS *NO, DO NOT ATTEMPT TO READ IT BACK. F1D13570
REM F1D13580
TSX (TAPE),4 READ CLOSUB FROM SCRATCH TAPE. F1D13590
PZE CLSIO,,(RBNC) F1D13600
PZE TCLOS,,EXEQTP F1D13610
REM F1D13620
WRCLS TSX WAT00,1 WRITE CLOSUB AS RECORD 14 OF FILE 5. F1D13630
PZE 9 F1D13640
TSX (TAPE),4 REWIND SCRATCH TAPE. F1D13650
PZE REWND,,(SKBP) F1D13660
PZE ,,EXEQTP F1D13670
REM F1D13680
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D13690
REM F1D13700
AXT 0,4 INITIALIZE IR4 FOR INDIRECT ADDRESSING. F1D13710
STZ* INTETP SET FIRST LOCATION OF TSTOPS TO ZERO. F1D13720
REM F1D13730
TSX TAP00,1 ASSEMBLE TABLE OF STOP AND RETURN F1D13740
PZE 15 STATEMENTS (TSTOPS). F1D13750
REM F1D13760
LXD INTETP+1,1 LOAD WORD COUNT OF TSTOPS. F1D13770
PXA ,1 PLACE WORD COUNT IN AC. F1D13780
ADD INTETP COMPUTE LAST ADDRESS PLUS ONE. F1D13790
STA STPLOC SAVE LAST ADDRESS PLUS ONE AND F1D13800
SXD STPLOC,1 WORD COUNT FOR SECTION ONE DOUBLE PRIME. F1D13810
REM F1D13820
STZ* INTETO SET FIRST WORD OF NONEXC TO ZERO. F1D13830
REM F1D13840
TSX TAP00,1 ASSEMBLE TABLE OF NON-EXECUTABLE F1D13850
PZE 14 STATEMENTS (NONEXC). F1D13860
REM F1D13870
LXD INTETO+1,1 LOAD NONEXC WORD COUNT. F1D13880
PXA ,1 PLACE WORD COUNT IN AC. F1D13890
ADD INTETO COMPUTE LAST ADDRESS PLUS ONE. F1D13900
STA NXCLOC SAVE LAST ADDRESS PLUS ONE AND F1D13910
SXD NXCLOC,1 WORD COUNT FOR SECTION ONE DOUBLE PRIME. F1D13920
REM F1D13930
TSX (TAPE),4 WRITE 5TH END-OF-FILE ON TABLE TAPE. F1D13940
PZE ,,(WEFP) F1D13950
PZE 5THEOF,,TABTAP F1D13960
REM F1D13970
LXD EIFNO,4 LOAD LAST IFN ASSIGNED. F1D13980
TXI *+1,4,1 INCREMENT BY ONE. F1D13990
PXD ,4 F1D14000
STO EIFNO SAVE FOR ONE DOUBLE PRIME FLOW ANALYSIS. F1D14010
TSX (LOAD),4 GO GET ONE DOUBLE PRIME. F1D14020
PZE F1D14030
REM F1D14040
REM F1D14050
REM *************************************************************F1D14060
REM F1D14070
REM ROUTINE TO SEARCH TEIFNO FOR AN IFN THAT CORRESPONDS F1D14080
REM TO AN EFN STORED IN LOCATION ERASA1. WHEN A MATCH IS F1D14090
REM FOUND, IT RETURNS TO THE CALLER WITH THE TEIFNO ENTRY F1D14100
REM IN THE AC. IF NO MATCH IS FOUND, IT RETURNS WITH A F1D14110
REM ZERO AC. ZERO IS AN IMPOSSIBLE IFN, AND THEREFORE, F1D14120
REM IS AN ERROR SIGNAL. F1D14130
REM F1D14140
FEIFA AXT **,4 LOAD TEIFNO WORD COUNT. F1D14150
FEIFB CAL **,4 GET A TEIFNO ENTRY. F1D14160
ANA ADMSK GET ADDRESS FIELD, EFN. F1D14170
SUB ERASA1 IS IT THE REQUESTED ONE. F1D14180
TZE FEIFC *YES. F1D14190
TIX FEIFB,4,1 *NO. IS TEIFNO EXHAUSTED, NO CONTINUE. F1D14200
ZAC YES. IFN DOES NOT EXIST, SET ERROR FLAG. F1D14210
TRA 1,1 *RETURN TO CALLER. F1D14220
REM F1D14230
FEIFC CAL **,4 GET TEIFNO ENTRY - EFN. F1D14240
TRA 1,1 *RETURN TO CALLER. F1D14250
REM F1D14260
REM *************************************************************F1D14270
REM F1D14280
REM F1D14290
REM I/O COMMANDS FOR SPECIAL READ-WRITE ROUTINES. F1D14300
REM USED TO- F1D14310
IOCM1 IOCP CITCNT,,1 WRITE COMPAIL RECORD COUNT AND F1D14320
IOCM2 IOCT FRSBBF,,** SUBDEF TABLE. $F1D14330
REM F1D14340
FLOCOM IOCP FLOCNT,,1 WRITE FLOCON TABLE WORD COUNT AND F1D14350
IOCT FLCNBF,,** THE FLOCON TABLE. $F1D14360
REM F1D14370
DMIO1 IOCP EIFNO,,1 WRITE LAST IFN ASSIGNED IN PROGRAM, F1D14380
DMIO2 IOCP ERASA1,,1 THE SIZ TABLE WORD COUNT, F1D14390
DMIO3 IOCT DIM1BF,,** AND THE SIZ TABLE. $F1D14400
REM F1D14410
CLSIO IORT **,,** WRITE CLOSUB ON A SCRATCH TAPE. F1D14420
REM ALSO USED TO READ IT BACK. F1D14430
REM F1D14440
ENDIO IORT **,,6 WRITE THE END TABLE. F1D14450
REM F1D14460
REM *************************************************************F1D14470
REM F1D14480
REM CONSTANTS AND ERASABLE STORAGE. F1D14490
REM F1D14500
LABL1 BCI 1,FORSUB FORSUB LABEL. F1D14510
LABL2 BCI 1,FLOCON FLOCON LABEL. F1D14520
LABL3 BCI 1,SIZ SIZ LABEL. F1D14530
TCLOS BCI 1,TMPCLS INTERMEDIATE CLOSUB LABEL. F1D14540
FRTSG PZE ,,49 FORMAT STATEMENT ERROR FLAG. F1D14550
EIFSG PZE ,,50 TEIFNO ERROR FLAG. F1D14560
MFRTE PZE ,,51 FRET ERROR FLAG, NON-EXISTENT EFN. F1D14561
GOOFCT SYN DGFLAG DECREMENT HAS COUNT OF WORDS IN ERROR LISTF1D14570
FLOCNT PZE ** FLOCON TABLE WORD COUNT. F1D14580
(1)L DEC 1 CONSTANT. F1D14590
(2)L DEC 2 CONSTANT. F1D14600
ERASA1 PZE **,,0 ADDRESS ERASABLE. F1D14610
ADMSK PZE -1 ADDRESS MASK. F1D14620
DCMSK PZE ,,-1 DECREMENT MASK. F1D14630
2NDEOF BCI 1,2NDEOF END-OF-FILE LABEL. F1D14640
3RDEOF BCI 1,3RDEOF DITTO. F1D14650
4THEOF BCI 1,4THEOF DITTO. F1D14660
5THEOF BCI 1,5THEOF DITTO. F1D14670
REM F1D14680
REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D14690
REM F1D14700
REM THE FOLLOWING ARE USED BY THE F1D14710
REM EQUIVALENCE PROCESSOR. F1D14720
REM F1D14730
FRCON PTH -1,7,-1 EQUIVALENCE ERROR FLAG. F1D14740
L(FEQ) PZE LWBF2 ORIGIN OF FINAL EQUIVALENCE TABLE. F1D14750
FEQ SYN 0 SAME. F1D14760
L(OEQ) PZE LWBF1 LOCATION OF ORIGINAL EQUIT TABLE. F1D14770
OEQ SYN 0 ORIGIN OF ASSEMBLED EQUIVALENCE TABLE. F1D14780
E4 PZE F1D14790
PCOUNT PZE ,,-LWBF1 (LOC OF FIRST SYMBOL OEQ SENTENCE BEING SCANNED)F1D14800
QCOUNT PZE ,,-LWBF1 (LOC FINAL SUBSCRIPT OF SENTENCE COPIED OUT OF F1D14810
REM ORDER FROM OEQ) F1D14820
WCOUNT PZE ,,-LWBF2 (LOC OF LAST SUBSCRIPT COPIED INTO FEQ BEFORE F1D14830
REM THIS PORTION OF SENTENCE WAS ADDED OUT OF ORDER)F1D14840
REM (IF SWITCH IS - A PORTION OF OEQ WAS SCANNED F1D14850
REM BEFORE THIS PORTION OF SENTENCE WAS ADDED. SKIP F1D14860
REM THIS PORTION OF OEQ WHEN RESUMING SCAN) F1D14870
YCOUNT PZE ,,-LWBF2 (LOC FIXED SYMBOL IN FEQ SCANNED FOR MATCH) F1D14880
ZCOUNT PZE ,,-LWBF2 (LOC OF FIRST SYMBOL IN FEQ SET BEING SCANNED) F1D14890
REM F1D14900
REM *************************************************************F1D14910
REM F1D14920
SYN * BEGINNING OF - F1D14930
REM SECTION ONE PRIME PATCHING SPACE. F1D14940
ENDF13 BES 200 END OF - F1D14950
REM F1D14960
REM *************************************************************F1D14970
TCD -1 $F1D14980
TTL * SECTION ONE DOUBLE PRIME * RECORD 9F17 * F1E00000
REM F1E00070
REM SECTION ONE DOUBLE PRIME SCANS VARIOUS TABLES F1E00080
REM COMPRISING THE FIFTH FILE OF THE TABLE TAPE. F1E00090
REM IT DOES NOT ADD ANY NEW INFORMATION TO WHAT F1E00100
REM ALREADY EXISTS. ITS ONLY TASK IS TO FIND F1E00110
REM SOURCE PROGRAM ERRORS. F1E00120
REM F1E00130
REM *************************************************************F1E00140
REM F1E00150
REM **** DEFINITIONS AND PARAMETERS **** F1E00160
REM F1E00170
REM F1E00180
PEIFNO SYN EIFNO DEFINE EIFNO FOR HEADED BLOCK. F1E00190
HEAD P HEAD SECTION ONE DOUBLE PRIME WITH P. F1E00200
LIST SYN BOTIOP-1 ORIGIN OF ERROR LIST FOR GENERAL DIAG. F1E00210
REM F1E00220
EJECT F1E00490
REM F1E00500
LBL 9F17,THE WORKS F1E00510
REM F1E00520
REM F1E00540
ORG SYSCUR $F1E00550
BCI 1,9F1700 $F1E00560
REM F1E00570
ORG (LODR) $F1E00580
TXI BEGF14,,170 ENTRY POINT,,RECORD NUMBER F1E00590
REM F1E00600
ABS F1E00610
ORG BOTMEM+15 F1E00620
REM F1E00630
SOURCE TXI (DIAG),,-1 SOURCE PROGRAM ERROR, GET DIAGNOSTIC. F1E00640
PZE LIST,,** LOCATION OF ERROR LIST,,WORD COUNT. F1E00650
REM F1E00660
1DPER0 TXI (DIAG),,0 *MACHINE ERROR. GO TO DIAGNOSTIC F1E00670
REM FAILURE OF TIX INSTRUCTION TO TRANSFER. F1E00680
REM INDEX SHOULD REDUCE BY ONE TO POSITION F1E00690
REM AT SECOND WORD OF A TWO WORD TIFGO ENTRY. F1E00700
REM F1E00710
1DPER1 TXI (DIAG),,0 *MACHINE ERROR. GO TO DIAGNOSTIC. F1E00720
REM SIMILAR CONDITION TO 1DPER0. HOWEVER, F1E00730
REM INSTRUCTION IS A TNX WHICH SHOULD NOT F1E00740
REM HAVE TRANSFERRED, BUT IT DID. F1E00750
REM F1E00760
REM *************************************************************F1E00770
REM F1E00780
BEGF14 RIR 777777 F1E00790
TSX (TAPE),4 POSITION TAPE AT FORVAL FOR SECTION TWO. F1E00800
PZE BKSPX,,(SKBP) F1E00801
PZE FORVL,,TABTAP F1E00802
REM F1E00810
LXD NXCLOC,4 LOAD WORD COUNT OF NONEXC TABLE. F1E00820
SXA SRNXA,4 F1E00830
TXL STPPA,4,0 *NO TABLE, EXIT. F1E00840
REM F1E00850
CAL NXCLOC INITIALIZE LAST ADDRESS PLUS ONE. F1E00860
STA NXCPA F1E00870
STA NXCPB F1E00880
STA SRNXB SET NONEXC SEARCH ROUTINE. F1E00890
NXCPA CAL **,4 MOVE IFNS FROM DECREMENT F1E00900
PDX ,1 FIELD TO ADDRESS FIELD. F1E00910
PXA ,1 F1E00920
NXCPB SLW **,4 STORE BACK IN TABLE. F1E00930
TIX NXCPA,4,1 *IS TABLE EXHAUSTED, NO CONTINUE. F1E00940
REM F1E00950
REM *************************************************************F1E00960
REM F1E00970
STPPA LXD STPLOC,4 LOAD WORD COUNT OF TSTOPS TABLE. F1E00980
CLA STPLOC GET BASE ADDRESS OF TSTOPS. F1E00990
STA TIFD F1E01000
STA FLOWB F1E01010
TXL EQITA,4,0 *NO TABLE, EXIT. F1E01020
REM F1E01030
STA STPPB SET LAST ADDRESS OF TSTOPS PLUS ONE F1E01040
STA STPPC IN VARIOUS ROUTINES. F1E01050
REM F1E01060
STPPB CAL **,4 MOVE IFNS FROM DECREMENT F1E01070
PDX ,2 FIELD TO ADDRESS FIELD. F1E01080
PXA ,2 F1E01090
STPPC SLW **,4 STORE BACK IN TABLE. F1E01100
TIX STPPB,4,1 *IS TABLE EXHAUSTED, NO CONTINUE. F1E01110
REM F1E01120
REM *************************************************************F1E01130
REM F1E01140
REM EQUIVALENCE STATEMENT ERROR ROUTINE. F1E01150
REM F1E01160
EQITA LXD EQTLOC,2 LOAD EQUIVALENCE WORD COUNT. F1E01170
TXL TIFGO,2,0 *NO TABLE, EXIT. F1E01180
CLS ALL1S SOME TABLE, F1E01190
ERA* EQTLOC IS THE FIRST WORD AN ERROR FLAG. F1E01200
TNZ TIFGO *NO, TABLE IS ALL RIGHT. F1E01210
TXI EQITC,2,-1 YES, ALL ENTRIES ARE ERRORS. F1E01220
EQITB CLS ALL1S LOAD TERMINAL FLAG. F1E01230
ERA* EQTLOC IS THIS ENTRY DIE ENDEN FLAG. F1E01240
TZE TIFGO *YES, ALL DONE. F1E01250
EQITC LDQ* EQTLOC LOAD MQ WITH VARIABLE NAME. F1E01260
TSX ERROR,4 GO TO ERROR ENTRY SUBROUTINE. F1E01270
OCT 1234 ERROR FLAG. F1E01280
TIX EQITB,2,1 *IS TABLE EXHAUSTED, NO CONTINUE. F1E01290
REM F1E01300
REM *************************************************************F1E01310
REM F1E01320
REM ROUTINE TO PROCESS TIFGO. F1E01330
REM CHECKS FOR THE EXISTENCE OF THE BETAS F1E01340
REM AND THAT THE BETAS ARE EXECUTABLE. F1E01350
REM F1E01360
TIFGO LXD TIFLOC,2 LOAD TIFGO WORD COUNT. F1E01370
TXL FLOWA,2,0 *NO TABLE, EXIT. F1E01380
LXD TRDLOC,4 INITIALIZE TRAD ADDRESS F1E01390
SXA ERASA,4 IN COMPUTED AND ASSIGNED F1E01400
CAL TRDLOC GO TO ROUTINES. F1E01410
SUB ERASA F1E01420
ADD TRADL ADD MAXIMUM LENGTH OF TRAD TABLE. F1E01430
STA TIF1B INITIALIZE TO LAST TRAD ADDRESS. F1E01440
STA TIF2B (TRAD+TRADMX) F1E01450
REM F1E01460
TIFA CLA* TIFLOC GET FIRST WORD OF A TIFGO ENTRY. F1E01470
PDX ,4 MOVE THE ALPHA TO THE ADDRESS F1E01480
SXA ALPHA,4 FIELD AND SAVE IT. F1E01490
REM F1E01500
REM BRANCH TO PROPER SUBROUTINE TO PROCESS. F1E01510
TMI TIFMA *MINUS TYPE - ARITMETIC IF. F1E01520
PAX ,1 PLACE TYPE NUMBER IN INDEX. F1E01530
TXL TIFB,1,6 *IS IT LEGITIMATE, YES. F1E01540
LDQ* TIFLOC NO, IS UNKNOWN TYPE. F1E01550
TSX ERROR,4 GO TO ERROR ENTRY SUBROUTINE. F1E01560
OCT 471 F1E01570
TRA TIFC CONTINUE WITH NEXT ENTRY. F1E01580
TIFB XEC TIFTR,1 BRANCH ON TYPE NUMBER. F1E01590
TSX 1DPER0,4 *TIX DID NOT TIX, MACHINE ERROR. F1E01600
REM F1E01610
TIX TIF6A,2,1 TYPE 6 - ASSIGN. F1E01620
TIX TIF5A,2,1 TYPE 5 - AC/MQ OVERFLOW IF. F1E01630
TIX TIF4A,2,1 TYPE 4 - DIVIDE CHECK IF. F1E01640
TIX TIF3A,2,1 TYPE 3 - SENSE LIGHT/SWITCH IF. F1E01650
TIX TIF2A,2,1 TYPE 2 - COMPUTED GO TO. F1E01660
TIX TIF1A,2,1 TYPE 1 - ASSIGNED GO TO. F1E01670
TIFTR TIX TIF0A,2,1 TYPE 0 - JUST PLAIN GO TO .... F1E01680
REM F1E01690
REM F1E01700
TIFC LXD STPLOC,4 LOAD TSTOPS WORD COUNT. F1E01710
TXI *+1,4,1 INCREMENT COUNT AND F1E01720
SXD STPLOC,4 SAVE. F1E01730
CLA ALPHA ENTER THIS ALPHA IN TSTOPS (ALPHA) TABLE F1E01740
TIFD STO **,4 FOR FLOW ANALYSIS. F1E01750
TIFE TIX TIFA,2,1 *IS TIFGO EXHAUSTED, NO CONTINUE. F1E01760
REM F1E01770
TRA FLOWA YES, GO TO FLOW ANAYSIS. F1E01790
REM F1E01800
REM . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E01810
REM F1E01820
REM IF (E) BETA1, BETA2, BETA3 F1E01830
REM F1E01840
REM -ALPHA,,BETA1 F1E01850
REM BETA2,,BETA3 F1E01860
REM F1E01870
TIFMA ANA ADMSK GET BETA1. F1E01880
TNZ TIFMB *DOES IT EXIST, YES. F1E01890
TSX NOBETA,4 NO, SAVE FOR DIAGNOSTIC. F1E01900
OCT 506 ERROR FLAG. F1E01910
TRA TIFMC *CONTINUE WITH BETA2. F1E01920
TIFMB TSX SRNONX,4 SEARCH FOR BETA1 IN THE NONEXC TABLE. F1E01930
OCT 510 ERROR FLAG. F1E01940
REM F1E01950
TIFMC TNX 1DPERA,2,1 REDUCE TIFGO INDEX TO GET SECOND WORD. F1E01960
CAL* TIFLOC GET SECOND WORD OF TIFGO ENTRY. F1E01970
PDX ,4 MOVE BETA2 TO ADDRESS FIELD. F1E01980
PXA ,4 F1E01990
TNZ TIFMD *DOES IT EXIST, YES. F1E02000
TSX NOBETA,4 NO, GO DIAGNOSTIC SUBROUTINE. F1E02010
OCT 517 ERROR FLAG. F1E02020
TRA TIFME *CONTINUE WITH BETA3. F1E02030
TIFMD TSX SRNONX,4 SEARCH FOR BETA2 IN THE NONEXC TABLE. F1E02040
OCT 521 ERROR FLAG. F1E02050
REM F1E02060
TIFME CAL* TIFLOC GET SECOND WORD OF TIFGO ENTRY. F1E02070
ANA ADMSK GET BETA3. F1E02080
TNZ TIFMF *DOES IT EXIST, YES. F1E02090
TSX NOBETA,4 NO, GO TO DIAGNOSTIC SUBROUTINE. F1E02100
OCT 527 ERROR FLAG. F1E02110
TRA TIFMG *GO TO SET BRANCH COUNT. F1E02120
TIFMF TSX SRNONX,4 SEACH FOR BETA3 IN THE NONEXC TABLE. F1E02130
OCT 531 ERROR FLAG. F1E02140
REM F1E02150
TIFMG AXT 3,1 SET NUMBER OF BRANCHES FOR THIS F1E02160
SXD ALPHA,1 TYPE OF TIFGO. F1E02170
TRA TIFC *RETURN TO MAIN ROUTINE. F1E02180
REM F1E02190
1DPERA TSX 1DPER1,4 *MACHINE ERROR. F1E02200
REM F1E02210
REM . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E02220
REM F1E02230
REM GO TO BETA F1E02240
REM F1E02250
REM ALPHA,,ZERO F1E02260
REM ,,BETA F1E02270
REM F1E02280
TIF0A CAL* TIFLOC GET SECOND WORD OF THIS TIFGO ENTRY. F1E02290
PAX ,4 PLACE BETA IN AN INDEX REGISTER. F1E02300
TXH TIF0B,4,0 *DOES BETA EXIST, YES. F1E02310
TSX NOBETA,4 NO, GO TO DIAGNOSTIC SUBROUTINE. F1E02320
OCT 547 ERROR FLAG. F1E02330
TRA TIF0C *SET NUMBER OF BRANCHES. F1E02340
TIF0B PXA ,4 PLACE BETA IN THE AC. F1E02350
TSX SRNONX,4 SEARCH FOR BETA IN THE NONEXC TABLE. F1E02360
OCT 551 ERROR FLAG. F1E02370
TIF0C AXT 1,1 SET NUMBER OF BRANCHES FOR THIS F1E02380
SXD ALPHA,1 TYPE OF TIFGO. F1E02390
TRA TIFC *RETURN TO MAIN ROUTINE. F1E02400
REM F1E02410
REM . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E02420
REM F1E02430
REM GO TO N,(BETA1,BETA2,....,BETAX) F1E02440
REM F1E02450
REM ALPHA,,ONE F1E02460
REM TRADI,,TRADU F1E02470
REM F1E02480
TIF1A SLF MAKE SURE NON-EXECUTABLE FLAG IS OFF. F1E02490
SIR 1 SET FLAG TO PREVENT ENTRY IN BETA TABLE. F1E02500
ZSD ALPHA SET BRANCH COUNT TO ZERO. F1E02510
CAL* TIFLOC GET SECOND WORD OF TIFGO ENTRY. F1E02520
PAX ,4 GET LAST TRAD REFERENCE AND F1E02530
SXD TIF1E,4 SET END OF ENTRY TEST. F1E02540
PDX ,1 LOAD FIRST TRAD REFERENCE. F1E02550
TIF1B CAL **,1 GET A TRAD ENTRY. F1E02560
TRA1 TRA PATC1 GO TO PATCH. $F1E02570
TSX NOBETA,4 NO, GO TO DIAGNOSTIC SUBROUTINE. F1E02580
OCT 571 ERROR FLAG. F1E02590
TRA TIF1D *UPDATE BRANCH COUNT ANYHOW. F1E02600
TIF1C TSX SRNONX,4 SEARCH FOR THIS BETA IN THE NONEXC TABLE. F1E02610
OCT 573 ERROR FLAG. F1E02620
TIF1D CLA ALPHA GET ALPHA AND F1E02630
ADD L(D1) UPDATE THE F1E02640
STO ALPHA BRANCH COUNT. F1E02650
SLT 4 WAS BETA EXECUTABLE. F1E02660
TRA *+2 *YES. F1E02670
STD* TIF1B NO, CLOBBER THIS TRAD ENTRY. F1E02680
TXI *+1,1,-1 UPDATE TRAD INDEX. F1E02690
TIF1E TXH TIF1B,1,** *HAVE ALL BETAS BEEN CHECKED, NO CONTINUE. F1E02700
RIR 1 YES, RESET BETA TABLE FLAG. F1E02710
TRA TIFC *RETURN TO MAIN ROUTINE. F1E02720
REM F1E02730
REM . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E02740
REM F1E02750
REM GO TO (BETA1,BETA2,....,BETAX), N F1E02760
REM F1E02770
REM ALPHA,,TWO F1E02780
REM TRADI,,TRADU F1E02790
REM F1E02800
TIF2A SLF MAKE SURE NON-EXECUTABLE FLAG IS OFF. F1E02810
SIR 1 SET FLAG TO PREVENT ENTRY IN BETA TABLE. F1E02820
SXD ALPHA,0 SET BRANCH COUNT TO ZERO. F1E02830
CAL* TIFLOC GET SECOND WORD OF TIFGO ENTRY. F1E02840
PAX ,4 GET LAST TRAD REFERENCE AND F1E02850
SXD TIF2E,4 SET END OF ENTRY TEST. F1E02860
PDX ,1 LOAD FIRST TRAD REFERENCE. F1E02870
TIF2B CAL **,1 GET A TRAD REFERENCE. F1E02880
TRA2 TRA PATC2 GO TO PATCH. $F1E02890
TSX NOBETA,4 NO, GO TO DIAGNOSTIC SUBROUTINE. F1E02900
OCT 622 ERROR FLAG. F1E02910
TRA TIF2D *UPDATE BRANCH COUNT ANYHOW. F1E02920
TIF2C TSX SRNONX,4 SEARCH FOR BETA IN THE NONEXC TABLE. F1E02930
OCT 624 ERROR FLAG. F1E02940
TIF2D CLA ALPHA GET ALPHA AND F1E02950
ADD L(D1) UPDATE THE F1E02960
STO ALPHA BRANCH COUNT. F1E02970
SLT 4 WAS BETA EXECUTABLE. F1E02980
TRA *+2 *YES. F1E02990
STD* TIF2B NO, CLOBBER THIS TRAD ENTRY. F1E03000
TXI *+1,1,-1 UPDATE TRAD INDEX. F1E03010
TIF2E TXH TIF2B,1,** *HAVE ALL BETAS BEEN CHECKED, NO CONTINUE. F1E03020
RIR 1 YES, RESET BETA TABLE FLAG. F1E03030
TRA TIFC *RETURN TO MAIN ROUTINE. F1E03040
REM F1E03050
REM . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E03060
REM F1E03070
REM IF (SENSE SWITCH/LIGHT I) BETA1, BETA2 F1E03080
REM F1E03090
REM ALPHA,,THREE F1E03100
REM BETA1,,BETA2 F1E03110
REM F1E03120
TIF3A CAL* TIFLOC GET SECOND WORD OF TIFGO ENTRY. F1E03130
PDX ,4 MOVE BETA1 FROM DECREMENT F1E03140
PXA ,4 FIELD TO ADDRESS FIELD. F1E03150
TNZ TIF3B *DOES BETA1 EXIST, YES. F1E03160
TSX NOBETA,4 NO, GO TO DIAGNOSTIC SUBROUTINE. F1E03170
OCT 647 ERROR FLAG. F1E03180
TRA TIF3C *CONTINUE WITH BETA2. F1E03190
TIF3B TSX SRNONX,4 SEARCH FOR BETA1 IN THE NONEXC TABLE. F1E03200
OCT 651 ERROR FLAG. F1E03210
TIF3C CAL* TIFLOC GET SECOND WORD OF TIFGO ENTRY AGAIN. F1E03220
ANA ADMSK GET BETA2. F1E03230
TNZ TIF3D *DOES BETA2 EXIST, YES. F1E03240
TSX NOBETA,4 NO, GO TO DIAGNOSTIC SUBROUTINE. F1E03250
OCT 657 ERROR FLAG. F1E03260
TRA TIF3E *CONTINUE WITH BRANCH COUNT. F1E03270
TIF3D TSX SRNONX,4 SEARCH FOR BETA2 IN THE NONEXC TABLE. F1E03280
OCT 661 ERROR FLAG. F1E03290
TIF3E AXT 2,1 SET BRANCH COUNT FOR THIS F1E03300
SXD ALPHA,1 TYPE OF TIFGO. F1E03310
TRA TIFC *RETURN TO MAIN ROUTINE. F1E03320
REM F1E03330
REM . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E03340
REM F1E03350
REM IF DIVIDE CHECK BETA1, BETA2 F1E03360
REM F1E03370
REM ALPHA,,FOUR F1E03380
REM BETA1,,BETA2 F1E03390
REM F1E03400
TIF4A CAL* TIFLOC GET SECOND WORD OF THIS TIFGO ENTRY. F1E03410
PDX ,4 MOVE BETA1 FROM DECREMENT F1E03420
PXA ,4 FIELD TO ADDRESS FIELD. F1E03430
TNZ TIF4B *DOES BETA1 EXIST, YES. F1E03440
TSX NOBETA,4 NO, GO TO DIAGNOSTIC SUBROUTINE. F1E03450
OCT 676 ERROR FLAG. F1E03460
TRA TIF4C *CONTINUE WITH BETA2. F1E03470
TIF4B TSX SRNONX,4 SEARCH FOR BETA1 IN THE NONEXC TABLE. F1E03480
OCT 700 ERROR FLAG. F1E03490
TIF4C CAL* TIFLOC GET SECOND WORD OF TIFGO ENTRY AGAIN. F1E03500
ANA ADMSK GET BETA2. F1E03510
TNZ TIF4D *DOES BETA2 EXIST, YES. F1E03520
TSX NOBETA,4 NO, GO TO DIAGNOSTIC SUBROUTINE. F1E03530
OCT 706 ERROR FLAG. F1E03540
TRA TIF4E *CONTINUE WITH BRANCH COUNT. F1E03550
TIF4D TSX SRNONX,4 SEARCH FOR BETA2 IN THE NONEXC TABLE. F1E03560
OCT 710 ERROR FLAG F1E03570
TIF4E AXT 2,1 SET BRANCH COUNT F1E03580
SXD ALPHA,1 FOR THIS TYPE OF TIFGO. F1E03590
TRA TIFC *RETURN TO MAIN ROUTINE. F1E03600
REM F1E03610
REM . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E03620
REM F1E03630
REM IF (AC/MQ) OVERFLOW BETA1, BETA2 F1E03640
REM F1E03650
REM ALPHA,,FIVE F1E03660
REM BETA1,,BETA2 F1E03670
REM F1E03680
TIF5A LXD STPLOC,4 LOAD TSTOPS (ALPHA) TABLE WORD COUNT. F1E03690
TXI *+1,4,1 INCREMENT WORD COUNT. F1E03700
SXD STPLOC,4 SAVE COUNT. F1E03710
LXA ALPHA,1 GET THE SECTION I DUMMY ALPHA F1E03720
TXI *+1,1,-1 AND REDUCE TO TRUE ALPHA FOR F1E03730
PXA ,1 TDO SCAN AND FLOW ANALYSIS. F1E03740
ADD L(D2) SET BRANCH COUNT. F1E03750
STO* TIFD STORE IN TSTOPS (ALPHA) TABLE. F1E03760
LXA SRNXC,1 LOAD BETA TABLE WORD COUNT. F1E03770
LXA ALPHA,4 GET THE SECONDARY ALPHA F1E03780
PXA ,4 AND STORE F1E03790
STO* SRNXD IT IN THE BETA TABLE FOR FLOW ANALYSIS. F1E03800
TXI *+1,1,-1 INCREMENT BETA TABLE WORD COUNT. F1E03810
SXA SRNXC,1 SAVE BETA TABLE WORD COUNT. F1E03820
CAL* TIFLOC GET SECOND WORD OF TIFGO ENTRY. F1E03830
PDX ,4 MOVE BETA1 FROM THE DECREMENT F1E03840
PXA ,4 FIELD TO THE ADDRESS FIELD. F1E03850
TNZ TIF5B *DOES BETA1 EXIST, YES. F1E03860
TSX NOBETA,4 NO, GO TO DIAGNOSTIC SUBROUTINE. F1E03870
OCT 736 ERROR FLAG. F1E03880
TRA TIF5C *CONTINUE WITH BETA2. F1E03890
TIF5B TSX SRNONX,4 SEARCH FOR BETA1 IN THE NONEXC TABLE. F1E03900
OCT 740 ERROR FLAG. F1E03910
TIF5C CAL* TIFLOC GET SECOND WORD OF THIS TIFGO ENTRY AGAIN.F1E03920
ANA ADMSK GET BETA2. F1E03930
TNZ TIF5D *DOES BETA2 EXIST, YES. F1E03940
TSX NOBETA,4 NO, GO TO DIAGNOSTIC SUBROUTINE. F1E03950
OCT 746 ERROR FLAG. F1E03960
TRA TIF5E *CONTINUE WITH BRANCH COUNT. F1E03970
TIF5D TSX SRNONX,4 SEARCH FOR BETA2 IN THE NONEXC TABLE. F1E03980
OCT 750 ERROR FLAG. F1E03990
TIF5E AXT 2,1 SET BRANCH COUNT FOR F1E04000
SXD ALPHA,1 THIS TYPE OF TIFGO ENTRY. F1E04010
TRA TIFC *RETURN TO MAIN ROUTINE. F1E04020
REM F1E04030
REM . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E04040
REM F1E04050
REM ASSIGN BETA TO N F1E04060
REM F1E04070
REM ALPHA,,SIX F1E04080
REM ZERO ,,BETA F1E04090
REM F1E04100
TIF6A CAL* TIFLOC GET SECOND WORD OF TIFGO ENTRY. F1E04110
ANA ADMSK ELIMINATE THE POSSIBILITY OF HASH. F1E04120
TNZ TIF6B *DOES BETA EXIST, YES. F1E04130
TSX NOBETA,4 NO, GO TO DIAGNOSTIC SUBROUTINE. F1E04140
OCT 764 ERROR FLAG. F1E04150
TRA TIFE *RETURN TO MAIN ROUTINE. F1E04160
TIF6B SIR 1 SET FLAG TO PREVENT ENTRY IN BETA TABLE. F1E04170
TSX SRNONX,4 SEARCH FOR BETA IN THE NONEXC TABLE. F1E04180
OCT 765 ERROR FLAG. F1E04190
RIR 1 RESET BETA TABLE FLAG. F1E04200
TRA TIFE *RETURN TO MAIN ROUTINE. F1E04210
REM F1E04220
REM . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E04230
REM F1E04240
REM ROUTINE TO SEARCH FOR BETA IN THE NONEXC F1E04250
REM TABLE AND TO MAKE ENTRIES IN THE BETA TABLE. F1E04260
REM F1E04270
SRNONX SLF RESET NOT-EXECUTABLE FLAG. F1E04280
SXA SRNXE,1 SAVE INDEX REGISTER. F1E04290
SRNXA AXT **,1 LOAD WORD COUNT OF NONEXC TABLE. F1E04300
SRNXB LAS **,1 COMPARE BETA TO A NONEXC ENTRY. F1E04310
TRA *+2 DOES NOT COMPARE. F1E04320
TRA SRNXF *COMPARES, PROGRAMMER ERROR. F1E04330
TIX SRNXB,1,1 *DOES NOT COMPARE, TABLE EXHAUSTED, NO. F1E04340
RFT 1 YES, SHOULD BETA BE ENTERED IN BETA TABLE.F1E04350
TRA SRNXE *NO. F1E04360
SRNXC AXT **,1 YES, LOAD CURRENT BETA TABLE WORD COUNT. F1E04370
SRNXD STO BETA,1 STORE THIS BETA. F1E04380
TXI *+1,1,-1 INCREMENT COUNT. F1E04390
SXA SRNXC,1 SAVE BETA WORD COUNT. F1E04400
SRNXE AXT **,1 RESTORE INDEX REGISTER. F1E04410
TRA 2,4 *RETURN TO CALLER. F1E04420
REM F1E04430
SRNXF LXD GOOFCT,1 LOAD ERROR LIST WORD COUNT. F1E04440
ALS 18 SHIFT BETA TO DECREMENT FIELD. F1E04450
SLW ELSEBF-1,1 STORE IN ERROR LIST. F1E04460
CLA ALPHA GET THE ALPHA OF THIS STATEMENT. F1E04470
STA ELSEBF-1,1 SAVE IT WITH BETA. F1E04480
CAL 1,4 GET ERROR FLAG. F1E04490
ORA NXFLG ADD THE NON-EXECUTABLE FLAG. F1E04500
SLW ELSEBF,1 STORE IN ERROR LIST. F1E04510
TXI *+1,1,2 UPDATE WORD COUNT. F1E04520
SXD GOOFCT,1 STORE NEW COUNT. F1E04530
SLN 4 TURN ON NON-EXECUTABLE LITE. F1E04540
TRA SRNXE *RETURN TO CALLER VIA INDEX RESTORE. F1E04550
REM F1E04560
REM *************************************************************F1E04570
REM F1E04580
REM FLOW ANALYSIS ROUTINE. F1E04590
REM PERFORMS A FLOW ANALYSIS OF THE PROGRAM F1E04600
REM BASED ON THE INFORMATION CONTAINED IN THE F1E04610
REM TSTOPS (ALPHA) TABLE AND THE NONEXC AND F1E04620
REM BETA TABLES. F1E04630
REM F1E04640
FLOWA LXD STPLOC,1 LOAD TSTOPS WORD COUNT. F1E04650
TXL TDOA,1,0 *EXIT, NO TABLE. F1E04670
LXD EIFNO,4 GET LAST IFN-PLUS-ONE AND F1E04680
PXA ,4 ENTER IT IN THE BETA TABLE F1E04690
TSX SRNXC,4 SO THAT THERE WILL BE A PATCH OF F1E04700
NOP FLOW TO THE IMAGINARY LAST STATEMENT+1. F1E04710
CLA TRDLOC INITIALIZE LAST ADDRESS PLUS ONE OF TRAD. F1E04720
STA FLOW3 F1E04730
LAC SRNXC,4 GET TRUE WORD COUNT OF THE F1E04740
PXA ,4 BETA TABLE AND COMPUTE THE F1E04750
ADD OBETA LAST ADDRESS PLUS ONE. F1E04760
STA FLOWD INITIALIZE THE BETA SEARCH F1E04770
SXA FLOWC,4 ROUTINE. F1E04780
LXA NXCLOC,4 INITIALIZE THE NONEXC SEARCH F1E04790
SXA FLOWF,4 ROUTINE WITH THE LAST ADDRESS PLUS ONE F1E04800
LXD NXCLOC,4 AND WORD COUNT. F1E04810
SXA FLOWE,4 F1E04820
REM F1E04830
REM F1E04840
LXD STPLOC,1 LOAD WORD COUNT OF TSTOPS (ALPHA) TABLE. F1E04850
FLOWB CAL **,1 GET AN ALPHA (AN ALPHA IS THE END OF F1E04860
ANA ADMSK A PATH OF FLOW). EXTRACT ALPHA. F1E04870
FLOW1 ADD L(A1) FORM IFN OF ALPHA+N (MUST BE A TRA TO IT).F1E04880
REM F1E04890
FLOWC AXT **,2 LOAD BETA TABLE WORD COUNT. F1E04900
TXL FLOW2,2,0 *EXIT, NO TABLE. F1E04910
FLOWD LAS **,2 DOES A BETA TRANSFER TO ALPHA+N. F1E04920
TRA *+2 NO. F1E04930
TRA FLOWG *YES, IS ALL RIGHT. F1E04940
TIX FLOWD,2,1 *NO, IS BETA EXHAUSTED, NO CONTINUE. F1E04950
REM F1E04960
FLOW2 LXD TRDLOC,2 YES, LOAD TRAD TABLE WORD COUNT. F1E04970
TXL FLOWE,2,0 *EXIT, NO TABLE. F1E04980
FLOW3 LAS **,2 DOES A BETA IN TRAD TRANSFER TO ALPHA+N. F1E04990
TRA *+2 NO. F1E05000
TRA FLOWG *YES, IS ALL RIGHT. F1E05010
TIX FLOW3,2,1 *NO, IS TRAD EXHAUSTED, NO CONTINUE. F1E05020
REM F1E05030
FLOWE AXT **,2 YES, LOAD THE NONEXC TABLE WORD COUNT. F1E05040
TXL FLOW4,2,0 *EXIT, NO TABLE. F1E05050
FLOWF LAS **,2 IS ALPHA+N NON-EXECUTABLE. F1E05060
TRA *+2 NO. F1E05070
TRA FLOW1 YES, FORM ALPHA+N+1. F1E05080
TIX FLOWF,2,1 *NO, IS NONEXC EXHAUSTED, NO CONTINUE. F1E05090
REM F1E05100
FLOW4 STA ALPHA YES, SAVE ALPHA. F1E05110
TSX NOBETA,4 GO TO DIAGNOSTIC SUBROUTINE. F1E05120
OCT 1014 ERROR FLAG. F1E05130
REM F1E05140
FLOWG TIX FLOWB,1,1 *IS TSTOPS (ALPHA) EXHAUSTED, NO CONTINUE. F1E05150
REM F1E05160
REM *************************************************************F1E05170
REM F1E05180
REM TDO ROUTINE. F1E05190
REM CHECKS THE BETA OF A DO LOOP FOR ITS EXISTENCE,F1E05200
REM THAT IT IS EXECUTABLE AND THAT IT IS NOT F1E05210
REM A TIFGO STATEMENT. F1E05220
REM F1E05230
TDOA LXD TDOLOC,1 LOAD TDO TABLE WORD COUNT. F1E05240
TXL FRETA,1,0 *EXIT, NO TABLE. F1E05260
REM F1E05270
LXA NXCLOC,2 INITIALIZE LAST ADDRESS PLUS ONE F1E05280
SXA TDOF,2 OF NONEXC SEARCH ROUTINE. F1E05290
LXA STPLOC,2 INITIALIZE LAST ADDRESS PLUS ONE F1E05300
SXA TDOD,2 OF TSTOPS SEARCH ROUTINE. F1E05310
LXA TDOLOC,2 LOAD LAST ADDRESS PLUS ONE OF TDO TABLE. F1E05320
SXA TDOB,2 SET ADDRESS IN PROCESSOR. F1E05330
TXI *+1,2,1 BUMP BY ONE AND SET IN ERROR ROUTINE F1E05340
SXA TDOI,2 TO GET SYMBOL. F1E05350
REM F1E05360
STZ ALPHA RESET ALPHA CELL. F1E05370
REM F1E05380
TDOB CAL **,1 GET FIRST WORD OF TDO ENTRY. F1E05390
PDX ,4 GET ALPHA FROM DECREMENT FIELD F1E05400
SXA ALPHA,4 AND SAVE FOR ERROR ROUTINE. F1E05410
ANA ADMSK GET BETA FOR THIS DO LOOP. F1E05420
TNZ TDOC *DOES BETA EXIST, YES. F1E05430
TSX NOBETA,4 NO, GO TO DIAGNOSTIC SUBROUTINE. F1E05440
OCT 1050 ERROR FLAG. F1E05450
TRA TDOG *TERMINATE PROCESSING ON THIS ENTRY. F1E05460
REM F1E05470
TDOC STO ERASE SAVE BETA. F1E05480
LXD STPLOC,2 LOAD TSTOPS (ALPHA) TABLE WORD COUNT. F1E05490
TXL TDOE,2,0 *NO TABLE, CONTINUE WITH NONEXC. F1E05500
TDOD CAL **,2 GET A TSTOPS ENTRY. F1E05510
ANA ADMSK EXTRACT THE ALPHA. F1E05520
SUB ERASE SUBTRACT BETA. F1E05530
TZE TDOH *ARE THEY THE SAME, YES - ERROR. F1E05540
TIX TDOD,2,1 *NO, IS TSTOPS EXHAUSTED, NO CONTINUE. F1E05550
REM F1E05560
TDOE LXD NXCLOC,2 YES, LOAD NONEXC TABLE WORD COUNT. F1E05570
TXL TDOG,2,0 *NO TABLE, EXIT. F1E05580
CAL ERASE SOME TABLE, GET BETA. F1E05590
TDOF LAS **,2 DOES BETA MATCH NONEXC IFN. F1E05600
TRA *+2 NO. F1E05610
TRA TDOJ *YES, PROGRAMMER ERROR. F1E05620
TIX TDOF,2,1 *NO, IS NONEXC EXHAUSTED, NO CONTINUE. F1E05630
REM F1E05640
TDOG TIX TDOB,1,5 *IS TDO EXHAUSTED, NO CONTINUE. F1E05650
TRA FRETA *YES, GO TO THE FRET PROCESSOR. F1E05660
REM F1E05670
REM . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E05680
REM F1E05690
REM BETA IS A TIFGO STATEMENT. F1E05700
REM F1E05710
TDOH TSX NOBETA,4 GO TO DIAGNOSTIC SUBROUTINE TO ENTER F1E05720
OCT 1100 ERROR FLAG. F1E05730
TDOK LXD GOOFCT,4 LOAD ERROR COUNT. F1E05740
XEC TDOB GET THE FIRST WORD OF THIS TDO ENTRY. F1E05750
SLW ELSEBF,4 STORE IN ERROR LIST. F1E05760
TDOI CAL **,1 GET SECOND WORD OF TDO ENTRY (SYMBOL). F1E05770
SLW ELSEBF-1,4 STORE IN ERROR LIST. F1E05780
TXI *+1,4,2 UPDATE ERROR COUNT. F1E05790
SXD GOOFCT,4 SAVE NEW COUNT. F1E05800
TRA TDOG *TEST FOR END OF TABLE. F1E05810
REM F1E05820
REM . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E05830
REM F1E05840
REM BETA IS A NON-EXECUTABLE STATEMENT. F1E05850
REM F1E05860
TDOJ TSX NOBETA,4 GO TO DIAGNOSTIC SUBROUTINE TO ENTER F1E05870
OCT 1070 ERROR FLAG. F1E05880
TRA TDOK *CONTINUE BY USING TIFGO ERROR ROUTINE. F1E05890
REM F1E05900
REM *************************************************************F1E05910
REM F1E05920
REM FREQUENCY ROUTINE. F1E05930
REM CHECKS FOR FREQUENCIES SPECIFYING MORE F1E05940
REM BRANCHES THAN THERE ARE FOR THAT TYPE F1E05950
REM OF TIFGO STATEMENT. F1E05960
REM F1E05970
FRETA LXD FRTLOC,1 LOAD FRET TABLE WORD COUNT. F1E05980
REM F1E05990
REM F1E06020
TXL FINIS,1,0 *EXIT, NO TABLE. F1E06030
REM F1E06040
SLF MAKE SURE FLAG LITE IS OFF. F1E06050
STZ ALPHA RESET ALPHA CELL. F1E06060
LXA STPLOC,2 LOAD TSTOPS (ALPHA) TABLE ORIGIN, F1E06070
SXA FRETE,2 LAST ADDRESS PLUS ONE AND SET ROUTINE. F1E06080
LXA FRTLOC,2 LOAD LAST ADDRESS PLUS ONE FRET F1E06090
SXA FRETB,2 TABLE AND INITIALIZE ADDRESSES. F1E06100
SXA FRETC,2 F1E06110
REM F1E06120
FRETB CLA **,1 GET THE IFN OF A FRET ENTRY. F1E06130
STA ALPHA SAVE IT IN ALPHA. F1E06140
TXI *+1,1,-1 DECREMENT INDEX TO GET FREQUENCY. F1E06150
AXT 0,2 INITIALIZE BRANCH COUNTER. F1E06160
FRETC CLA **,1 GET NEXT WORD OF THE FRET TABLE. F1E06170
TMI FRETD *IS THIS BEGINNING OF NEW ENTRY, YES. F1E06180
TXI *+1,2,1 NO, INCREMENT COUNT OF BRANCHES. F1E06190
TIX FRETC,1,1 *IS FRET EXHAUSTED, NO CONTINUE. F1E06200
SLN 1 YES, SET END OF TABLE FLAG. F1E06210
FRETD LXD STPLOC,4 LOAD TSTOPS (ALPHA) TABLE WORD COUNT. F1E06220
TXL FINIS,4,0 *NO ALPHA TABLE, NO MORE WORK TO DO. F1E06230
FRETE CAL **,4 SOME TABLE, GET AN ENTRY. F1E06240
ANA ADMSK EXTRACT THE IFN (ALPHA). F1E06250
SUB ALPHA IS IT THE SAME AS THE ALPHA OF THIS F1E06260
TNZ FRETF *FREQUENCY STATEMENT. NO CONTINUE. F1E06270
XEC FRETE YES, RETRIEVE ENTRY. F1E06280
STD *+1 PICK UP BRANCH COUNT FOR THIS TIFGO. F1E06290
TXL FRETG,2,** DOES THE FRET ENTRY SPECIFY TOO MANY F1E06300
TSX NOBETA,4 BRANCHES. YES, GO TO DIAGNOSTIC. F1E06310
OCT 1172 ERROR FLAG. F1E06320
TRA FRETG *CONTINUE BELOW. F1E06330
REM F1E06340
FRETF TIX FRETE,4,1 *IS TSTOPS EXHAUSTED, NO CONTINUE. F1E06350
REM F1E06360
FRETG SLT 1 IS FRET EXHAUSTED. F1E06370
TRA FRETB *NO, GET NEXT FREQUENCY ENTRY. F1E06380
REM F1E06390
REM *************************************************************F1E06400
REM F1E06410
FINIS LXD GOOFCT,4 LOAD ERROR COUNT. F1E06420
TXH *+3,4,0 *ANY ERRORS TODAY, YES. F1E06430
REM F1E06440
TSX (LOAD),4 NO, GET SECTION 2. F1E06450
PZE F1E06460
REM F1E06470
SXD SOURCE+1,4 SAVE ERROR COUNT FOR GENERAL DIAGNOSTIC. F1E06480
CLA SOURCE+1 GET ORIGIN OF ERROR LIST. F1E06490
ADD L(A1) SET FOR TIX LOOP TO MOVE TEMPORARY LIST. F1E06500
STA *+2 F1E06510
CAL ELSEBF+1,4 MOVE ERROR LIST. F1E06520
SLW **,4 F1E06530
TIX *-2,4,1 F1E06540
TSX SOURCE,4 GET GENERAL DIAGNOSTIC. F1E06550
REM F1E06560
REM *************************************************************F1E06570
REM F1E06580
REM ERROR SUBROUTINE. F1E06590
REM F1E06600
ERROR SXA ERR01,2 SAVE INDEX. F1E06610
LXD GOOFCT,2 LOAD ERROR COUNT. F1E06620
CAL 1,4 GET ERROR FLAG. F1E06630
ALS 18 SHIFT TO DECREMENT FIELD. F1E06640
SLW ELSEBF,2 STORE IN ERROR LIST. F1E06650
STQ ELSEBF-1,2 STORE PERTINENT INFORMATION. F1E06660
TXI *+1,2,2 UPDATE ERROR COUNT. F1E06670
SXD GOOFCT,2 SAVE ERROR COUNT. F1E06680
ERR01 AXT **,2 RESTORE INDEX F1E06690
TRA 2,4 *RETURN TO CALLER. F1E06700
REM F1E06710
REM . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E06720
REM F1E06730
REM NOBETA SUBROUTINE. F1E06740
REM F1E06750
NOBETA SXA NBET1,2 SAVE INDEX. F1E06760
LXD GOOFCT,2 LOAD ERROR COUNT. F1E06770
CAL 1,4 GET ERROR FLAG. F1E06780
ALS 18 SHIFT TO DECREMENT FIELD. F1E06790
SLW ELSEBF,2 STORE IN ERROR LIST. F1E06800
CLA ALPHA GET ALPHA (IFN) OF THIS STATEMENT. F1E06810
STA ELSEBF,2 SAVE WITH ERROR FLAG. F1E06820
TXI *+1,2,1 UPDATE ERROR COUNT. F1E06830
SXD GOOFCT,2 SAVE ERROR COUNT. F1E06840
NBET1 AXT **,2 RESTORE INDEX. F1E06850
TRA 2,4 *RETURN TO CALLER. F1E06860
REM F1E06870
REM *************************************************************F1E06880
REM F1E06890
REM F1E07080
REM F1E07090
REM *************************************************************F1E07100
REM F1E07110
REM *** CONSTANTS AND ERASABLE *** F1E07120
REM F1E07130
BKSPX MZE 6,,1 COMMAND TO BACKSPACE TO FORVAL. F1E07131
FORVL BCI 1,FORVAL FORVAL LABEL. F1E07132
TRADL PZE TRADMX CONSTANT (MAXIMUM SIZE OF TRAD TABLE). F1E07140
OBETA PZE BETA ORIGIN OF BETA TABLE. F1E07150
NXFLG OCT 1360000000 NOT EXECUTABLE FLAG. F1E07160
L(D1) PZE ,,1 CONSTANT. F1E07170
L(D2) PZE ,,2 CONSTANT. F1E07180
L(A1) PZE 1 CONSTANT. F1E07190
ADMSK PZE -1 ADDRESS MASK. F1E07200
ALL1S SVN -1,7,-1 ERROR FLAG FOR EQUIT. F1E07210
REM F1E07220
ALPHA PZE **,,** IFN,,SOMETHING F1E07230
ERASA PZE **,,0 ADDRESS ERASABLE. F1E07240
ERASE PZE ** WHOLE WORD ERASABLE. F1E07250
REM F1E07260
REM *************************************************************F1E07270
REM F1E07280
PATC1 ANA ADMSK MASK ADDRESS. $F1E07281
TNZ TIF1C *DOES BETA EXIST, YES. $F1E07282
TRA TRA1+1 RETURN. $F1E07283
PATC2 ANA ADMSK MASK ADDRESS. $F1E07284
TNZ TIF2C *DOES BETA EXIST, YES. $F1E07285
TRA TRA2+1 RETURN. $F1E07286
BSS 1000 PATCH SPACE FOR I DOUBLE PRIME. F1E07290
REM F1E07300
REM *************************************************************F1E07310
REM F1E07320
BETA SYN * ORIGIN FOR BETA TABLE F1E07330
EJECT F1E07350
END -1 F1E07351