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