Personal tools
You are here: Home Projects FORTRAN and FORTRAN II Source Code ibsys FORTRAN 32K 709/7090 FORTRAN - SECTION ONE, ONE PRIME, ONE DOUBLE PRIME (RECORDS 13-17)
Document Actions

32K 709/7090 FORTRAN - SECTION ONE, ONE PRIME, ONE DOUBLE PRIME (RECORDS 13-17)

by Paul McJones last modified 2005-06-01 20:11

Click here to get the file

Size 924.8 kB - File type text/plain

File contents

$JOB   ASSEMBLY OF MONITOR, COMPILER SECTIONS 1 THROUGH 6 OF           $00000010
$*     FORTRAN II PROCESSOR, 7090-FO-928                                00000020
$*     VERSION 3, MODIFICATION LEVEL 35                             (35)00000030
$EXECUTE       IBSFAP                                                  $00000050
*      32K 709/7090 FORTRAN SECTION ONE                                 F1A00010
*     FAP                                                               F1A00020
*      SECTIONS ONE, ONE PRIME, ONE DOUBLE PRIME (RECORDS 13-17)        F1A00030
       COUNT   12000                                                    F1A00050
       ABS                                                              F1A00060
       REM                                                              F1A00070
       REM SECTION 1= READS IN AND CLASSIFIES STATEMENTS. FOR ARITHMETICF1A00080
       REM FORMULAS, COMPILES THE OBJECT (OUTPUT) INSTRUCTIONS. FOR     F1A00090
       REM NONARITHMETIC STATEMENTS INCLUDING INPUT-OUTPUT, DOES A      F1A00100
       REM PARTIAL COMPILATION, AND RECORDS THE REMAINING INFORMATION   F1A00110
       REM IN TABLES.                                                   F1A00120
       REM                                                              F1A00130
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A00140
       REM                                                              F1A00150
       SST     FORTRAN                                                 $F1A00151
       REM                                                              F1A00160
       REM SYNONYMS USED BY SECTION ONE.                                F1A00170
A      EQU 1                                                            F1A00180
B      EQU 2                                                            F1A00190
C      EQU 4                                                            F1A00200
 ..    EQU  0                                                           F1A00210
       REM                                                              F1A00220
TAGA   SYN     4                                                        F1A00230
TAGB   SYN     2                                                        F1A00240
TAGC   SYN     4                                                        F1A00250
       REM                                                              F1A00260
       REM                                                              F1A00270
       REM     PARAMETERS VARIABLE AT ASSEMBLY TIME                     F1A00280
       REM                                                              F1A00290
TMFACT SYN     7             CONSTANT FOR EXPANDING TABLE SIZES.       $F1A00300
TNFACT SYN     8             CONSTANT FOR REDUCING TABLE SIZES         $F1A00310
BMFACT SYN     7                                                       $F1A00320
BNFACT SYN     8                                                       $F1A00330
AMFACT SYN     7                                                       $F1A00340
ANFACT SYN     8                                                       $F1A00350
       REM                                                              F1A00360
TOPTAB SYN     BOTIOP-1       TOP OF AVAILABLE MEMORY.                  F1A00370
BOTMEM SYN     BOTTOM         BOTTOM OF AVAILABLE MEMORY.               F1A00380
       TITLE                                                           $F1A00385
       EJECT                                                            F1A01150
       REM                                                              F1A01160
       REM     DEFINITIONS OF TAPES FOR DUMPING THE CORE BUFFERS.       F1A01170
       REM                                                              F1A01180
CITTAP SYN     2              COMPAIL TAPE ADDRESS.                     F1A01190
TEIFTP SYN     3              TEIFNO.                                   F1A01200
DOLPTP SYN     3              TDO.                                      F1A01210
TIFGTP SYN     3              TIFGO.                                    F1A01220
TRADTP SYN     3              TRAD.                                     F1A01230
FRTGTP SYN     3              FORTAG.                                   F1A01240
FRVRTP SYN     3              FORVAR.                                   F1A01250
FRVLTP SYN     3              FORVAL.                                   F1A01260
FRETTP SYN     3              FRET.                                     F1A01270
EQITTP SYN     3              EQUIT.                                    F1A01280
CLSBTP SYN     3              CLOSUB.                                   F1A01290
FRMTTP SYN     3              FORMAT.                                   F1A01300
SBDFTP SYN     3              SUBDEF.                                   F1A01310
CMMNTP SYN     3              COMMON.                                   F1A01320
HLRGTP SYN     3              HOLARG.                                   F1A01330
NONXTP SYN     3              NONEXC.                                   F1A01340
STOPTP SYN     3              TSTOPS.                                   F1A01350
CALLTP SYN     3              CALLFN.                                   F1A01360
FMTNTP SYN     3              FMTEFN.                                   F1A01370
ENDITP SYN     3              ENDI.                                     F1A01380
INPUTP SYN     2              BCD INPUT TAPE.                           F1A01390
EXEQTP SYN     4              EXECUTABLE STATEMENT INTERMEDIATE TAPE.   F1A01400
BUFTAP SYN     3              CORE BUFFER DUMP TAPE.                    F1A01410
TABTAP SYN     2              TABLE TAPE.                               F1A01420
       EJECT                                                            F1A01430
       REM     DEFINITIONS OF MAXIMUM SIZES FOR TAPE TABLES.            F1A01440
       REM                                                              F1A01450
FRMTMX SYN     6000*TMFACT/TNFACT  NUMBER OF BCD WORDS IN FORMAT STATS. F1A01460
CLSBMX SYN     6000*TMFACT/TNFACT  NUMBER OF SUBPROGRAMS.               F1A01470
NONXMX SYN     1200*TMFACT/TNFACT  NUMBER OF NON-EXECUTABLE STATEMENTS. F1A01480
STOPMX SYN     1200*TMFACT/TNFACT  NUMBER OF STOP AND RETURN STATEMENTS.F1A01490
FMTNMX SYN     2000*TMFACT/TNFACT  NUMBER OF REFERENCES TO FORMAT STATS.F1A01500
CALLMX SYN     2400*TMFACT/TNFACT  NUMBER OF CALL STATEMENTS. (FUNCTION)F1A01510
HLRGMX SYN     3600*TMFACT/TNFACT  NUMBER OF BCD WORDS USED AS HOLERITH F1A01520
       REM                         ARGUMENTS FOR SUBROUTINES.           F1A01530
DOLPMX SYN     600*TMFACT/TNFACT   NUMBER OF DO LOOPS.                  F1A01540
FRVLMX SYN     2000*TMFACT/TNFACT  NUMBER OF FIXED POINT VARIABLES (N-S)F1A01550
       REM                         APPEARING TO THE LEFT OF EQUAL SIGNS.F1A01560
FRVRMX SYN     3000*TMFACT/TNFACT  NUMBER OF FIXED POINT VARIABLES (N-S)F1A01570
       REM                         APPEARING TO THE RIGHT OF EQUAL SIGNSF1A01580
FRTGMX SYN     6000*TMFACT/TNFACT  NUMBER OF I-TAU TAGS.                F1A01590
FRSBMX SYN     200*TMFACT/TNFACT   NUMBER OF ARITHMETIC STAT. FUNCTIONS.F1A01600
SBDFMX SYN     180*TMFACT/TNFACT   NUMBER OF SUBPROGRAM DEFINITIONS.    F1A01610
TIFGMX SYN     1200*TMFACT/TNFACT  NUMBER OF IF AND GO TO STATEMENTS.   F1A01620
TRADMX SYN     1000*TMFACT/TNFACT  NUMBER OF BRANCHES IN COMPUTED AND   F1A01630
       REM                         ASSIGNED GO TO'S.                    F1A01640
TEIFMX SYN     3000*TMFACT/TNFACT  NUMBER EXTERNAL FORMULA NUMBERS.     F1A01650
CMMNMX SYN     6000*TMFACT/TNFACT  NUMBER OF COMMON VARIABLES.          F1A01660
FRETMX SYN     3000*TMFACT/TNFACT  NUMBER OF FREQUENCY ESTIMATES.       F1A01670
EQITMX SYN     3000*TMFACT/TNFACT  NUMBER OF EQUIVALENCED VARIABLES.    F1A01680
ENDIMX SYN     36                  NUMBER OF END CARD SETTINGS.         F1A01690
FLCNMX SYN     1800*TMFACT/TNFACT  NUMBER OF FLOATING POINT VARIABLES.  F1A01700
FXCNMX SYN     400*TMFACT/TNFACT   NUMBER OF FIXED POINT VARIABLES.     F1A01710
TAU1MX SYN     400*TMFACT/TNFACT   NUMBER OF 1 DIMENSIONAL SYMBOLIC TAGSF1A01720
TAU2MX SYN     360*TMFACT/TNFACT   NUMBER OF 2 DIMENSIONAL SYMBOLIC TAGSF1A01730
TAU3MX SYN     300*TMFACT/TNFACT   NUMBER OF 3 DIMENSIONAL SYMBOLIC TAGSF1A01740
DIM1MX SYN     400*TMFACT/TNFACT   NUMBER OF ARRAYS OF 1 DIMENSION.     F1A01750
DIM2MX SYN     400*TMFACT/TNFACT   NUMBER OF ARRAYS OF 2 DIMENSIONS.    F1A01760
DIM3MX SYN     360*TMFACT/TNFACT   NUMBER OF ARRAYS OF 3 DIMENSIONS.    F1A01770
DLT1MX SYN     150*TMFACT/TNFACT   NUMBER OF DP-CA ARRAYS.              F1A01780
DLT2MX SYN     400*TMFACT/TNFACT   NUMBER OF DP-CA NON-SUBSCRIPTED      F1A01790
       REM                         VARIABLES.                           F1A01800
       REM                                                              F1A01810
       EJECT                                                            F1A01820
       REM     DEFINITIONS OF MAXIMUM SIZES FOR TABLE BUFFERS.          F1A01830
       REM                                                              F1A01840
FREGSZ SYN     111            SIZE OF FORMULA REGION.                   F1A01850
FTBFSZ SYN     12             FT BUFFER LENGTH.                         F1A01860
CITSIZ SYN     200            LENGTH OF EACH CIT BUFFER.                F1A01870
BOLSIZ SYN     19             LENGTH OF BOOLEAN OPERATION CODE TABLE.   F1A01880
BFSZ   SYN     4000*BMFACT/BNFACT  TEMPORARY FORMAT BUFFER.             F1A01890
FRMTSZ SYN     200*BMFACT/BNFACT   FORMAT.                              F1A01900
CLSBSZ SYN     200*BMFACT/BNFACT   CLOSUB.                              F1A01910
NONXSZ SYN     250*BMFACT/BNFACT   NONEXC.                              F1A01920
STOPSZ SYN     100*BMFACT/BNFACT   TSTOPS.                              F1A01930
FMTNSZ SYN     200*BMFACT/BNFACT   FMTEFN.                              F1A01940
CALLSZ SYN     200*BMFACT/BNFACT   CALLFN.                              F1A01950
HLRGSZ SYN     200*BMFACT/BNFACT   HOLARG.                              F1A01960
DOLPSZ SYN     100*BMFACT/BNFACT   TDO.                                 F1A01970
FRVLSZ SYN     150*BMFACT/BNFACT   FORVAL.                              F1A01980
FRVRSZ SYN     300*BMFACT/BNFACT   FORVAR.                              F1A01990
FRTGSZ SYN     600*BMFACT/BNFACT   FORTAG.                              F1A02000
DLT1SZ SYN     DLT1MX              DLST1 (SIZ).                         F1A02010
DLT2SZ SYN     DLT2MX              DLST2 (SIZ).                         F1A02020
DIM1SZ SYN     DIM1MX              DIM1 (SIZ).                          F1A02030
DIM2SZ SYN     DIM2MX              DIM2 (SIZ).                          F1A02040
DIM3SZ SYN     DIM3MX              DIM3 (SIZ).                          F1A02050
FLCNSZ SYN     FLCNMX              FLOCON.                              F1A02060
FXCNSZ SYN     FXCNMX              FIXCON.                              F1A02070
TAU1SZ SYN     TAU1MX              TAU1 (I-TAU).                        F1A02080
TAU2SZ SYN     TAU2MX              TAU2 (I-TAU).                        F1A02090
TAU3SZ SYN     TAU3MX              TAU3 (I-TAU).                        F1A02100
FRSBSZ SYN     FRSBMX              FORSUB.                              F1A02110
SBDFSZ SYN     SBDFMX              SUBDEF.                              F1A02120
TRADSZ SYN     250*BMFACT/BNFACT   TRAD.                                F1A02130
TIFGSZ SYN     300*BMFACT/BNFACT   TIFGO.                               F1A02140
TEIFSZ SYN     600*BMFACT/BNFACT   TEIFNO.                              F1A02150
CMMNSZ SYN     800*BMFACT/BNFACT   COMMON.                              F1A02160
FRETSZ SYN     100*BMFACT/BNFACT   FRET.                                F1A02170
EQITSZ SYN     350*BMFACT/BNFACT   EQUIT.                               F1A02180
ENDISZ SYN     ENDIMX              END.                                 F1A02190
ELSESZ SYN     3                   COMPENSATING VARIABLE.               F1A02200
OTHRSZ SYN     0                   COMPENSATING VARIABLE.               F1A02210
       REM                                                              F1A02220
       REM                                                              F1A02230
       REM                                                              F1A02240
       REM     DEFINITIONS OF MAXIMUM SIZES FOR INTERNAL TABLES.        F1A02250
       REM                                                              F1A02260
LAMBSZ SYN     4800*AMFACT/ANFACT  LAMBDA.                              F1A02270
SCRPSZ SYN     LAMBSZ/2            OPTIMIZED LAMBDA.                    F1A02280
ALPHSZ SYN     556*AMFACT/ANFACT   ALPHA.                               F1A02290
BETASZ SYN     LAMBSZ/4            BETA.                                F1A02300
SGMASZ SYN     120*AMFACT/ANFACT   SIGMA1.                              F1A02310
RGRGSZ SYN     200*AMFACT/ANFACT   ARGREG.                              F1A02320
       REM                                                              F1A02330
       EJECT                                                            F1A02340
       REM     DEFINITION OF ORIGIN FOR TABLES AND BUFFERS (TABORG).    F1A02350
       REM                                                              F1A02360
TABLSA SYN     6*TAU3SZ+4*TAU2SZ+2*TAU1SZ+1+FXCNSZ+FLCNSZ               F1A02370
TABLSB SYN     2*DLT1SZ+DLT2SZ+2*DIM1SZ+2*DIM2SZ+3*DIM3SZ               F1A02380
TABLSC SYN     LAMBSZ+BETASZ+SGMASZ                                     F1A02390
TABLSD SYN     CLSBSZ+SBDFSZ+ELSESZ                                     F1A02400
TABLSE SYN     NONXSZ+STOPSZ+FRETSZ+FRMTSZ+2*TIFGSZ+TRADSZ+5*DOLPSZ     F1A02410
TABLSF SYN     TEIFSZ+2*FRSBSZ+HLRGSZ+FMTNSZ+ENDISZ+CMMNSZ              F1A02420
TABLSG SYN     2*FRVRSZ+2*FRVLSZ+FRTGSZ+2*EQITSZ+CALLSZ+OTHRSZ+2        F1A02430
TABLSH SYN     TABLSA+TABLSB+TABLSC+TABLSD+TABLSE+TABLSF+TABLSG         F1A02440
       REM                                                              F1A02450
TABORG SYN     TOPTAB-TABLSH  ORIGIN FOR TABLE BUFFERS.                 F1A02460
       TTL * SECTION ONE * COMMON BLOCK * RECORD 9F13 *                 F1A02550
       REM                                                              F1A02570
       ORG     SYSCUR                                                  $F1A02580
       LBL     9F13,THE WORKS                                           F1A02590
       BCI     1,9F1300                                                $F1A02600
       ORG     (LODR)                                                  $F1A02610
       TXI     INITIL,,130             ENTRY POINT,,RECORD NUMBER       F1A02620
       REM                                                              F1A02630
       REM                                                              F1A02640
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A02650
       REM                                                              F1A02660
       ABS                                                              F1A02670
ORGONE ORG     BOTMEM                                                   F1A02680
       REM                                                              F1A02690
       REM TABLE PARAMETERS FOR CORE AND TAPE TABLES GENERATED BY       F1A02700
       REM SECTION ONE.                                                 F1A02710
       REM                                                              F1A02720
       REM     PARAMETERS FOR USE BY SECTION 1 PRIME AND 1 DOUBLE PRIME.F1A02730
       REM                                                              F1A02740
       REM                                                              F1A02750
       REM WORD CONTAINING LAST EXTERNAL FORMULA NUMBER AND LAST        F1A02760
       REM INTERNAL FORMULA NUMBER.                                     F1A02770
EIFNO  PZE **,,**                    EXTERNAL,,INTERNAL FORMULA NUMBER. F1A02780
       REM                                                              F1A02790
EIFLOC PZE     **,TAGC,**     LOCATION OF TEIFNO TABLE,,WORD COUNT      F1A02800
TIFLOC PZE     **,TAGB,**     LOCATION OF TIFGO  TABLE,,WORD COUNT      F1A02810
TRDLOC PZE     **,TAGB,**     LOCATION OF TRAD   TABLE,,WORD COUNT      F1A02820
TDOLOC PZE     **,TAGB,**     LOCATION OF TDO    TABLE,,WORD COUNT      F1A02830
FRTLOC PZE     **,TAGB,**     LOCATION OF FRET   TABLE,,WORD COUNT      F1A02840
EQTLOC PZE     **,TAGB,**     LOCATION OF EQUIT  TABLE,,WORD COUNT      F1A02850
NXCLOC PZE     **,TAGC,**     LOCATION OF NONEXC TABLE,,WORD COUNT      F1A02860
STPLOC PZE     **,TAGC,**     LOCATION OF TSTOPS TABLE,,WORD COUNT      F1A02870
       REM                                                              F1A02880
ONLINE PZE     **,,**         ON-LINE INDICATOR,,LOCATION OF CALL.      F1A02890
       REM                                                              F1A02900
       REM PARAMETER FOR THE FORSUB TABLE.                              F1A02910
BK     PZE **,,**                    FORSUB COUNTER.                    F1A02920
       REM                                                              F1A02930
       REM PARAMETER  FOR THE COMPAIL (CIT) TABLE .                     F1A02940
CITCNT PZE     **,,-20        COUNT OF REC. ON TAPE,,BUFFER INCREMENT  $F1A02950
       REM                                                              F1A02960
XEQCTR PZE     **             COUNT OF EXECUTABLE STATEMENTS.           F1A02970
       REM                                                              F1A02980
DGFLAG PZE     **             SIGNAL FOR PRIOR DIAGNOSTIC CALL.         F1A02990
       REM                                                              F1A03000
       EJECT                                                            F1A03010
       REM PARAMETERS FOR ALL TAPE TABLES EXCEPT COMPAIL (CIT)          F1A03020
       REM GENERATED BY SECTION ONE.                                    F1A03030
       REM ENTRIES ARE MADE IN THESE TABLES BY THE TET00 SUBROUTINE IN  F1A03040
       REM SECTION ONE.                                                 F1A03050
       REM THE TAP00 SUBROUTINE IN SECTION ONE PRIME ASSEMBLES THE      F1A03060
       REM FRAGMENTS OF A GIVEN TABLE INTO AN ENTITY FOR LATER SECTIONS.F1A03070
       REM                                                              F1A03080
       REM EACH TABLE HAS AN IDENTIFICATION NUMBER WHICH IS ALSO AN     F1A03090
       REM INDEX TO ITS SET OF PARAMETERS IN THE FOLLOWING LIST. WHERE  F1A03100
       REM                           O = ORIGIN OF TABLE BUFFER,        F1A03110
       REM                           B = BUFFER CAPACITY,               F1A03120
       REM                           A = ADDRESS OF TABLE ENTRY,        F1A03130
       REM                           E = ENTRY LENGTH IN WORDS,         F1A03140
       REM                           C = COUNT OF BLOCKS PUT ON TAPE,   F1A03150
       REM                           P = PORTION OF BUFFER THAT IS FULL.F1A03160
       REM                           T = TAPE FOR DUMPING BUFFERS.      F1A03170
       REM                           X = MARKS THE SPOT FOR ASSEMBLING  F1A03180
       REM                               THE TABLE IN SECTION I PRIME.  F1A03190
       REM                           M = MAXIMUM TABLE SIZE.            F1A03200
       REM                           N = NUMBER OF WORDS IN TABLE.      F1A03210
       REM                           L = LABEL ATTACHED TO THIS TABLE.  F1A03220
       REM                                                              F1A03230
INTETX PZE     TEIFBF,TAGA,**        00) O,,P                           F1A03240
       PZE     EIFNO+1,TAGB,1            A,,E                           F1A03250
       PZE     TEIFSZ,,TEIFTP            B,,T                           F1A03260
INTETA PZE     TEIFNO,TAGC,TEIFMX        X,,M                           F1A03270
       PZE     **,,**                    C,,N                           F1A03280
       BCI     1,TEIFNO                  L                              F1A03290
       REM                                                              F1A03300
       PZE     DOLPBF,TAGA,**        01) O,,P                           F1A03310
       PZE     1C+5,TAGB,5               A,,E                           F1A03320
       PZE     DOLPSZ*5,,DOLPTP          B,,T                           F1A03330
INTETB PZE     TDOTAB,TAGC,DOLPMX*5      X,,M                           F1A03340
       PZE     **,,**                    C,,N                           F1A03350
       BCI     1,TDO                     L                              F1A03360
       REM                                                              F1A03370
       PZE     TIFGBF,TAGA,**        02) O,,P                           F1A03380
       PZE     1C+2,TAGB,2               A,,E                           F1A03390
       PZE     TIFGSZ*2,,TIFGTP          B,,T                           F1A03400
INTETC PZE     TIFGOT,TAGC,TIFGMX*2      X,,M                           F1A03410
       PZE     **,,**                    C,,N                           F1A03420
       BCI     1,TIFGO                   L                              F1A03430
       REM                                                              F1A03440
       PZE     TRADBF,TAGA,**        03) O,,P                           F1A03450
       PZE     1G+1,TAGB,1               A,,E                           F1A03460
       PZE     TRADSZ,,TRADTP            B,,T                           F1A03470
INTETD PZE     TRADTB,TAGC,TRADMX        X,,M                           F1A03480
       PZE     **,,**                    C,,N                           F1A03490
       BCI     1,TRAD                    L                              F1A03500
       REM                                                              F1A03510
       PZE     FRTGBF,TAGA,**        04) O,,P                           F1A03520
       PZE     G+1,TAGB,1                A,,E                           F1A03530
       PZE     FRTGSZ,,FRTGTP            B,,T                           F1A03540
INTETE PZE     FORTAG,TAGC,FRTGMX        X,,M                           F1A03550
       PZE     **,,**                    C,,N                           F1A03560
       BCI     1,FORTAG                  L                              F1A03570
       REM                                                              F1A03580
       PZE     FRVRBF,TAGA,**        05) O,,P                           F1A03590
       PZE     G+2,TAGB,2                A,,E                           F1A03600
       PZE     FRVRSZ*2,,FRVRTP          B,,T                           F1A03610
INTETF PZE     FORVAR,TAGC,FRVRMX*2      X,,M                           F1A03620
       PZE     **,,**                    C,,N                           F1A03630
       BCI     1,FORVAR                  L                              F1A03640
       REM                                                              F1A03650
       PZE     FRVLBF,TAGA,**        06) O,,P                           F1A03660
       PZE     G+2,TAGB,2                A,,E                           F1A03670
       PZE     FRVLSZ*2,,FRVLTP          B,,T                           F1A03680
INTETG PZE     FORVAL,TAGC,FRVLMX*2      X,,M                           F1A03690
       PZE     **,,**                    C,,N                           F1A03700
       BCI     1,FORVAL                  L                              F1A03710
       REM                                                              F1A03720
       PZE     FRETBF,TAGA,**        07) O,,P                           F1A03730
       PZE     1G+1,TAGB,1               A,,E                           F1A03740
       PZE     FRETSZ,,FRETTP            B,,T                           F1A03750
INTETH PZE     FRETTB,TAGC,FRETMX        X,,M                           F1A03760
       PZE     **,,**                    C,,N                           F1A03770
       BCI     1,FRET                    L                              F1A03780
       REM                                                              F1A03790
       PZE     EQITBF,TAGA,**        08) O,,P                           F1A03800
       PZE     1C+2,TAGB,2               A,,E                           F1A03810
       PZE     EQITSZ*2,,EQITTP          B,,T                           F1A03820
INTETI PZE     EQUITT,TAGC,EQITMX*2      X,,M                           F1A03830
       PZE     **,,**                    C,,N                           F1A03840
       BCI     1,EQUIT                   L                              F1A03850
       REM                                                              F1A03860
CLSBCN PZE     CLSBBF,TAGA,1         09( O,,P                           F1A03870
       PZE     G+1,TAGB,1                A,,E                           F1A03880
       PZE     CLSBSZ,,CLSBTP            B,,T                           F1A03890
INTETJ PZE     CLOSUB,TAGC,CLSBMX        X,,M                           F1A03900
       PZE     **,,**                    C,,N                           F1A03910
       BCI     1,CLOSUB                  L                              F1A03920
       REM                                                              F1A03930
       REM     THE CLOSUB TABLE HAS ONE PRESET ENTRY OF (FPT).          F1A03940
       REM     (FPT) IS A FLOATING POINT TRAP SUBROUTINE CALLED FOR     F1A03950
       REM     BY MAIN PROGRAMS COMPILED BY FORTRAM.                    F1A03960
       REM                                                              F1A03970
       PZE     FRMTBF,TAGA,**        10) O,,P                           F1A03980
       PZE     G+1,TAGB,1                A,,E                           F1A03990
       PZE     BFSZ,,FRMTTP              B,,T                           F1A04000
INTETK PZE     FORMAT,TAGC,FRMTMX        X,,M                           F1A04010
       PZE     **,,**                    C,,N                           F1A04020
       BCI     1,FORMAT                  L                              F1A04030
       REM                                                              F1A04040
SBDFCN PZE     SBDFBF,TAGA,**        11) O,,P                           F1A04050
       PZE     1G+1,TAGB,1               A,,E                           F1A04060
       PZE     SBDFSZ,,SBDFTP            B,,T                           F1A04070
INTETL PZE     SUBDEF,TAGC,SBDFMX        X,,M                           F1A04080
       PZE     **,,**                    C,,N                           F1A04090
       BCI     1,SUBDEF                  L                              F1A04100
       REM                                                              F1A04110
       PZE     CMMNBF,TAGA,**        12) O,,P                           F1A04120
       PZE     1G+1,TAGB,1               A,,E                           F1A04130
       PZE     CMMNSZ,,CMMNTP            B,,T                           F1A04140
INTETM PZE     COMMON,TAGC,CMMNMX        X,,M                           F1A04150
       PZE     **,,**                    C,,N                           F1A04160
       BCI     1,COMMON                  L                              F1A04170
       REM                                                              F1A04180
       PZE     HLRGBF,TAGA,**        13) O,,P                           F1A04190
       PZE     1G+1,TAGB,1               A,,E                           F1A04200
       PZE     HLRGSZ,,HLRGTP            B,,T                           F1A04210
INTETN PZE     HOLARG,TAGC,HLRGMX        X,,M                           F1A04220
       PZE     **,,**                    C,,N                           F1A04230
       BCI     1,HOLARG                  L                              F1A04240
       REM                                                              F1A04250
       PZE     NONXBF,TAGA,**        14) O,,P                           F1A04260
       PZE     EIFNO+1,TAGB,1            A,,E                           F1A04270
       PZE     NONXSZ,,NONXTP            B,,T                           F1A04280
INTETO PZE     NONEXC,TAGC,NONXMX        X,,M                           F1A04290
       PZE     **,,**                    C,,N                           F1A04300
       BCI     1,NONEXC                  L                              F1A04310
       REM                                                              F1A04320
       PZE     STOPBF,TAGA,**        15) O,,P                           F1A04330
       PZE     EIFNO+1,TAGB,1            A,,E                           F1A04340
       PZE     STOPSZ,,STOPTP            B,,T                           F1A04350
INTETP PZE     TSTOPS,TAGC,STOPMX        X,,M                           F1A04360
       PZE     **,,**                    C,,N                           F1A04370
       BCI     1,TSTOPS                  L                              F1A04380
       REM                                                              F1A04390
       PZE     CALLBF,TAGA,**        16) O,,P                           F1A04400
       PZE     CALLNM+1,TAGB,1           A,,E                           F1A04410
       PZE     CALLSZ,,CALLTP            B,,T                           F1A04420
INTETQ PZE     CALLFN,TAGC,CALLMX        X,,M                           F1A04430
       PZE     **,,**                    C,,N                           F1A04440
       BCI     1,CALLFN                  L                              F1A04450
       REM                                                              F1A04460
       PZE     FMTNBF,TAGA,**        17) O,,P                           F1A04470
       PZE     SET+1,TAGB,1              A,,E                           F1A04480
       PZE     FMTNSZ,,FMTNTP            B,,T                           F1A04490
INTETR PZE     FMTEFN,TAGC,FMTNMX        X,,M                           F1A04500
       PZE     **,,**                    C,,N                           F1A04510
       BCI     1,FMTEFN                  L                              F1A04520
       REM                                                              F1A04530
       PZE                           18) O,,P     TSKIPS TABLE.         F1A04540
       PZE                               A,,E     NOT USED IN           F1A04550
       PZE                               B,,T     709/7090              F1A04560
       PZE                               X,,M     FORTRAN.              F1A04570
       PZE                               C,,N                           F1A04580
       BCI     1,                        L                              F1A04590
       REM                                                              F1A04600
ENDICN PZE     ENDIBF,TAGA,**        19) O,,P                           F1A04610
       PZE     G+1,TAGB,1                A,,E                           F1A04620
       PZE     ENDISZ,,ENDITP            B,,T                           F1A04630
INTETT PZE     ENDTAB,TAGC,ENDIMX        X,,M                           F1A04640
       PZE     **,,**                    C,,N                           F1A04650
       BCI     1,END                     L                              F1A04660
       REM                                                              F1A04670
       BSS     6              EXPANSION SPACE.                          F1A04680
       EJECT                                                            F1A04690
       REM PARAMETERS FOR ALL CORE TABLES WHICH ARE GENERATED AND       F1A04700
       REM SEARCHED BY THE TBSR00 (TABLE SEARCH) SUBROUTINE.            F1A04710
       REM ALL OF THESE TABLES AND THEIR PARAMETERS EXCEPT SIGMA ARE    F1A04720
       REM LEFT IN CORES FOR SECTION ONE PRIME.                         F1A04730
       REM                                                              F1A04740
       REM                                                              F1A04750
       REM ENTRY TO THE TBSR00 ROUTINE IS BY TSX TO ....IX WHERE ....IX F1A04760
       REM IS THE LAST WORD OF THE BLOCK OF PARAMETERS ASSOCIATED WITH  F1A04770
       REM A GIVEN TABLE. THE PARAMETERS ARE...                         F1A04780
       REM                           ***  = TXH/TXL OP SWITCH FOR DIMS, F1A04790
       REM                           ARG1 = LOCATION OF 1ST ARGUMENT,   F1A04800
       REM                           L    = LENGTH OF ARGUMENT,         F1A04810
       REM                           NCA  = NEXT CORE ADDRESS,          F1A04820
       REM                           N    = CURRENT NUMBER OF ENTRIES,  F1A04830
       REM                           FCA  = 1ST CORE ADDRESS,           F1A04840
       REM                           J    = MAXIMUM NUMBER OF ENTRIES,  F1A04850
       REM                           EP   = ENTRY POINT TO TBSR00.      F1A04860
       REM                           ID   = IDENTIFICATION FOR DIAG.    F1A04870
       REM                                                              F1A04880
       REM                                                              F1A04890
       TXL G+1,,1                    FXCN) *** ARG1,,L                  F1A04900
       PZE FXCNBF+1,,**                        NCA,,N                   F1A04910
       PZE FXCNBF,,FXCNSZ                      FCA,,J                   F1A04920
FXCNIX TXI TBSR00,0,-11                    TXI EP,,ID                   F1A04930
       REM                                                              F1A04940
       TXL G+1,,1                    FLCN) *** ARG1,,L                  F1A04950
       PZE FLCNBF+1,,**                        NCA,,N                   F1A04960
       PZE FLCNBF,,FLCNSZ                      FCA,,J                   F1A04970
FLCNIX TXI     CORR01,0,-10                TXI EP,,ID                   F1A04980
       REM                                                              F1A04990
       TXL E+3+2,,2                  TAU1) *** ARG1,,L                  F1A05000
       PZE TAU1BF+2,,**                        NCA,,N                   F1A05010
       PZE TAU1BF,,TAU1SZ                      FCA,,J                   F1A05020
TAU1IX TXI TBSR00,0,-9                     TXI EP,,ID                   F1A05030
       REM                                                              F1A05040
       TXL E+3+4,,4                  TAU2) *** ARG1,,L                  F1A05050
       PZE TAU2BF+4,,**                        NCA,,N                   F1A05060
       PZE TAU2BF,,TAU2SZ                      FCA,,J                   F1A05070
TAU2IX TXI TBSR00,0,-8                     TXI EP,,ID                   F1A05080
       REM                                                              F1A05090
       TXL E+3+6,,6                  TAU3) *** ARG1,,L                  F1A05100
       PZE TAU3BF+6,,**                        NCA,,N                   F1A05110
       PZE TAU3BF,,TAU3SZ                      FCA,,J                   F1A05120
TAU3IX TXI TBSR00,0,-7                     TXI EP,,ID                   F1A05130
       REM                                                              F1A05140
TXLOP  TXL E+11+1,,1                 SIG1) *** ARG1,,L                  F1A05150
       PZE **,,**                              NCA,,N                   F1A05160
       PZE SIGMA1,,SGMASZ                      FCA,,J                   F1A05170
SIG1IX TXI TBSR00,0,-6                     TXI EP,,ID                   F1A05180
       REM                                                              F1A05190
TXHOP  TXH 1C+2,,2                   DIM1) *** ARG1,,L                  F1A05200
       PZE DIM1BF+2,,**                        NCA,,N                   F1A05210
ORGDM1 PZE DIM1BF,,DIM1SZ                      FCA,,J                   F1A05220
DIM1IX TXI TBSR00,0,-3                     TXI EP,,ID                   F1A05230
       REM                                                              F1A05240
       TXH 1C+2,,2                   DIM2) *** ARG1,,L                  F1A05250
       PZE DIM2BF+2,,**                        NCA,,N                   F1A05260
ORGDM2 PZE DIM2BF,,DIM2SZ                      FCA,,J                   F1A05270
DIM2IX TXI TBSR00,0,-2                     TXI EP,,ID                   F1A05280
       REM                                                              F1A05290
       TXH 1C+3,,3                   DIM3) *** ARG1,,L                  F1A05300
       PZE DIM3BF+3,,**                        NCA,,N                   F1A05310
       PZE DIM3BF,,DIM3SZ                      FCA,,J                   F1A05320
DIM3IX TXI TBSR00,0,-1                     TXI EP,,ID                   F1A05330
       REM                                                              F1A05340
       TXH     1C+2,,2                     DLT1) *** ARG1,,L            F1A05350
       PZE     DLT1BF+2,,**                          NCA,,N             F1A05360
       PZE     DLT1BF,,DLT1SZ                        FCA,,J             F1A05370
DLIST1 TXI     TBSR00,,-12                       TXI EP,,ID             F1A05380
       REM                                                              F1A05390
       TXL E+3,,1                          DLT2) *** ARG1,,L            F1A05400
       PZE DLT2BF+1,,**                              NCA,,N             F1A05410
       PZE DLT2BF,,DLT2SZ                            FCA,,J             F1A05420
DLIST2 TXI TBSR00,0,-13                          TXI EP,,ID             F1A05430
       REM                                                              F1A05440
       BSS     4              EXPANSION SPACE.                          F1A05450
       REM                                                              F1A05460
       REM TEST FOR IMPROPERLY WRITTEN COMPLEX CONSTANT WHICH IS        F1A05470
       REM ABOUT TO BE ENTERED AS A SINGLE PRECISION STANDARD           F1A05480
       REM FORTRAN CONSTANT.                                            F1A05490
CORR01 CLA     MODECL                                                   F1A05500
       SUB     L(I)          TEST FOR CA MODE                           F1A05510
       TNZ     TBSR00        NO, CONTINUE                               F1A05520
       TRA     ICM6          YES, ERROR, GO TO DIAGNOSTIC               F1A05530
       EJECT                                                            F1A05540
       REM     MACHINE ERROR CALLS TO DIAGNOSTIC.                       F1A05550
       REM                                                              F1A05560
       REM                                                              F1A05570
MRTN77 TXI     (DIAG),,0     *GO TO MACHINE ERROR DIAGNOSTIC.           F1A05580
       REM                    CHARACTER IN AC IS GREATER THAN 77 OCTAL. F1A05590
       REM     SECTION ONE SCANS A SATEMENT 1 CHARACTER AT A TIME.      F1A05600
       REM     THE AC WAS CLEARED PRIOR TO SHIFTING IN THE CURRENT      F1A05610
       REM     SIX BITS.  A COMPARISION WAS MADE WITH A CELL CONTAINING F1A05620
       REM     THE NUMBER 77 OCTAL AND THE AC GREATER THAN BRANCH WAS   F1A05630
       REM     TAKEN. 77 OCTAL IS AN INTERNAL CHARACTER USED AS AN      F1A05640
       REM     END OF STATEMENT FLAG.                                   F1A05650
       REM                                                              F1A05660
OCTL12 TXI     (DIAG),,0     *GO TO MACHINE ERROR DIAGNOSTIC.           F1A05670
       REM     STATEMENT SCAN IS THE SAME THE ONE DESCRIBED IN MRTN77   F1A05680
       REM     ERROR.  HOWEVER, THIS TIME THE AC CONTAINS THE NUMBER    F1A05690
       REM     12 OCTAL, AN ILLEGAL CHARACTER IN ANY SENSE.             F1A05700
       REM                                                              F1A05710
       TXI     (DIAG),,0      NOT USED.                                 F1A05720
       REM                                                              F1A05730
       TXI     (DIAG),,0      NOT USED.                                 F1A05740
       REM                                                              F1A05750
       REM                                                              F1A05760
       REM                                                              F1A05770
       REM                                                              F1A05780
       REM                                                              F1A05790
       REM         CALLS TO THE SECTION I DIAGNOSTIC THAT WOULD         F1A05800
       REM         FALL INTO DUPLICATE LOCATION NUMBERS IN              F1A05810
       REM         RECORDS 9F10 AND 9F11.                               F1A05820
       REM                                                              F1A05830
ER0033 TSX     DIAG,4        *N.A. STATEMENT NOT FOUND IN DICTIONARY.   F1A05840
       REM                                                              F1A05850
       BSS     4              ADDITIONAL SPACE.                         F1A05860
       REM                                                              F1A05870
       EJECT                                                            F1A05880
       REM                                                              F1A05890
       REM     RE-ENTRY TO PASS1 OR PASS 2.                             F1A05900
       REM                                                              F1A05910
PASS1  TXH     PASS2,,0       (TXH-TXL) SWITCH FOR PASS 1 OR PASS 2.    F1A05920
       LXD     LDFT2,4        HAS AN EOF BEEN SENSED ON BCD INPUT TAPE. F1A05930
       TXH     LDFR0,4,0     *NO, GET NEXT STATEMENT.                   F1A05940
       TRA     CLOSP1        *YES, CLOSE OUT PASS 1 AND GET PASS 2.     F1A05950
       REM                                                              F1A05960
       REM *************************************************************F1A05961
       REM                                                              F1A05962
       REM     CIT00 / CALLS I/O ROUTINE.                               F1A05970
       REM                                                              F1A05980
       REM         ENTERS FOUR WORD CITS INTO THE CIT BUFFER AND        F1A05990
       REM         DUMPS A BUFFER WHEN IT BECOMES FULL.                 F1A06000
       REM         THE ROUTINE ALSO MAPS ARITHMETIC INSTRUCTIONS        F1A06010
       REM         INTO BOOLEAN OPERATIONS IF THE CURRENT STATEMENT     F1A06020
       REM         MODE IS BOOLEAN.                                     F1A06030
       REM                                                              F1A06040
CIT00  ZET     DGFLAG         HAS THERE BEEN A DIAGNOSTIC.              F1A06050
       TRA     BERPCH            GO TO BOOLEAN TEST PATCH              $F1A06060
       SXA     CITJ1,1        SAVE IR1 AND IR2.                         F1A06070
       SXA     CITJ2,2                                                  F1A06080
       TRA     COMP1          TEST FOR FUNCTION OR SUBROUTINE          $F1A06090
       ZET     *+1            IS THIS A CLOSE OUT CALL.                 F1A06100
CITA0  TXH     CITC0,2,-CITSIZ NO, IS THE BUFFER FULL.                  F1A06110
       SXA     CITB0,4        YES.                                      F1A06120
       LXA     CITD0,1        GET CURRENT BUFFER ORIGIN.                F1A06130
       SXA     CIT01,1        SET IN I/O COMMAND.                       F1A06140
       TXL     CITB0,2,0     *NOTHING TO WRITE.                         F1A06150
       PXD     ,2             GET TRUE NUMBER.                          F1A06160
       PDC     ,2                                                       F1A06170
       SXD     CIT01,2        SET I/O COMMAND WORD COUNT.               F1A06180
       TSX     (TAPE),4       WRITE CIT RECORD.                         F1A06190
       PZE     CIT01,,(WBNP)                                            F1A06200
       PZE     CIT02,,CITTAP                                            F1A06210
       CLA     CITCNT         INCREMENT CIT RECORD COUNT.               F1A06220
       ADD     L(1)                                                     F1A06230
       STO     CITCNT                                                   F1A06240
       TXL     *+2,1,CITBUF   SET NEW BUFFER ORIGIN.                    F1A06250
       TXI     *+2,1,-CITSIZ                                            F1A06260
       TXI     *+1,1,CITSIZ                                             F1A06270
       SXA     CITD0,1        SET ADDRESSES IN ROUTINE.                 F1A06280
       TXI     *+1,1,1                                                  F1A06290
       SXA     CITE0,1                                                  F1A06300
       TXI     *+1,1,-4                                                 F1A06310
       SXA     CITF0,1                                                  F1A06320
CITB0  AXT     **,4           RESTORE LINKAGE.                          F1A06330
       AXT     0,2            RESET BUFFER INCREMENT.                   F1A06340
       NZT     CITA0          IS THIS A CLOSE OUT CALL.                 F1A06350
       TRA     CITJ0          YES.                                      F1A06360
CITC0  AXT     2,1            NO, LOAD LOOP COUNT.                      F1A06370
CITC1  CAL*    1,4            GET FIRST (OR THIRD) WORD OF CIT.         F1A06380
CITD0  SLW     CITBUF,2       STORE IN CURRENT BUFFER.                  F1A06390
       CLA     1,4            GET ADDRESS OF SECOND (OR FOURTH)         F1A06400
       ARS     18             WORD OF CIT.                              F1A06410
       STA     *+1                                                      F1A06420
       CAL     **             GET WORD.                                 F1A06430
CITE0  SLW     CITBUF+1,2     STORE IN CURRENT BUFFER.                  F1A06440
       TXI     *+1,2,-2       INCREMENT BUFFER INDEX.                   F1A06450
       TXI     *+1,4,-1       INCREMENT LINKAGE ADDRESS.                F1A06460
       TIX     CITC1,1,1      GET NEXT TWO WORDS OF CIT.                F1A06470
       CAL     MODECL         IS THIS A BOOLEAN STATEMENT.              F1A06480
       ERA     L(B)                                                     F1A06490
       TNZ     CITJ0         *NO.                                       F1A06500
CITF0  CAL     CITBUF-3,2     YES, GET THE OPERATION CODE.              F1A06510
       LAS     ALL1           IS THIS AN ARITHMETIC STATEMENT FUNCTION. F1A06520
       TRA     *+2            NO.                                       F1A06530
       TRA     CITJ0          YES, DO NOT MODIFY FLAG.                  F1A06540
       SLW     ERASE          SAVE DECREMENT, IF ANY.                   F1A06550
       AXT     BOLSIZ,1       LOAD COUNT OF BOOLEAN OPERATION CODES.    F1A06560
CITG0  LDQ     BTABL,1        GET FIRST (OR NEXT) DICTIONARY WORD AND   F1A06570
       SLQ     ERASE          SPLIT OF ALGEBRAIC OPERATION CODE.        F1A06580
       LAS     ERASE          ARE OPERATION CODES IDENTICAL.            F1A06590
       TRA     *+2            NO.                                       F1A06600
       TRA     CITH0          YES, MAP LOGICAL COUNTER PART.            F1A06610
       TIX     CITG0,1,1      NO, CONTINUE COMPARISON.                  F1A06620
BER001 TSX     DIAG,4         OPERATION CODE NOT IN DICTIONARY.         F1A06630
CITH0  LGL     18             MOVE LOGICAL COUTERPART INTO DECREMENT.   F1A06640
       SLQ*    CITF0          SET LOGICAL COUNTERPART IN CURRENT CIT.   F1A06650
CITJ0  SXD     CITCNT,2       SAVE BUFFER INCREMENT.                    F1A06660
CITJ1  AXT     **,1           RESTORE INDICES.                          F1A06670
CITJ2  AXT     **,2                                                     F1A06680
       TRA     1,4            RETURN TO CALLER.                         F1A06690
       REM                                                              F1A06700
CIT01  IORT    **,,**         I/O COMMAND FOR WRITING CITS.             F1A06710
CIT02  BCI     1,COMAIL       COMPAIL LABEL.                            F1A06720
       REM                                                              F1A06730
       REM                                                              F1A06740
       REM TABLE OF CORRESPONDENCE BETWEEN REAL ALGEBRA AND BOOLEAN.    F1A06750
       REM                                                              F1A06760
       BSS 5                 SPACE FOR POSSIBLE ADDITIONAL ENTRIES...   F1A06770
       BCD 1CHSCOM                                                      F1A06780
       BCD 1CLACAL                                                      F1A06790
       BCD 1CLSCAL                                                      F1A06800
       BCD 1FADORA                                                      F1A06810
       BCD 1FMPANA                                                      F1A06820
       BCD 1STOSLW                                                      F1A06830
       BCD 1COMCOM                                                      F1A06840
       BCD 1LDQLDQ                                                      F1A06850
       BCD 1SXDSXD                                                      F1A06860
       BCD 1TSXTSX                                                      F1A06870
       BCD 1LXDLXD                                                      F1A06880
       BCD 1PXAPXA                                                      F1A06890
       BCD 1SUBSUB                                                      F1A06900
       BCD 1STASTA                                                      F1A06910
       BCD 1STQSTQ                                                      F1A06920
       BCD 1TRATRA                                                      F1A06930
       BCD 1PZEPZE                                                      F1A06940
       BCD 1XCAXCA                                                      F1A06950
       BCD 1NTRNTR                                                      F1A06960
BTABL  SYN     *                                                        F1A06970
       REM                                                              F1A06980
BOOLIN PZE 0                 CELL FOR BOOLEAN INDICATOR.                F1A06990
       REM                                                              F1A07000
       REM *************************************************************F1A07001
       REM                                                              F1A07002
       REM     TET00 / CALLS I/O ROUTINE.                               F1A07010
       REM                                                              F1A07020
       REM              MAKES ENTRIES INTO THE CORE BUFFERS FOR         F1A07030
       REM              VARIOUS TABLES AND DUMPS A BUFFER WHEN          F1A07040
       REM              IT BECOMES FULL.                                F1A07050
       REM                                                              F1A07060
TET00  ZET     DGFLAG         HAS THERE BEEN A DIAGNOSTIC.              F1A07070
       TRA     2,1           *YES, DO NOT MAKE ENTRY.                   F1A07080
       SXA     TETX1,1        SAVE INDICES.                             F1A07090
       SXA     TETX2,2                                                  F1A07100
       SXA     TETX4,4                                                  F1A07110
       STQ     TEMP           SAVE CONTENTS OF MQ.                      F1A07120
       LDQ     1,1            GET TABLE IDENTIFICATION.                 F1A07130
       STQ     TABNUM         SAVE FOR POSSIBLE WRITE.                  F1A07140
       MPY     L(6)                                                     F1A07150
       XCA                                                              F1A07160
       PAC     ,1                                                       F1A07170
       CLA     INTETX,1       GET COUNT OF WORDS IN BUFFER.             F1A07180
       STD     TETA0          SET TEST FOR FULL BUFFER.                 F1A07190
       CLA     INTETX+2,1     GET MAXIMUM BUFFER LENGTH.                F1A07200
       PAX     ,2             LOAD BUFFER LENGTH.                       F1A07210
       ZET     TETCL          IS THIS A CALL TO CLOSE OUT BUFFER.       F1A07220
TETA0  TXH     TETC0,2,**    *NO, IS BUFFER FULL.                       F1A07230
       STD     TETB1          YES, SET TAPE ADDRESS.                    F1A07240
       CLA     INTETX,1       GET BUFFER ADDRESS AND WORD COUNT.        F1A07250
       STA     TETIO+1        SET I/O COMMAND FOR WRITING.              F1A07260
       STD     TETIO+1                                                  F1A07270
       ANA     1BAR                                                     F1A07280
       TZE     TETB2         *WORD COUNT OF BUFFER ZERO, NIL TO WRITE.  F1A07290
       CLA     INTETX+4,1     INCREMENT COUNT OF BUFFERS.               F1A07300
       ADD     L(1)           DUMPED ON TAPE.                           F1A07310
       STA     INTETX+4,1     SAVE COUNT.                               F1A07320
       PAX     ,4             SET BUFFER NUMBER IN RECORD LABEL.        F1A07330
       ADD     TETA0          UPDATE COUNT OF WORDS ON TAPE.            F1A07340
       STD     INTETX+4,1                                               F1A07350
       SXD     TABNUM,4                                                 F1A07360
       TSX     (TAPE),4       DUMP BUFFER ON DESIGNATED TAPE.           F1A07370
TETB0  PZE     TETIO,,(WBNC)  OPERATION CODE MAY BECOME A PROCEED.      F1A07380
TETB1  PZE     INTETX+5,1,**                                            F1A07390
       SXA     TETFLG,4       RESET NO DUMP FLAG.                       F1A07400
TETB2  CLA     TETCL          IS THIS A CALL TO CLOSE OUT BUFFER.       F1A07410
       TZE     TETE0         *YES, DO NOT MAKE AN ENTRY.                F1A07420
       STD     TETA0          NO, RESET COUNT OF WORDS IN BUFFER.       F1A07430
TETC0  LDC     TETA0,4        LOAD 2S COMPLEMENT OF BUFFER WORD COUNT.  F1A07440
       CLA     INTETX+1,1     GET COUNT OF WORDS IN THIS TABLE ENTRY.   F1A07450
       PDX     ,2             LOAD ENTRY LENGTH.                        F1A07460
TETD0  CAL*    INTETX+1,1     GET A WORD OF THIS ENTRY.                 F1A07470
       SLW*    INTETX,1       STORE IN TABLE BUFFER.                    F1A07480
       TXI     *+1,4,-1       INCREMENT BUFFER REFERENCE.               F1A07490
       TIX     TETD0,2,1      DECREMENT ENTRY REFERENCE AND TEST COUNT. F1A07500
       CAL     TETA0          UPDATE COUNT OF WORDS IN BUFFER.          F1A07510
       ADD     INTETX+1,1                                               F1A07520
TETE0  STD     INTETX,1                                                 F1A07530
TETX1  AXT     **,1           RESTORE INDICES.                          F1A07540
TETX2  AXT     **,2                                                     F1A07550
TETX4  AXT     **,4                                                     F1A07560
       LDQ     TEMP           RESTORE CONTENTS OF MQ.                   F1A07570
       TRA     2,1           *RETURN TO CALLER.                         F1A07580
       REM                                                              F1A07590
TETFLG PZE     **             BUFFER DUMP FLAG.                         F1A07600
TETCL  PZE     -1             CLOSE OUT BUFFER FLAG.                    F1A07610
       REM                                                              F1A07620
TETIO  IOCP    TABNUM,,1      I/O COMMAND TO WRITE LABEL.               F1A07630
       IOCT    **,,**        I/O COMMAND TO WRITE BUFFER.              $F1A07640
       REM                                                              F1A07650
       REM *************************************************************F1A07651
  RP2I CLA     PS2L          SET EXIT TO PASS TWO                      $F1A07653
       TRA     *+2                                                     $F1A07657
 D12CS CLA     DIAGL         SET EXIT TO SECTION ONE DIAGNOSTIC.       $F1A07660
       STO     1TOCS+1       SETS EXIT FOR DISKS.                      $F1A07665
 1TOCS TSX     (LOAD),4,1    CALLS THE ONE TO CS ROUTINE.              $F1A07670
       PZE                                                              F1A07680
       REM                                                              F1A07690
       REM *************************************************************F1A07691
       REM                                                              F1A07700
       REM     SUBROUTINE TO CALL THE SECTION I DIAGNOSTIC.             F1A07710
       REM                                                              F1A07720
P1DXIT AXT     0,4            SET END OF SECTION ONE FLAG FOR DIAG.     F1A07730
       REM                                                              F1A07740
DIAG   SXD     ONLINE,4       SAVE LOCATION OF CALL.                    F1A07750
       NZT     *+2            IS SYSTEM TAPE POSITIONED AT DIAGNOSTIC.  F1A07760
       TRA     1TOCS-2       *YES, READ IN DIAGNOSTIC.                 $F1A07770
DGX1   TSX     (TAPE),4       NO, SPACE OVER PASS 2.                    F1A07780
       PZE     FRSP,,(SKBP)                                             F1A07790
       PZE     ,,SYSTAP                                                 F1A07800
       TRA     1TOCS-2       *     READ IN DIAGNOSTIC.                 $F1A07810
 DIAGL BCI     1,9F1500                                                $F1A07813
  PS2L BCI     1,9F1400                                                $F1A07817
       REM                                                              F1A07820
       REM *************************************************************F1A07821
       REM                                                              F1A07822
       REM     I/O COMMANDS USED BY PASS 2.                             F1A07830
       REM                                                              F1A07840
       REM     F-REGION AND CONTROL INFORMATION.                        F1A07850
       REM                                                              F1A07860
       IORT    FREGON-4,,FREGSZ+4       LOADS BUFFER 1.                 F1A07870
DCF    PZE     **,2,-FREGON   ORIGIN OF CURRENT F-REGION,,2S COMPLIMENT.F1A07880
       IORT    FREGON+FREGSZ,,FREGSZ+4  LOADS BUFFER 2.                 F1A07890
       REM                                                              F1A07900
       REM     CURRENT CONTROL WORDS.                                   F1A07910
       REM                                                              F1A07920
TLABEL PZE     **,,**         PROCESSOR ADDRESS,,F-SCAN POSITION.       F1A07930
MODECL PZE     **             MODE INDICATOR.                           F1A07940
EFN    PZE     **,,0          EXTERNAL FORMULA NUMBER IN BINARY (IF ANY)F1A07950
FIRST5 PZE     **             FIRST 5 CHARACTERS OF STATEMENT IN BCD.   F1A07960
       REM                                                              F1A07970
       REM     F-REGION DEFINITION - FORMULA REGION.                    F1A07980
BEGFRG SYN     *              ORIGIN OF FT-REGION.                      F1A07990
       BSS     4              CONTROL WORD RESERVATION.                 F1A08000
FREGON BSS     FREGSZ         STATEMENT RESERVATION.                    F1A08010
FRGBF2 SYN     *              ORIGIN OF SECOND F-REGION BUFFER.         F1A08020
       BSS     FREGSZ+4       BUFFER 2 FOR F-REGION.                    F1A08030
       REM                                                              F1A08040
ENDFRG SYN     *              END OF F-REGION.                          F1A08050
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A08060
       REM                                                              F1A08070
       REM COMMON/3-CONSTANTS AND VARIABLES=                            F1A08080
       REM                                                              F1A08090
COMCON BSS 0                                                            F1A08100
       REM                                                              F1A08110
FRSP   PZE     1,,0           CONTROL WORD TO FORWARD SPACE 1 RECORD.   F1A08120
BKSP   MZE     1,,0           CONTROL WORD TO BACKSPACE 1 RECORD.       F1A08130
REWD   PZE     ,,-1           CONTROL WORD TO REWIND TAPE.              F1A08140
       REM                                                              F1A08150
TRAILR IOCP    ALL1,,1                                                  F1A08160
       IOCP    ALL1,,1                                                  F1A08170
       IOCP    ALL1,,1                                                  F1A08180
       IOCT    ALL1,,1                                                 $F1A08190
TRAIL  BCI     1,MARKER                                                 F1A08200
       REM                                                              F1A08210
WTXQ5  BCI     1,EXEQ         LABEL FOR EXEQUTABLE STATEMENT RECORDS.   F1A08220
EXEQF  BCI     1,EOF 1        END-OF-FILE LABEL.                        F1A08230
       REM                                                              F1A08240
       REM *************************************************************F1A08250
       REM                                                              F1A08260
TEN    OCT 12                        (1010) - CTEST-11                  F1A08270
ENDMK  OCT 77                        111111 - CTEST-10                  F1A08280
OPEN   OCT 74                        (      - CTEST-9                   F1A08290
COMMA  OCT 73                        ,      - CTEST-8                   F1A08300
CLOS   OCT 34                        )      - CTEST-7                   F1A08310
EQUAL  OCT 13                        =      - CTEST-6                   F1A08320
11Z    OCT 40                        -      - CTEST-5                   F1A08330
SLASH  OCT 61                        /      - CTEST-4                   F1A08340
POINT  OCT 33                        .      - CTEST-3                   F1A08350
12Z    OCT 20                        +      - CTEST-2                   F1A08360
STAR   OCT 54                        *      - CTEST-1                   F1A08370
CTEST  BSS 0                         ADDRESS USED FOR INDEXING ABOVE.   F1A08380
       REM                                                              F1A08390
MASK2  OCT 77777                     2**15-1            -ARITHMETIC.    F1A08400
L(0)   BCD 1000000                   0                                  F1A08410
L(1)   BCD 1000001                   1                                  F1A08420
L(2)   BCD 1000002                   2                                  F1A08430
L(3)   BCD 1000003                   3                                  F1A08440
L(4)   BCD 1000004                   4                                  F1A08450
L(5)   BCD 1000005                   5                                  F1A08460
L(6)   BCD 1000006                   6                                  F1A08470
L(7)   BCD 1000007                   7                                  F1A08480
L(8)   BCD 1000008                   8                                  F1A08490
L(9)   BCD 1000009                   9                                  F1A08500
MINUS  OCT 14                        -                                  F1A08510
L(A)   BCD 100000A                                                      F1A08520
L(B)   BCD 100000B                                                      F1A08530
L(C)   BCD 100000C                   CONSTANT USED BY PASS1 AND DIAG.   F1A08540
L(D)   BCD 100000D                                                      F1A08550
L(F)   BCD 100000F                   CONSTANT USED BY PASS2 AND DIAG.   F1A08560
L(H)   BCD 100000H                   H                                  F1A08570
L(I)   BCD 100000I                                                      F1A08580
L(L)   BCD 100000L                                                      F1A08590
L(O)   BCD 100000O                   O (ALPHABETIC)                     F1A08600
SPECOP OCT 53                        00000$                             F1A08610
BLANK  OCT 60                        000000000060                       F1A08620
IFSYM  OCT 6712                      CONSTANT USED BY PASS2 AND DIAG.   F1A08630
IFSYM2 OCT 671260606060                                                 F1A08640
CALLSM OCT     711260606060                                             F1A08650
CALLER OCT 7112                      CONSTANT USED BY PASS2 AND DIAG.   F1A08660
2E18   OCT 1000000                   DECREMENT=1                        F1A08670
5BLANS BCD 10                        006060606060                       F1A08680
1BAR   OCT 77777000000               (2**15-1)*2**18DECREMENT MASK.     F1A08690
BLANKS BCD 1                         606060606060                       F1A08700
ALL1   OCT -377777777777             END OF STATEMENT WORD.             F1A08710
MAXIMA OCT 077777777777                                                 F1A08720
COMVAR BSS 0                                                            F1A08730
ARGCNT PZE 4,,1                      ARGUMENT COUNTER USED BY C30,C32.  F1A08740
 SET   PON  ..                       VARIABLE USED TO COMPILE 8)....    F1A08750
       REM  END OF COMMON CONSTANTS AND VARIABLES.                      F1A08760
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A08770
       REM                                                              F1A08780
       REM COMMON/4-SUBROUTINES USED BY SECTION ONE=                    F1A08790
       REM                                                              F1A08800
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A08810
       REM                                                              F1A08820
       REM C0160,2/ CALLS=C0190,DIAG.                                   F1A08830
       REM C0160 ASSEMBLES LEFT-ADJUSTED IN 1G, THE CHAR IN THE AC AND  F1A08840
       REM SUCCESSIVE NB CHARS STARTING IN THE MQ, UNTIL A ,()= OR ENDMKF1A08850
       REM IS MET AND LEFT IN THE AC. ALSO MARKS END OF WORD WITH A     F1A08860
       REM BLANK, IF LESS THAN 6 CHARACTERS.                            F1A08870
C0160  SXD C016X,2                   SAVE THE C(XR2), AND               F1A08880
       LXA L(0),2                    SET XR2 TO CONTROL SHIFTING.       F1A08890
       STZ 1G                        CLEAR WORKING STORAGE.             F1A08900
       TSX     TESTH0,4      TEST FIRST CHARACTER FOR NUMERIC, ERROR.   F1A08910
C0161  AXT CTEST-ENDMK,4             TEST                               F1A08920
C0162  CAS CTEST,4                   CHARACTER                          F1A08930
C016X  TXI C0163,0,**                IN THE AC                          F1A08940
  FWA  TXI C0165,0,**                AGAINST                            F1A08950
C0163  TIX C0162,4,1                 ALL PUNCTUATION.                   F1A08960
       TXL C0164,2,30                IF SYMBOL EXCEEDS 6 CHARACTERS,    F1A08970
ER0001 BSS 0                                                            F1A08980
       TSX DIAG,4                  * GO TO THE DIAGNOSTIC.              F1A08990
C0164  ALS 30,2                      BUILD LEFT-ADJUSTED                F1A09000
       ORS 1G                        SYMBOL IN WORKING STORAGE.         F1A09010
       TSX C0190,4                 * GET NEXT NB CHARACTER IN THE AC.   F1A09020
       TXI C0161,2,6                 UPDATE SHIFT COUNT, AND CONTINUE.  F1A09030
C0165  TXH C0167,2,0                 IF PUNCTUATION IS 1ST CHARACTER,   F1A09040
ER0002 BSS 0                                                            F1A09050
C0166  TSX DIAG,4                  * OR ILLEGAL, GO TO THE DIAGNOSTIC.  F1A09060
C0167  TXL C0166,4,5                 IF LEGAL PUNCTUATION, THEN         F1A09070
       STO 1H                        SAVE, AND                          F1A09080
       PXD ,0                                                           F1A09090
       LDQ BLANKS            COMPLETE VARIABLE NAMES LESS THAN SIX CHAR-F1A09100
       LGL 36,2              ARCTERS WITH BCD BLANKS.                   F1A09110
       ORS 1G                        THAN 6 CHARACTERS IN LENGTH.       F1A09120
       CLA 1H                        PICKUP PUNCTUATION MARK,           F1A09130
       LXD C016X,2                   RESTORE THE C(XR2), AND            F1A09140
       TRA 1,2                     * RETURN TO CALLER.                  F1A09150
       REM  END OF PROGRAM C0160.                                       F1A09160
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A09170
       REM                                                              F1A09180
       REM C0180,2/ CALLS=C0190.                                        F1A09190
       REM C0180 CONVERTS SUCCESSIVE NUMERICS STARTING IN THE AC TO     F1A09200
       REM BINARY, PLACES RESULT IN 1G, AND LEAVES 1ST NON-NUMERIC IN ACF1A09210
C0180X TSX C0190,4                 * OBTAIN 1ST NUMERIC IN THE AC.      F1A09220
C0180  TSX TESTI0,4          TEST CHARACTER FOR NUMERIC.                F1A09230
C0181  STO 1G                        PLACE 1ST NUMERIC IN 1G.           F1A09240
       TSX C0190,4                 * EXAMINE NEXT NON-BLANK CHARACTER,  F1A09250
       CAS L(9)                      AND IF NON-NUMERIC, THEN           F1A09260
       TRA 1,2                     * RETURN TO CALLER.                  F1A09270
       NOP                           IF NUMERIC, THEN                   F1A09280
       STO 2G                        SAVE DIGIT IN 2G.                  F1A09290
       CLA 1G                        MULTIPLY                           F1A09300
       ALS 2                         C(1G)                              F1A09310
       ADD 1G                        BY                                 F1A09320
       ALS 1                         10,                                F1A09330
       ADD 2G                        AND ADD CURRENT DIGIT.             F1A09340
       TXI C0181,0,0                 REPEAT PROCESS FOR NEXT CHARACTER. F1A09350
       REM  END OF PROGRAM C0180.                                       F1A09360
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A09370
       REM                                                              F1A09380
       REM C0190X,4/                                                    F1A09390
       REM C0190X INITIALIZES C0190 TO OBTAIN 1ST WORD OF FORMULA IN F. F1A09400
C0190X CLA DCF                       SET FORMULA WORD ADDRESS           F1A09410
       STD FWA                       TO THE FIRST WORD OF F-REGION.     F1A09420
       SXA     XCHCTR,0              SET CHARACTER COUNT TO ZERO.       F1A09430
       TRA 1,4                     * RETURN TO MAIN ROUTINE.            F1A09440
       REM  END OF PROGRAM C0190X.                                      F1A09450
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A09460
       REM                                                              F1A09470
       REM C0390,4/                                                     F1A09480
       REM C0390 INSERTS THE CHARACTER IN THE AC INTO THE 1ST POSITION  F1A09490
       REM TO THE LEFT OF THAT DEFINED BY FWA AND XR1.                  F1A09500
C0390  CLA ENDMK                     PREPARE TO CHANGE                  F1A09510
       LXD FWA,2                     THE PROPER CHARACTER               F1A09520
       LXA     XCHCTR,1       IN THE F-REGION.                          F1A09530
       TNX C0393,1,1                 ADJUST MASK                        F1A09540
C0392  LGL 6                         TO POSITION                        F1A09550
       TIX C0392,1,1                 CHARACTER.                         F1A09560
C0393  COM                           INVERT MASK, AND                   F1A09570
       ANS -1,2                      ERASE PROPER CHARACTER.            F1A09580
       XCL                    MOVE TO AC AND                            F1A09590
       ORS -1,2                      INSERT IN ERASED POSITION.         F1A09600
       REM C0390 CONTINUES BY USING C0190.                              F1A09610
       REM                                                              F1A09620
       REM C0190,4/                                                     F1A09630
       REM C0190 OBTAINS IN AC THE NEXT NON-BLANK CHARACTER OF FORMULA. F1A09640
C0190  SXA     C0194,1        SAVE C(IR1).                              F1A09650
XCHCTR AXT     **,1           LOAD CHARACTER COUNT.                     F1A09660
       LDQ RESIDU                    PICK UP ANY REMAINING CHARACTERS.  F1A09670
C0191  TIX C0193,1,1                 IF NONE,                           F1A09680
       LXD FWA,1                     PICK UP NEXT FORMULA               F1A09690
       LDQ 0,1                       WORD FROM F-REGION,                F1A09700
       TXI C0192,1,-1                AND INCREASE                       F1A09710
C0192  SXD FWA,1                     FORMULA WORD ADDRESS BY 1.         F1A09720
       AXT     6,1            RESET IR1 FOR 6 NEW CHARACTERS.           F1A09730
C0193  PXD ,0                        EXAMINE                            F1A09740
       LGL 6                         NEXT CHARACTER                     F1A09750
       CAS BLANK                     AND COMPARE WITH A BLANK.          F1A09760
       TRA     C0195          IF BLANK                                  F1A09770
       TRA     C0191          GO EXAMINE NEXT CHARACTER.                F1A09780
C0195  SXA     XCHCTR,1       IF NOT BLANK, SAVE CHARACTER COUNT.       F1A09790
       STQ RESIDU                    SAVE ANY REMAINING CHARACTERS,     F1A09800
C0194  AXT     **,1           RESTORE C(IR1).                           F1A09810
       TRA 1,4                     * RETURN TO MAIN ROUTINE.            F1A09820
       REM  END OF PROGRAM C0190.                                       F1A09830
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A09840
       REM                                                              F1A09850
       REM DIM.SR,4/ CALLS=DIAG.                                        F1A09860
       REM DIM.SR SEARCHS THE DIMENSION TABLES. ENTRANCE IS TO DIM1SR,  F1A09870
       REM DIM2SR, OR DIM3SR ACCORDING TO THE DIMENSION.                F1A09880
       REM DIM1SR= ENTRY POINT FOR 1 DIMENSION TABLE.                   F1A09890
DIM1SR SXA     DIMXR4,4                                                 F1A09900
       LXD DIM1IX-2,4        GET NO OF ENTRIES IN DIM1.                 F1A09910
       CLA ORGDM1            GET ORIGIN ADDRESS OF DIM1 TABLE.          F1A09920
       TXI DMSR00,0,0                                                   F1A09930
       REM DIM2SR= ENTRY POINT FOR 2 DIMENSION TABLE.                   F1A09940
DIM2SR SXA     DIMXR4,4                                                 F1A09950
       LXD DIM2IX-2,4        GET NO OF ENTRIES IN DIM2.                 F1A09960
       CLA ORGDM2            GET ORIGIN ADDRESS OF DIM2 TABLE.          F1A09970
DMSR00 STA DMSR01            SET ADDRESS OF COMPARISON TEST.            F1A09980
       STA DMSR03            SET ADDRESS OF RETRIEVAL INSTRUCTION.      F1A09990
       SXA     DIMXR2,2                                                 F1A10000
       LXA L(0),2            SET INDEX 2 FOR FORWARD SEARCH.            F1A10010
       CLA E+2               ARGUMENT BEING SEARCHED FOR TO AC.         F1A10020
DMSR01 CAS **,2              COMPARISON OF ARGUMENT TO 1ST WORD OF ENTRYF1A10030
       TXI DMSR02,2,-2       NO                                         F1A10040
       TXI DMSR03,2,-1       YES                                        F1A10050
       TXI DMSR02,2,-2       NO                                         F1A10060
DMSR02 TIX DMSR01,4,1        NOT THIS ENTRY, WAS THIS LAST ENTRY...     F1A10070
       TRA     DIMXR2                                                   F1A10080
DMSR03 CLA **,2              FOUND, SECOND WORD OF DIM ENTRY TO AC      F1A10090
       TRA DMSR07                                                       F1A10100
       REM DIM3SR= ENTRY POINT FOR 3 DIMENSION TABLE.                   F1A10110
DIM3SR SXA     DIMXR4,4                                                 F1A10120
       SXA     DIMXR2,2                                                 F1A10130
       LXD DIM3IX-2,4        GET NO OF ENTRIES IN DIM3.                 F1A10140
       LXA L(0),2            SET INDEX 2 FOR FORWARD SEARCH.            F1A10150
       CLA E+2               ARGUMENT BEING SEARCHED FOR TO AC.         F1A10160
DMSR04 CAS **,2              COMPARE ARGUMENT TO 1ST WORD OF DIM3 ENTRY F1A10170
       TXI DMSR05,2,-3       NO                                         F1A10180
       TRA DMSR06            YES                                        F1A10190
       TXI DMSR05,2,-3       NO                                         F1A10200
DMSR05 TIX DMSR04,4,1        NOT THIS ENTRY, WAS THIS LAST ENTRY...     F1A10210
DIMXR2 AXT     ..,2                                                     F1A10220
DIMXR4 AXT     ..,4                                                     F1A10230
       TRA     1,4                   EXIT (NOT FOUND).                  F1A10240
DMSR06 CLA **,2              THIRD WORD OF DIM3 ENTRY TO D3.            F1A10250
       STO ERASE2                                                       F1A10260
DMSR08 CLA **,2              SECOND WORD OF DIM3 ENTRY TO AC.           F1A10270
DMSR07 STO ERASE1            AC TO D12.                                 F1A10280
       LXA     DIMXR2,2                                                 F1A10290
       LXA DIMXR4,4                                                     F1A10300
       TRA 2,4                       EXIT (FOUND).                      F1A10310
       REM  END OF PROGRAM DIM.SR.                                      F1A10320
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A10330
       REM                                                              F1A10340
       REM SR6DC1,1/ CALLS=DIAG.                                        F1A10350
       REM SR6DC1 CONVERTS UP TO 6 BCD DIGITS TO THEIR BINARY EQUIV.    F1A10360
SR6DC1 SXD SR6XR2,2                  SAVE THE C(XR2), AND               F1A10370
       LXA L(6),2                    SET TO COUNT 6 CHARACTERS.         F1A10380
       STZ ERASE1                    INITIALIZE OUTPUT CELL TO 0.       F1A10390
SR6DC2 PXD ,0                        OBTAIN NEXT CHARACTER              F1A10400
       LGL 6                         IN AC AND                          F1A10410
       CAS BLANK                     TEST FOR BLANK.                    F1A10420
SR6XR2 TXI SR6DC3,0,**               IF NOT BLANK,                      F1A10430
       TXI SR6DC4,0,-1                                                  F1A10440
SR6DC3 CAS L(9)                      TEST FOR NUMERIC.                  F1A10450
ER0004 BSS 0                                                            F1A10460
       TSX DIAG,4                  * IF NON-NUMERIC - GO TO DIAGNOSTIC. F1A10470
  NOP  NOP                           IF NUMERIC,                        F1A10480
       STO ERASE2                    SAVE DIGIT, AND                    F1A10490
       CLA ERASE1                    MULTIPLY PREVIOUS PARTIAL          F1A10500
       ALS 2                         RESULT BY 10,                      F1A10510
       ADD ERASE1                    AND ADD IN                         F1A10520
       ALS 1                         CURRENT DIGIT, SAVING              F1A10530
       ADD ERASE2                    NEW PARTIAL RESULT.                F1A10540
       STO ERASE1                    THEN                               F1A10550
SR6DC4 TIX SR6DC2,2,1                WHEN 6 CHARS HAVE BEEN TREATED,    F1A10560
       CLA ERASE1                    PICKUP OUTPUT,                     F1A10570
       LXD SR6XR2,2                  RESTORE THE C(XR2), AND            F1A10580
  TRA  TRA 1,1                     * EXIT TO MAIN ROUTINE.              F1A10590
       REM  END OF PROGRAM SR6DC1.                                      F1A10600
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A10610
       REM                                                              F1A10620
       REM TBSR00(,4)/ CALLS=DIAG.                                      F1A10630
       REM TBSR00 IS CALLED BY TSX ....IX,4 -WHERE .... IS THE NAME OF  F1A10640
       REM THE CORE TABLE REFERRED TO. TBSR00 MAKES ENTRIES IN THE CORE F1A10650
       REM TABLES, AND ALSO SEARCHES THE CORE TABLES FOR INFORMATION.   F1A10660
       REM                                                              F1A10670
TBSR00 SXA     TBSR18-1,1     SAVE INDEX REGISTERS.                     F1A10680
       SXA     TBSR18,2                                                 F1A10690
       SXA     TBSR18+1,4                                               F1A10700
       CLA 0,4               GET   ....IX,4                             F1A10710
       ADD L(1)              FORM   ....IX+1                            F1A10720
       STA TBSR01            SET ADDRESS OF PARAMETER MOVING LOOP.      F1A10730
       SUB L(3)              FORM   ....IX-2                            F1A10740
       STA TBSR09            SET ADDRESS FOR UPDATING PARAMETER.        F1A10750
       AXT     4,1            PREPARE TO MOVE 4 WORD PARAMETERS.        F1A10760
TBSR01 CAL **,1              MOVE PARAMETERS TO TEMPORARY WORKING AREA. F1A10770
       SLW TEMP,1            X                                          F1A10780
       TIX TBSR01,1,1        X                                          F1A10790
       CAL TEMP-4            GET   ARG1+L,,L                            F1A10800
       STA TBSR07                                                       F1A10810
       STA TBSR12                                                       F1A10820
       STP TBSR02            SET SWITCH TO SKIP SEARCH ON DIM TABLES.   F1A10830
       PDC     ,1             GET 2S COMPLIMENT.                        F1A10840
       SXD     TBSR14,1                                                 F1A10850
       CLA TEMP-3            GET   TA,,N                                F1A10860
       STA TBSR08                                                       F1A10870
       STD TBSR95            SET TEST FOR TABLE OVERFLOW.               F1A10880
       CLA TEMP-2            GET   FA,,J                                F1A10890
       STA TBSR13                                                       F1A10900
       LXD TEMP-3,2          GET N.                                     F1A10910
       TXL TBSR06,2,0                                                   F1A10920
TBSR02 PZE     TBSR10,,0      SKIP SEARCH ON DIM TABLES. (TXH)          F1A10930
TBSR05 LXD TEMP-2,1          GET J.                                     F1A10940
TBSR95 TIX TBSR06,1,**       TEST FOR N=J, YES WHEN TABLE IS FULL.      F1A10950
       LXD TEMP-1,4          LOAD IR4 WITH COMPLEMENT OF TABLE NUMBER.  F1A10960
       TRA     DIAG          *GO TO DIAGNOSTIC.                         F1A10970
TBSR06 LXD TEMP-4,3          GET L.                                     F1A10980
TBSR07 CLA **,1              GET ARGUMENT                               F1A10990
TBSR08 STO **,1              AND ENTER IN TABLE.                        F1A11000
       TIX TBSR07,1,1        ENTER L WORDS.                             F1A11010
       PXA ,2                GET L.                                     F1A11020
       ADD TEMP-3            FORM TA+L,,N                               F1A11030
       ADD 2E18              FORM TA+L,,N+1                             F1A11040
TBSR09 STO **                UPDATE PERMANENT PARAMETER.                F1A11050
       LXD TEMP-3,2          GET TAG (N) WHICH IS NUMBER OF ENTRIES     F1A11060
       TRA     TBSR17         PRECEDING THIS ENTRY.                     F1A11070
TBSR10 LXD TEMP-3,4          GET N.                                     F1A11080
       AXT     0,2            SET INDEX FOR FORWARD SCAN.               F1A11090
TBSR11 LXD TEMP-4,1          GET L.                                     F1A11100
       SXA     TBSR19,2              SAVE CURRENT NBAR.                 F1A11110
TBSR12 CLA **,1              COMPARE EACH WORD ON ARGUMENT TO CORRES-   F1A11120
TBSR13 CAS **,2              PONDING WORD OF TABLE ENTRY.               F1A11130
       TRA     TBSR93         UNEQUAL.                                  F1A11140
       TXI TBSR15,2,-1       EQUAL.                                     F1A11150
TBSR93 TNX TBSR05,4,1        UNEQUAL, WAS THIS LAST ENTRY IN TABLE...   F1A11160
TBSR19 AXT     ..,2                  GET LAST NBAR.                     F1A11170
TBSR14 TXI TBSR11,2,**       INCREMENT LAST NBAR BY -(L)                F1A11180
TBSR15 TIX TBSR12,1,1        THESE WORDS ARE EQUAL, TRY NEXT PAIR.      F1A11190
       LXD TEMP-3,2          ARGUMENT EQUALS TABLE ENTRY IN ALL WORDS,  F1A11200
       SXD TBSR16,4          COMPUTE TAG WHICH IS N-NUMBER OF ENTRIES   F1A11210
TBSR16 TIX TBSR17,2,**       WHICH DID NOT AGREE-1.                     F1A11220
       LXA L(0),2            SPECIAL CASE OF FIRST ENTRY IN TABLE.      F1A11230
TBSR17 PXA ,2                TAG TO AC.                                 F1A11240
       AXT     **,1           RESTORE INDEX REGISTERS.                  F1A11250
TBSR18 AXT     **,2                                                     F1A11260
       AXT     **,4                                                     F1A11270
       TRA 1,4               RETURN TO CALLER +1.                       F1A11280
       REM  END OF PROGRAM TBSR00.                                      F1A11290
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A11300
       REM                                                              F1A11310
       REM TESTFX,1/                                                    F1A11320
       REM TESTFX TESTS FOR FIXED OR FLOATING POINT VARIABLES.          F1A11330
TESTFX CAL FIRSTC                    COMPARE FIRST CHARACTER            F1A11340
       CAS L(H)                      WITH H.                            F1A11350
       CAS L(O)                      IF GREATER THAN H, COMPARE WITH O. F1A11360
       TRA 1,1                     * IF NOT GREATER THAN H, LESS THAN O,F1A11370
       TRA 1,1                     * THEN TAKE FLOATING POINT EXIT.     F1A11380
       TRA 2,1                     * OTHERWISE, TAKE FIXED POINT EXIT.  F1A11390
       REM  END OF PROGRAM TESTFX.                                      F1A11400
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A11410
       REM                                                              F1A11420
       REM TEST..,4/ CALLS=DIAG.                                        F1A11430
       REM TEST.. TESTS THE CHARACTER IN THE AC(30-35).                 F1A11440
TEST.. BSS 0                         TEST CHARACTER IN THE AC.          F1A11450
       REM TEST CHARACTER IN THE AC FOR COMMA OR ENDMARK.               F1A11460
TESTA0 CAS COMMA                                                        F1A11470
       TRA TESTA1                                                       F1A11480
       TRA 1,4                     * RETURN TO CALLER.                  F1A11490
TESTA1 SUB ENDMK                                                        F1A11500
       TZE 1,4                     * RETURN TO CALLER.                  F1A11510
ER0015 TSX DIAG,4                  * ERROR -- GO TO DIAGNOSTIC.         F1A11520
       REM TEST CHARACTER IN THE AC FOR COMMA OR CLOSED PARENTHESIS.    F1A11530
TESTB0 CAS COMMA                                                        F1A11540
       TRA TESTB1                                                       F1A11550
       TRA 1,4                     * RETURN TO CALLER.                  F1A11560
TESTB1 SUB CLOS                                                         F1A11570
       TZE 1,4                     * RETURN TO CALLER.                  F1A11580
ER0016 TSX DIAG,4                  * ERROR -- GO TO DIAGNOSTIC.         F1A11590
       REM TEST CHARACTER IN THE AC FOR OPEN PARENTHESIS OR ENDMARK.    F1A11600
TESTC0 CAS OPEN                                                         F1A11610
       TRA TESTC1                                                       F1A11620
       TRA 1,4                     * RETURN TO CALLER.                  F1A11630
TESTC1 SUB ENDMK                                                        F1A11640
       TZE 1,4                     * RETURN TO CALLER.                  F1A11650
ER0017 TSX DIAG,4                  * ERROR -- GO TO DIAGNOSTIC.         F1A11660
       REM TEST CHARACTER IN THE AC FOR ENDMARK.                        F1A11670
TESTD0 CAS ENDMK                                                        F1A11680
       TSX     MRTN77,4      *CHARACTER GREATER THAN 77 OCTAL, IMPOSS.  F1A11690
       TRA 1,4                     * RETURN TO CALLER.                  F1A11700
ER0019 TSX DIAG,4            *ERROR, END OF STATEMENT NOT REACHED.      F1A11710
       REM TEST CHARACTER IN THE AC FOR OPEN PARENTHESIS.               F1A11720
TESTE0 CAS OPEN                                                         F1A11730
       TRA TESTE1                                                       F1A11740
       TRA 1,4                     * RETURN TO CALLER.                  F1A11750
ER0020 BSS 0                                                            F1A11760
TESTE1 TSX DIAG,4                  * ERROR -- GO TO DIAGNOSTIC.         F1A11770
       REM TEST CHARACTER IN THE AC FOR CLOSED PARENTHESIS.             F1A11780
TESTF0 CAS CLOS                                                         F1A11790
       TRA TESTF1                                                       F1A11800
       TRA 1,4                     * RETURN TO CALLER.                  F1A11810
ER0021 BSS 0                                                            F1A11820
TESTF1 TSX DIAG,4                  * ERROR -- GO TO DIAGNOSTIC.         F1A11830
       REM TEST CHARACTER IN THE AC FOR COMMA.                          F1A11840
TESTG0 CAS COMMA                                                        F1A11850
       TRA TESTG1                                                       F1A11860
       TRA 1,4                     * RETURN TO CALLER.                  F1A11870
ER0022 BSS 0                                                            F1A11880
TESTG1 TSX DIAG,4                  * ERROR -- GO TO DIAGNOSTIC.         F1A11890
       REM TEST CHARACTER IN THE AC FOR NON-NUMERIC.                    F1A11900
TESTH0 CAS L(9)                                                         F1A11910
       TRA 1,4                     * RETURN TO CALLER.                  F1A11920
       NOP                                                              F1A11930
ER0023 TSX DIAG,4                  * ERROR -- GO TO DIAGNOSTIC.         F1A11940
       REM TEST CHARACTER IN THE AC FOR NUMERIC.                        F1A11950
TESTI0 CAS L(9)                                                         F1A11960
ER0024 TSX DIAG,4                  * ERROR -- GO TO DIAGNOSTIC.         F1A11970
       TRA 1,4                     * RETURN TO CALLER.                  F1A11980
       TRA 1,4                     * RETURN TO CALLER.                  F1A11990
       REM  END OF PROGRAM TEST...                                      F1A12000
       REM                                                              F1A12010
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A12020
       REM                                                              F1A12030
       REM ERASABLE STORAGE COMMON TO BOTH PASS 1 AND PASS 2.           F1A12040
       REM                                                              F1A12050
COMORG SYN     *                                                        F1A12060
1C     BSS 5                         COMMON WORKING STORAGE.            F1A12070
1G     BSS 1                         COMMON WORKING STORAGE.            F1A12080
2G     BSS 1                         COMMON WORKING STORAGE FOR STATE A.F1A12090
3G     BSS 1                                                            F1A12100
1H     BSS 1                                                            F1A12110
CALLNM BSS 1                                                            F1A12120
E      BSS 14                        WORKING STORAGE USED BY SS000.     F1A12130
ERASE  BSS 1                                                            F1A12140
ERASE1 BSS 1                                                            F1A12150
ERASE2 BSS 1                                                            F1A12160
ERASE3 BSS 1                                                            F1A12170
ERASE4 BSS 1                                                            F1A12180
FIRSTC BSS 1                         USED BY SS000,TESTFX,C3000.        F1A12190
FSNAME BSS 1                         NAME OF FUNCTION.                  F1A12200
G      BSS 2                                                            F1A12210
LEFT   BSS 3                         STORAGE USED BY ARITHMETIC, DIAG.  F1A12220
RESIDU BSS 1                         REMAINDER OF F-REGION WORD.(C0190) F1A12230
TABNUM BSS 1                                                            F1A12240
TEMP   BES 4                                                            F1A12250
       BSS     1                                                       $F1A12251
       REM                                                              F1A12260
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A12270
       REM                                                              F1A12280
       REM COMMON/6-PATCH AREA=                                         F1A12290
CLAIFN PZE     0              STORAGE FOR CLA 2 IFN                    $F1A12291
 COMP1 LXD     CITCNT,2       LOAD CURRENT BUFFER INCREMENT            $F1A12292
       NZT     CLAIFN         WAS THIS FUNCTION OR SUBROUTINE          $F1A12293
       TRA     CIT00+5        NO                                       $F1A12294
       CLA     CLAIFN         YES                                      $F1A12295
       STO     CITBUF         STORE IFN INSTEAD OF                     $F1A12296
       STZ     CLAIFN         $$ INTO FIRST INSTRUCTION (CLA 2)        $F1A12297
       TRA     CIT00+5                                                 $F1A12298
       REM         PATCH CHECKS ON BOOLEAN ERRORS                      $F1A12300
BERPCH CAL     MODECL             CHECK INDICATOR, BOOLEAN ERROR PATCH $F1A12301
       ERA     L(B)              IS STATEMENT BOOLEAN                  $F1A12302
       TNZ     3,4               NO, RETURN TO CALLER                  $F1A12303
       TRA     CIT00+2           GO BACK TO CHECK FOR BOOL. ERROR      $F1A12304
       BSS     187               PATCH AREA                            $F1A12305
ENDCOM SYN     *              END OF COMMON .                           F1A12310
       REM  END OF COMMON PATCH AREA.                                   F1A12320
       REM                                                              F1A12330
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A12340
       REM                                                              F1A12350
       REM  END OF THE COMMON PART OF SECTION ONE.                      F1A12360
       TTL * SECTION ONE PASS ONE * RECORD 9F13 *                       F1A12370
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A12380
       REM                                                              F1A12390
       REM SECTION 1 / PASS1 =                                          F1A12400
       REM                                                              F1A12410
       REM                                                              F1A12420
       REM PASS 1/1-ASSEMBLE AND CLASSIFY ALL STATEMENTS=               F1A12430
       REM                                                              F1A12440
ORGP1  ORG     ENDCOM                                                   F1A12450
       REM                                                              F1A12460
INITIL LFTM                   MAKE SURE TRAP MODES ARE INACTIVE.        F1A12470
       LTM                                                              F1A12480
       CAL     L(4)           SET MONITOR ERROR FLAG                    F1A12490
       SLW     (MSLN)         FOR ERROR RECORDS.                        F1A12491
       AXT     TEMP-1C,4     ZERO OUT THE ERASEABLE                    $F1A12492
       STZ     TEMP,4        STORAGE FOR IBSYS.                        $F1A12493
       TIX     *-1,4,1                                                 $F1A12494
       AXT     TOPTAB-ENDF10,4                                          F1A12500
       STZ     TOPTAB,4       CLEAR WORKING AREA.                       F1A12510
       TIX     *-1,4,1                                                  F1A12520
       AXT     4,1                                                      F1A12530
INITZ  SXD     *+3,1          REWIND WORKING TAPES.                     F1A12540
       TSX     (TAPE),4                                                 F1A12550
       PZE     REWD,,(SKDP)                                             F1A12560
       PZE     ,,**                                                     F1A12570
       TXL     *+2,1,2        DO NOT REWIND SYSTEM TAPE.                F1A12580
       TIX     INITZ,1,1                                                F1A12590
       CAL     L(FPT)         INITIALIZE CLOSUB TABLE IN CASE           F1A12600
       SLW     CLSBBF         THIS A MAIN PROGRAM.                      F1A12610
       CLA*    (FGBX)         GET MONITOR FLAGS.                        F1A12611
       TPL     *+8           *IS THIS MONITOR MODE, NO.                 F1A1261A
       AXT     (RBNP),4       YES. SET READ OPERATIONS TO BINARY.       F1A1261B
       SXD     *+7,4                                                    F1A1261C
       AXT     (RBEP),4                                                 F1A1261D
       SXD     LDFTT,4                                                  F1A1261E
       AXT     FINPUT,4       SET CALLING SEQUENCE TO READ LABELS.      F1A1261F
       SXA     LDFTT+1,4                                                F1A1261G
       SXA     *+3,4                                                    F1A1261H
       TSX     (TAPE),4       LOAD FT-REGION (BUFFER 1).                F1A12620
       PZE     FTREG-1,,(RDNP)                                          F1A12630
       PZE     ,,INPUTP                                                 F1A12640
       CAL     DIM3IX-1       INITIALIZE                                F1A12650
       STA     DMSR04         DIM3                                      F1A12660
       ADD     L(1)           ADDRESS                                   F1A12670
       STA     DMSR08         IN DIM3                                   F1A12680
       ADD     L(1)           SEARCH                                    F1A12690
       STA     DMSR06         ROUTINE.                                  F1A12700
       TSX     LDFT0,4        LOAD FT-REGION (BUFFER 2).                F1A12710
       TRA     LDFR0          GO TO PASS 1 SUBROUTINE TO LOAD F-REGION. F1A12720
       REM                                                              F1A12730
L(FPT) BCI     1,(FPT)        ASSUMED FIRST ENTRY IN CLOSUB.            F1A12740
FINPUT BCI     1,FINPUT       LABEL FOR READING INPUT TAPE.             F1A12741
       REM                                                              F1A12750
       REM *************************************************************F1A12760
       REM                                                              F1A12761
       REM     TERMINAL ROUTINE FOR PASS 1.                             F1A12770
       REM                                                              F1A12780
CLOSP1 ZET     *+1            HAS THERE BEEN A NO XEQ STAT. ERROR.      F1A12790
       TRA     *+2            NOT YET.                                  F1A12800
       TRA     P1DXIT         YES, QUIT PROCESSING.                     F1A12810
       LXA     XEQCTR,4       ARE THERE ANY EXECUTABLE STATEMENTS.      F1A12820
       TXH     *+3,4,0       *YES.                                      F1A12830
       STZ     CLOSP1+1       NO, SET QUIT FLAG.                        F1A12840
NOXEQR TSX     DIAG,4         GO TO DIAGNOSTIC.                         F1A12850
       TSX     (TAPE),4       WRITE A DUMMY RECORD AFTER THE            F1A12860
       PZE     TRAILR,,(WBNP) EXECUTABLE STATEMENTS.                    F1A12870
       PZE     WTXQ5,,EXEQTP                                            F1A12880
       TSX     (TAPE),4       WRITE END-OF-FILE AFTER EXECUTABLE        F1A12890
       PZE     ,,(WEFP)       STATEMENTS.                               F1A12900
       PZE     EXEQF,,EXEQTP                                            F1A12910
       TSX     (TAPE),4       REWIND TAPE.                              F1A12920
       PZE     REWD,,(SKBP)                                             F1A12930
       PZE     ,,EXEQTP                                                 F1A12940
       ZET     DGFLAG         HAS THERE BEEN AN ERROR.                  F1A12941
       TRA     P1EXIT        *YES, SKIP DUMP.                           F1A12942
       LDC     INTETI-3,1    COMPUTE THE ROOM IN THE TWO BUFFERS.       F1A12950
       TXI     *+1,1,FRMTSZ-1     FORMAT, AND                           F1A12960
       TXI     *+1,1,EQITSZ*2   EQUIT.                                  F1A12970
       SXD     TEST,1                                                   F1A12980
       LDC     BFCNT,2       GET THE MUMBER TO MOVE                     F1A12990
       TXI     *+1,2,BFSZ                                               F1A13000
 TEST  TXH     DUMP,2,**     TEST FOR ROOM ENOUGH                       F1A13010
       SXD     INTETK-3,2    UPDATE BUFFER P COUNT                      F1A13020
       AXT     FRMTBF+FRMTSZ-1,4                                        F1A13030
       SXD     *+1,2         SET BUFFER ORIGIN FOR 1 PRIME.             F1A13040
       TIX     *+1,4,**                                                 F1A13050
       SXA     INTETK-3,4                                               F1A13060
       LDC     BFCNT,4       INITIALIZE MOVE LOOP                       F1A13070
       TXI     *+1,4,TABORG                                             F1A13080
       SXA     *+1,4                                                    F1A13090
 MOVF  CLA     **,2                                                     F1A13100
       STO     FRMTBF+FRMTSZ-1,2                                        F1A13110
       TIX     *-2,2,1                                                  F1A13120
       TSX     (TAPE),4                                                 F1A13130
       PZE     FRMTTP,,(CHKU)                                           F1A13140
       LXD     FLBL,4        PUT DUMP COUNT WHERE 1 PRIME               F1A13150
       SXA     INTETK+1,4    CAN FIND IT.                               F1A13160
       TRA     P1EXIT                                                   F1A13170
DUMP   SXD     *+1,1          GET THE NUMBER OF WORDS TO DUMP.          F1A13180
       TIX     *+1,2,**                                                 F1A13190
       PXD     0,2                                                      F1A13200
       ADD     INTETK+1                                                 F1A13210
       STD     INTETK+1                                                 F1A13220
       SXD     FORIO+1,2                                                F1A13230
       LXD     FLBL,4                                                   F1A13240
       TXI     *+1,4,1       UPDATE THE DUMP COUNT                      F1A13250
       SXD     FLBL,4        PUT IT IN THE LABEL                        F1A13260
       TSX     (TAPE),4      OUT THEY GO                                F1A13270
       PZE     FORIO,,(WBNP)    CHECK LATER                             F1A13280
       PZE     INTETK+2,,FRMTTP                                         F1A13290
       STL     TETFLG         SET FLAG TO INDICATE DATA ON TAPE.        F1A13291
       LXD     TEST,2        SET UP NUMBER TO BE MOVED                  F1A13300
       TRA     TEST+1        AND GO DO IT.                              F1A13310
P1EXIT CLS     PASS1          FLIP SWITCH FOR PASS 2.                   F1A13320
       STO     PASS1                                                    F1A13330
       REM                                                              F1A13340
CALLP2 STZ     DGX1           SET FLAG FOR DIAGNOSTIC CALLER.           F1A13350
       LXD     INTETM-3,4     LOAD COUNT OF WORDS IN COMMON BUFFER.     F1A13360
       PXA     ,4             PLACE IN AC.                              F1A13370
       STO     ERASE          SAVE IN ERASABLE.                         F1A13380
       CLA     INTETM-1       GET COMMON MAXIMUM BUFFER SIZE.           F1A13390
       SUB     ERASE          SUBTRACT THE USED PORTION.                F1A13400
       ADD     INTETN-1       ADD MAXIMUM SIZE FOR HOLARG TABLE BUFFER. F1A13410
       STA     INTETN-1       SET NEW BUFFER SIZE FOR HOLARG.           F1A13420
       CLA     INTETM-3       GET COMMON BUFFER ORIGIN.                 F1A13430
       ADD     ERASE          ADD COUNT OF WORDS IN COMMON BUFFER.      F1A13440
       STA     INTETN-3       SET NEW HOLARG BUFFER ORIGIN.             F1A13450
       NZT     DGFLAG         HAS THERE BEEN A DIAGNOSTIC.              F1A13460
       TRA     RP2I          NO, GET PASS TWO.                         $F1A13470
       TSX     (TAPE),4       YES, REPOSITION SYSTEM TAPE TO BEFORE     F1A13480
       PZE     BKSP,,(SKBP)   PASS 2.                                   F1A13490
       PZE     ,,SYSTAP                                                 F1A13500
       TRA     RP2I          GET PASS TWO                              $F1A13510
       REM                                                              F1A13520
       REM *************************************************************F1A13521
       REM                                                              F1A13530
       REM     SUBROUTINE USED TO WRITE EXECUTABLE STATEMENTS           F1A13540
       REM     ON AN INTERMEDIATE TAPE FOR PROCESSING IN PASS2.         F1A13550
       REM                                                              F1A13560
       REM     WTXQ0 / CALLS CF000 TO PROCESS NON-EXECUTABLE STATEMENTS,F1A13570
       REM             OR I/O PACKAGE TO WRITE EXECUTABLE STATEMENTS.   F1A13580
       REM                                                              F1A13590
WTXQ0  CLA     T,1            ENTRY POINT FOR STATEMENTS IN DICTIONARY. F1A13600
       REM               WTXQ1 IS THE ENTRY POINT FOR ARITH. STATEMENTS.F1A13610
WTXQ1  STO     TLABEL         SET TRANSFER LABEL.                       F1A13620
       TMI     CF000         *TRANSFER IF STATEMENT IS NON-EXECUTABLE.  F1A13630
       LDC     DCF,1          GET TRUE ADDRESS OF CURRENT F-REGION.     F1A13640
       SXA     WTXQ2,1        SET ADDRESS OF LOOP TO MOVE TLABEL, ETC.  F1A13650
       TXI     *+1,1,-4       SET INDEX TO TRUE ADDRESS OF TLABEL.      F1A13660
       SXA     WTXQ4,1        SET I/O COMMAND ADDRESS.                  F1A13670
       AXT     4,2            MOVE TLABEL, MODECL, EFN, AND FIRST5      F1A13680
       CAL     FIRST5+1,2     INTO CURRENT OUTPUT BUFFER AHEAD OF       F1A13690
WTXQ2  SLW     **,2           CURRENT F-REGION.                         F1A13700
       TIX     *-2,2,1                                                  F1A13710
WTXQ3  AXC     **,2           GET TRUE NUMBER OF LAST WORD IN F-REGION. F1A13720
       SXD     *+1,1          SET TIX WITH ORIGIN OF CURRENT F-REGION   F1A13730
       TIX     *+1,2,**       (INCLUDING 4 DATA CELLS). COMPUTE LENGTH  F1A13740
       SXD     WTXQ4,2        OF ENTIRE F-REGION AND SET I/O COMMAND.   F1A13750
       LXA     XEQCTR,4       LOAD COUNT OF EXECUTABLE STATEMENTS       F1A13760
       TXI     *+1,4,1        WRITTEN ON TAPE AND INCREMENT.            F1A13770
       SXA     XEQCTR,4                                                 F1A13780
       TSX     (TAPE),4       WRITE STATEMENT ON TAPE FOR PASS2.        F1A13790
       PZE     WTXQ4,,(WBNP)                                            F1A13800
       PZE     WTXQ5,,EXEQTP                                            F1A13810
       TRA     PASS1          RETURN TO PASS1 SWITCH.                   F1A13820
       REM                                                              F1A13830
WTXQ4  IORT    **,,**         I/O COMMAND TO WRITE EXEQUTABLE STATS.    F1A13840
       REM                                                              F1A13850
       REM *************************************************************F1A13851
       REM                                                              F1A13860
       REM     SUBROUTINE TO READ A RECORD FROM THE                     F1A13870
       REM     BCD INPUT TAPE INTO THE TEMPORARY F REGION.              F1A13880
       REM                                                              F1A13890
LDFT0  SXA     LDFT4,4        SAVE LINKAGE.                             F1A13900
LDFT1  AXT     -1,2           LOAD BUFFER SWITCH (+1 OR -1)             F1A13910
       TSX     (TAPE),4       READ A RECORD FROM BCD INPUT TAPE.        F1A13920
LDFTT  PZE     FTREG,2,(RDEP)                                           F1A13930
       PZE     ,,INPUTP                                                 F1A13940
       LAC     LDFT1,2        FLIP BUFFER SWITCH.                       F1A13950
       SXA     LDFT1,2                                                  F1A13960
       CAL     (SCHU)+INPUTP  GET RESULT OF SCHX.                       F1A13970
       TNZ     *+3            WAS AN END-OF-FILE READ.                  F1A13980
       SXD     LDFT2,0        YES, SET EOF FLAG.                        F1A13990
LDFT2  TXI     LDFR5,,-1      TAKE EOF EXIT.                            F1A14000
       STA     FTREG          SET LAST+1 FOR TIX LOOP.                  F1A14010
       SUB     FTREG,2        COMPUTE WORD COUNT OF RECORD.             F1A14020
       PAX     ,2             WERE LESS THAN 3 WORDS READ.              F1A14030
       TXL     LDFT1,2,3     *YES, IGNORE IT, MOST LIKELY NOISE.        F1A14040
       SXA     LDFT5,2        NO, SAVE WORD COUNT.                      F1A14050
       PXD     ,0             CLEAR AC.                                 F1A14060
       LDQ*    FTREG          GET FIRST CHARACTER OF                    F1A14070
       LGL     6              CARD IN AC.                               F1A14080
       LAS     L(C)           IS THIS A COMMENT CARD.                   F1A14090
       TRA     *+2            NOT A (C) COMMENTS CARD.                  F1A14100
       TRA     LDFT1          YES, IGNORE IT.                           F1A14110
       ERA     STAR           DOES COLUMN 1 CONTAIN (*).                F1A14120
       TZE     LDFT1         *YES, IGNORE IT, COMMENT OR MONITOR CARD.  F1A14130
LDFT3  CAL*    FTREG          IS THIS CARD COMPLETELY BLANK.            F1A14140
       ERA     BLANKS                                                   F1A14150
       TNZ     LDFT4         *NO, HAS AT LEAST A CONTINUATION PUNCH.    F1A14160
       TIX     LDFT3,2,1                                                F1A14170
       TRA     LDFT1         *YES, IGNORE IT.                           F1A14180
LDFT4  AXT     **,4           RESTORE LINKAGE.                          F1A14190
LDFT5  AXT     **,2           RELOAD WORD COUNT.                        F1A14200
       TRA     1,4            RETURN TO CALLER.                         F1A14210
       REM                                                              F1A14220
       REM *************************************************************F1A14221
       REM                                                              F1A14230
       REM     LDFR0 / CALLS LDFT0, SR6DC1                              F1A14240
       REM                                                              F1A14250
       REM     LDFR0 ASSEMBLES A STATEMENT IN THE F-REGION.             F1A14260
       REM                                                              F1A14270
FROVR  CAL     ALL1           SET END OF STATEMENT MARKER.              F1A14280
       SLW     -1,1           DIAGNOSTIC WILL NEED IT.                  F1A14290
ER1007 TSX     DIAG,4         STATEMENT TOO LONG FOR F-REGION.          F1A14300
       REM                                                              F1A14310
LDFR0  LXA     LDFT5,2                                                  F1A14320
       CAL*    FTREG          GET FIRST SIX CHARACTERS OF STATEMENT.    F1A14330
       ARS     6              ELIMINATE CONTINUATION MARK (IF ANY).     F1A14340
       SLW     FIRST5         SAVE FIRST FIVE.                          F1A14350
       LDQ     BLANKS         SHIFT EFN INTO MQ WITH TRAILING BLANKS.   F1A14360
       LGR     24                                                       F1A14370
       PAX     ,1             LOAD COLUMN INTO INDEX.                   F1A14380
       STZ     MODECL         CLEAR MODE INDICATOR.                     F1A14390
       TXL     LDFR1,1,9      IS COLUMN 1 NON-NUMERIC.                  F1A14400
       ERA     BLANK          YES, IS IT A BLANK.                       F1A14410
       TZE     LDFR2         *YES.                                      F1A14420
       SXA     MODECL,1       NO, SAVE IT AS A MODE INDICATOR.          F1A14430
       TRA     LDFR2          ENTIRE EFN (IF ANY) IS IN MQ.             F1A14440
LDFR1  LGR     6              SHIFT FIRST DIGIT OF EFN INTO MQ.         F1A14450
LDFR2  STQ     EFN            SAVE EXTERNAL FORMULA NUMBER (EFN).       F1A14460
       LXD     DCF,1          LOAD 2S COMPLEMENT OF LAST F-REGION USED. F1A14470
       TXI     *+1,2,-1       REDUCE FT INDEX TO SECOND WORD.           F1A14480
       CLA     TLABEL         WAS LAST STATEMENT EXECUTABLE.            F1A14490
       TMI     LDFR3         *NO, DO NOT FLIP BUFFERS.                  F1A14500
       TXH     *+2,1,-FRGBF2-4  SWITCH BUFFERS.                         F1A14510
       TXI     *+2,1,FREGSZ+4      FLIP TO BUFFER 1.                    F1A14520
       TXI     *+1,1,-FREGSZ-4     FLIP TO BUFFER 2.                    F1A14530
       SXD     DCF,1          SET BUFFER ADDRESS.                       F1A14540
       TXI     *+1,1,-FREGSZ  COMPUTE LAST ADDRESS OF BUFFER FOR        F1A14550
       SXD     LDFR4,1        OVERFLOW TEST.                            F1A14560
       LXD     DCF,1          LOAD F-REGION ORIGIN (2S COMPLEMENT FORM).F1A14570
LDFR3  LDQ*    FTREG          MOVE FT-REGION TO F-REGION.               F1A14580
       STQ     0,1                                                      F1A14590
       TXI     *+1,1,-1       UPDATE F-REGION ADDRESS.                  F1A14600
LDFR4  TXL     FROVR,1,**    *IS THE STATEMENT TOO LONG, YES.           F1A14610
       TIX     LDFR3,2,1      NO, IS FT-REGION EXHAUSTED.               F1A14620
       TSX     LDFT0,4        YES, RELOAD IT.                           F1A14630
       CAL*    FTREG          IS THIS CARD A CONTINUATION               F1A14640
       ANA     ENDMK          OF THE STATEMENT.                         F1A14650
       TZE     LDFR5         *NO.                                       F1A14660
       ERA     BLANK          POSSIBLY, IS COLUMN 6 BLANK.              F1A14670
       TZE     LDFR5         *YES.                                      F1A14680
       TXI     LDFR3,2,-1     NO, THIS IS A CONTINUATION CARD.          F1A14690
LDFR5  CAL     BLANKS         SCAN F-REGION BACKWARDS AND               F1A14700
LDFR6  LAS     -1,1           FIND THE LAST NON-BLANK WORD.             F1A14710
       TXI     *+3,1,-1       NON-BLANK, SET INDEX TO ENDMARK PLUS ONE. F1A14720
       TXI     LDFR6,1,1      BLANK, REDUCE F-REGION INDEX AND CONTINUE.F1A14730
       TXI     *+1,1,-1       NON-BLANK, SET INDEX TO ENDMARK PLUS ONE. F1A14740
       CAL     ALL1           INSERT END-MARK (36 BINARY 1S).           F1A14750
       SLW     -1,1                                                     F1A14760
       SXA     WTXQ3,1        SAVE ADDRESS OF LAST NON-BLANK WORD.      F1A14770
       LDQ     EFN            GET EXTERNAL FORMULA NUMBER (IF ANY).     F1A14780
       TSX     SR6DC1,1       CONVERT TO BINARY.                        F1A14790
       SLW     EFN            SET TO BINARY EQUIVALENT.                 F1A14800
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A14810
       REM                                                              F1A14820
       REM CD000/ CALLS=C0190X,C0190,DIAG.                              F1A14830
       REM CD000 SCANS FOR HOLLERITH AND ILLEGAL CHARACTERS.            F1A14840
       CLA     MODECL        TEST FOR ASTERICK IN CC 1 WHICH INDICATES  F1A14850
       SUB     L(F)          TEST FOR F IN CC 1 WHICH MEANS A FORTRAN 3 F1A14860
       TNZ     SCAN0        *FUNCTION LIST.  IS NOT A LIST.             F1A14870
       REM     NAMES FROM FUNCTION LIST ARE ENTERED IN CLOSUB TABLE.    F1A14880
       TSX     C0190X,4      SET SCAN TO FIRST POSITION.                F1A14890
FCARD0 TSX     C0190,4       PLACE FIRST NON-BLANK CHARACTER OF NAME IN F1A14900
       TSX     C0160,2       AC AND THEN COLLECT NAME IN 1G CELL.       F1A14910
       TSX     TESTA0,4      TEST NEXT CHARACTER FOR COMMA OR ENDMK.    F1A14920
       CLA     1G            MOVE SUBROUTINE NAME TO INPUT CELL FOR TET F1A14930
       STO     G             SUBROUTINE.                                F1A14940
       TSX     TET00,1       ENTER NAME IN CLOSUB TABLE.                F1A14950
               9             WHOSE IDENTIFICATION NUMBER IS 9.          F1A14960
       CLA     1H            INSPECT CHARACTER FOLLOWING NAME FOR ENDMK.F1A14970
       SUB     ENDMK                                                    F1A14980
       TNZ     FCARD0        NOT ENDMK, CONITNUE COLLECTING NAMES.      F1A14990
       SSM                    SET  FLAG FOR LDFR ROUTINE SO THAT        F1A15000
       STO     TLABEL         IT WILL NOT FLIP BUFFERS.                 F1A15010
       TRA     PASS1         GO TO NEXT SOURCE STATEMENT.               F1A15020
       REM                                                              F1A15030
       REM *************************************************************F1A15040
       REM                                                              F1A15041
       REM     SCAN0 / CALLS WTXQ0, CC000, DIAG AND (DIAG).             F1A15042
       REM                                                              F1A15043
       REM     SCANS AN ASSEMBLED STATEMENT IN ORDER TO DETERMINE IF    F1A15044
       REM     THERE ARE ANY ILLEGAL CHARACTERS CONTIANED IN THE        F1A15045
       REM     STATEMENT AND WHETHER THE STATEMENT IS ARITHMETIC        F1A15050
       REM     OR NON-ARITHMETIC.                                       F1A15051
       REM                                                              F1A15052
       REM     AN ARITHMETIC STATEMENT IS OF THE FORM -                 F1A15053
       REM                                                              F1A15054
       REM          ALPHA = BETA                                        F1A15055
       REM                                                              F1A15060
       REM          WHERE ALPHA IS  1) A NON-SUBSCRIPTED VARIABLE       F1A15061
       REM                          2) A SUBSCRIPTED VARIABLE           F1A15062
       REM                                                              F1A15063
       REM          AND BETA IS     1) A CONSTANT                       F1A15064
       REM                          2) A NON-SUBSCRIPTED VARIABLE       F1A15065
       REM                          3) A SUBSCRIPTED VARIABLE           F1A15070
       REM                          4) AN EXPRESION OF THE FORM         F1A15071
       REM                                                              F1A15072
       REM                             A+B-C*D/E**F+FUNCTION (G,H,I)    F1A15073
       REM                                                              F1A15074
       REM                                   WHERE A,B,C,D,E,F,G,H AND  F1A15075
       REM                                   I ARE 1,2,3, AND 4 ABOVE.  F1A15080
       REM                                                              F1A15081
       REM                                                              F1A15082
       REM     A HOLLERITH LITERAL MAY APPEAR IN AN ARITHMETIC          F1A15083
       REM     STATEMENT.  A HOLLERITH FIELD APPEARS IN NON-ARITHMETIC  F1A15084
       REM     STATEMENTS.                                              F1A15085
       REM                                                              F1A15090
       REM          A HOLLERITH LITERAL IS DEFINED AS THE SEQUENCE -    F1A15091
       REM                                                              F1A15092
       REM               +NH....        (+NH....)                       F1A15093
       REM               -NH....        (-NH....)                       F1A15094
       REM               *NH....        (*NH....)                       F1A15095
       REM                                                              F1A15100
       REM          A HOLLERITH FIELD IS DEFINED AS THE SEQUENCE -      F1A15101
       REM                                                              F1A15102
       REM               (NH....                                        F1A15103
       REM               /NH....                                        F1A15104
       REM               ,NH....                                        F1A15105
       REM                                                              F1A15110
       REM                                                              F1A15111
       REM     A NON-ARITHMETIC STATEMENT IS OF THE FORM -              F1A15112
       REM                                                              F1A15113
       REM          1) X                5) X (Y=Y,Y)                    F1A15114
       REM          2) X (Y)            6) X Y                          F1A15115
       REM          3) X (Y,Y)          7) X Y,Y                        F1A15120
       REM          4) X (Y),(Y)        8) X Y=Y,Y                      F1A15121
       REM                                                              F1A15122
       REM          WHERE X IS A DECLARATION, DESCRIPTION, DIRECTIVE,   F1A15123
       REM          OR QUESTION.                                        F1A15124
       REM                                                              F1A15125
       REM          AND Y IS THE SAME AS THE ABOVE BETA IN AN           F1A15130
       REM          ARITHMETIC STATEMENT OR A WORD.                     F1A15131
       REM                                                              F1A15132
       REM                                                              F1A15133
 SCAN0 TRA     SCAN00         GO TO PATCH TO TEST FOR IF(.             $F1A15140
       STZ     LITFG          RESET HOLLERITH LITER FLAG.               F1A15141
       STZ     HOLFG          RESET HOLLERITH FIELD FLAG.               F1A15142
       STZ     NOTAF          RESET NON-ARITHMETIC FLAG.                F1A15143
       STZ     EQSFG          RESET EQUALS SIGN FLAG.                   F1A15144
       LXD     DCF,2          LOAD ORIGIN OF F-REGION.                  F1A15150
       ZAC                    RESET PAREN COUNTER.                      F1A15151
SCAN1  LDQ     0,2            GET A WORD OF THE STATEMENT.              F1A15160
       AXT     6,4            INITIALIZE CHARACTER COUNT.               F1A15161
SCAN2  CAQ     SCANT,1,1      CHECK A CHARACTER.                        F1A15162
       TRA     CHSV1          STORE CURRENT CHARACTER                  $F1A15163
       REM                                                              F1A15170
       REM                    TRANSFER VECTOR.                          F1A15171
       REM                                                              F1A15172
       DUP     1,4            SPACE FOR ADDITIONAL BRANCHES.           $F1A15173
       PZE                    23-26                                    $F1A15174
       REM                                                              F1A15175
       TRA     PMS01          22 - CHARACTER IS *                      $F1A15179
ER0026 TSX     DIAG,4         21 - CHARACTER IS $                       F1A15180
ER0027 TSX     DIAG,4         20 - CHARACTER IS + ZERO                  F1A15181
ER0028 TSX     DIAG,4         17 - CHARACTER IS - ZERO                  F1A15182
ER0029 TSX     DIAG,4         16 - CHARACTER IS RECORD MARK             F1A15183
ER0030 TSX     DIAG,4         15 - CHARACTER IS 8-4 PUNCH               F1A15184
       TSX     OCTL12,4       14 - CHARACTER IS OCTAL 12.               F1A15185
       TRA     END00          13 - CHARACTER IS ENDMARK                 F1A15190
       TRA     CHRX0          12 - CHARACTER IS X                       F1A15191
       TRA     CHRH0          11 - CHARACTER IS H                       F1A15192
       TRA     LPRN0          10 - CHARACTER IS (                      $F1A15193
       TRA     RPRN0          07 - CHARACTER IS )                      $F1A15194
       TRA     EQUS0          06 - CHARACTER IS =                      $F1A15195
       TRA     COMA0          05 - CHARACTER IS ,                      $F1A15200
       TRA     PMS01          04 - CHARACTER IS /                      $F1A15201
       TRA     PMS01          03 - CHARACTER IS +-                     $F1A15202
       TRA     DIGT0          02 - CHARACTER IS NUMERIC                $F1A15203
       TRA     LEGL0          01 - CHARACTER IS LEGAL                  $F1A15204
SCAN3  TIX     SCAN2,4,1      00 - CHARACTER IS BLANK OR COUNT TEST.    F1A15205
SCAN4  TXI     SCAN1,2,-1    *WORD EXHAUSTED, GET ANOTHER.              F1A15210
       REM                                                              F1A15211
       REM                                                              F1A15212
       REM                    CHARACTER IS A NUMERIC.                   F1A15213
       REM                                                              F1A15214
DIGT0  ZET     HOLFG          IS THIS POSSIBLY A HOLLERITH FIELD.       F1A15220
       TRA     DIGT1          YES. N FOLLOWS (/ OR ,                    F1A15221
       NZT     LITFG          NO. IS THIS POSSIBLY A HOLLERITH LITERAL. F1A15222
       TRA     SCAN3         *NO.  N DOES NOT FOLLOW +-*                F1A15223
DIGT1  STQ     C(MQ)          YES. SAVE CONTENTS OF MQ.                 F1A15224
       XCL                    SAVE AC IN MQ AND MOVE DIGIT TO           F1A15225
       ANA     ENDMK          LOW ORDER OF AC AND PRESERVE IT.          F1A15230
       SLW     2G             SAVE DIGIT.                               F1A15231
       CLA     1G             GET PREVIOUS PARTIAL RESULT.              F1A15232
       ALS     2              MULTIPLY BY 4.                            F1A15233
       ADD     1G             ADD NEW DIGIT.                            F1A15234
       ALS     1              MULTIPLY BY 2.                            F1A15235
       ADD     2G             ADD NEW DIGIT AGAIN.                      F1A15240
       STO     1G             SAVE PARTIAL RESULT.                      F1A15241
       XCL                    RESTORE PAREN COUNT IN AC.                F1A15242
       LDQ     C(MQ)          RESTORE CHARACTERS IN MQ.                 F1A15243
       TRA     SCAN3         *RETURN TO SCAN.                           F1A15244
       REM                                                              F1A15245
       REM                    CHARACTER IS LEGAL AND INSIGNIFICANT.     F1A15250
       REM                                                              F1A15251
LEGL0  ANA     1BAR           AVOID FIELD OVERFLOW, MASK DECREMENT.     F1A15260
       STZ     HOLFG          RESET HOLLERITH FIELD FLAG.               F1A15261
       STZ     LITFG          RESET HOLLERITH LITERAL FLAG.             F1A15262
       STZ     1G             CLEAR CONVERSION CELL.                    F1A15263
       TRA     SCAN3         *RETURN TO SCAN.                           F1A15264
       REM                                                              F1A15265
       REM                    CHARACTER IS +-* OR =                     F1A15270
       REM                                                              F1A15271
PMS00  STL     LITFG          SET POSSIBLE HOLLERITH LITERAL FLAG.      F1A15272
       STZ     HOLFG          RESET POSSIBLE HOLLERITH FIELD FLAG.      F1A15273
       STZ     1G             CLEAR CONVERSION CELL.                    F1A15274
       TRA     SCAN3         *RETURN TO SCAN.                           F1A15275
       REM                                                              F1A15280
       REM                    CHARACTER IS /( OR ,                      F1A15281
       REM                                                              F1A15282
SLSH0  STL     HOLFG          SET POSSIBLE HOLLERITH FIELD FLAG.        F1A15290
       STZ     LITFG          RESET POSSIBLE HOLLERITH LITERAL FLAG.    F1A15291
       STZ     1G             CLEAR CONVERSION CELL.                    F1A15292
       TRA     SCAN3         *RETURN TO SCAN.                           F1A15293
       REM                                                              F1A15300
       REM                    CHARACTER IS ,                            F1A15301
       REM                                                              F1A15302
COMA0  PDX     ,1             LOAD PAREN COUNT. IS COMMA INSIDE PARENS. F1A15310
       TXH     SLSH0,1,0      *YES,IS SUBSCRIPT OR ARGUMENT SEPARATOR  $F1A15311
COMA1  STL     NOTAF          NO. THIS MUST BE A NON-ARITHMETIC         F1A15312
       TRA     LEGL0         *STATEMENT, SET FLAG AND CLEAR FLAGS.      F1A15313
       REM                                                              F1A15320
       REM                    CHARACTER IS =                            F1A15321
       REM                                                              F1A15322
EQUS0  PDX     ,1             LOAD PAREN COUNT. IS EQUALS INSIDE PARENS.F1A15330
       TXH     COMA1,1,0     *YES, MUST BE I/O LIST.                    F1A15331
       STL     EQSFG          NO. SET FLAG FOR POSSIBLE ARITHMETIC.     F1A15332
       TRA     PMS00         *TREAT AS POSSIBLE HOLLERITH LITERAL       F1A15333
       REM                    DEFINITION.                               F1A15334
       REM                                                              F1A15340
       REM                    CHARACTER IS )                            F1A15341
       REM                                                              F1A15342
RPRN0  PDX     ,1             LOAD PAREN COUNT. HAS COUNT GONE MINUS.   F1A15350
       TXL     LEGL0,1,1200   *NO,CLEAR FLAGS                          $F1A15351
       TRA     ER0032        *YES.  GO TO DIAGNOSTIC.                   F1A15352
       REM                                                              F1A15360
       REM                    CHARACTER IS (                            F1A15361
       REM                                                              F1A15362
LPRN0  TRA     SLSH0         *TREAT AS POSSIBLE HOLLERITH FIELD DEF.    F1A15363
       REM                                                              F1A15370
       REM                    CHARACTER IS H.                           F1A15371
       REM                                                              F1A15372
CHRH0  ZET     LITFG          IS THIS POSSIBLY A HOLLERITH LITERAL.     F1A15380
       TRA     CHRH1          YES.                                      F1A15381
       NZT     HOLFG          NO. IS THIS POSSIBLY A HOLLERITH FIELD.   F1A15382
       TRA     LEGL0          *NO,MUST BE VARIABLE OR WORD             $F1A15383
CHRH1  LXA     1G,1           YES. LOAD CHARACTER COUNT.                F1A15384
       TXL     LEGL0,1,0      *IS COUNT 0.YES,NOT HOLLERITH            $F1A15385
       ZET     HOLFG          IS THIS A HOLLERITH FIELD.                F1A15390
       STL     NOTAF          YES. SET NON-ARITHMETIC FLAG.             F1A15391
       SLW     C(MQ)          SAVE CONTENTS OF AC.                      F1A15392
CHRH2  TIX     CHRH3,4,1     *ANY CHARACTERS LEFT IN MQ, YES.           F1A15393
       TXI     *+1,2,-1       NO. INCREMENT F-REGION INDEX.             F1A15394
       LDQ     0,2            GET ANOTHER WORD OF STATEMENT.            F1A15395
       AXT     6,4            INITIALIZE COUNT OF CHARACTERS IN MQ.     F1A15400
CHRH3  SXA     CHRH4,1        SAVE HOLLERITH CHARACTER COUNT.           F1A15401
       CAQ     SCANT,1,1      CHECK A CHARACTER.                        F1A15402
       TRA     CHRH4,1       *BRANCH ON ANALYSIS OF CHARACTER.          F1A15403
       REM                                                              F1A15410
       REM                    TRANSFER VECTOR FOR HOLLERITH SCAN.       F1A15411
       REM                                                              F1A15412
       DUP     1,4            SPACE FOR ADDITIONAL BRANCHES.           $F1A15420
       PZE                                                              F1A15421
       REM                                                              F1A15422
       TRA     CHRH4          CHARACTER IS *                           $F1A15429
       TRA     CHRH4          CHARACTER IS $                            F1A15430
       TRA     ER0027         CHARACTER IS + ZERO                       F1A15431
       TRA     ER0028         CHARACTER IS - ZERO                       F1A15432
       TRA     ER0029         CHARACTER IS RECORD MARK                  F1A15433
       TRA     CHRH4          CHARACTER IS 8-4 PUNCH.                   F1A15434
       TSX     OCTL12,4       CHARACTER IS OCTAL 12                     F1A15435
ER0075 TSX     DIAG,4         CHARACTER IS ENDMARK                      F1A15440
       TRA     CHRH4          CHARACTER IS X                            F1A15441
       TRA     CHRH4          CHARACTER IS H                            F1A15442
       TRA     CHRH4          CHARACTER IS (                            F1A15443
       TRA     CHRH4          CHARACTER IS )                            F1A15444
       TRA     CHRH4          CHARACTER IS '                            F1A15445
       TRA     CHRH4          CHARACTER IS ,                            F1A15450
       TRA     CHRH4          CHARACTER IS /                            F1A15451
       TRA     CHRH4          CHARACTER IS +-*                          F1A15452
       TRA     CHRH4          CHARACTER IS NUMERIC                      F1A15453
       TRA     CHRH4          CHARACTER IS LEGAL                        F1A15454
CHRH4  AXT     **,1           CHARACTER IS BLANK OR COUNT TEST.         F1A15455
       TIX     CHRH2,1,1     *IS HOLLERITH FIELD EXHAUSTED, NO.         F1A15460
       STZ     1G             YES. CLEAR CONVERSION CELL.               F1A15461
       STZ     LITFG          RESET HOLLERITH LITERAL FLAG.             F1A15462
       CAL     C(MQ)          RESTORE PAREN COUNT IN AC.                F1A15463
       TRA     SCAN3         *RETURN TO NORMAL SCAN.                    F1A15464
       REM                                                              F1A15470
       REM                    CHARACTER IS X                            F1A15471
       REM                                                              F1A15472
CHRX0  ZET     HOLFG          IS THIS POSSIBLY A  BLANK SPECIFICATION.  F1A15480
       NZT     1G             YES. IS THE COUNT NON-ZERO.               F1A15481
       TRA     LEGL0          *NO,NOT BLANK FIELD SPECIFICATION        $F1A15482
       STZ     1G             YES. CLEAR BLANK COUNT.                   F1A15483
       STL     NOTAF          SET NON-ARITHMETIC FLAG.                  F1A15484
       TRA     SCAN3         *RETURN TO SCAN.                           F1A15485
       REM                                                              F1A15490
       REM                    CHARACTER IS ENDMARK                      F1A15491
       REM                                                              F1A15492
END00  PDX     ,1             LOAD PAREN COUNT.                         F1A15500
       TXL     END01,1,0     *DO PARENS BALANCE, YES.                   F1A15501
       TXL     *+2,1,1200     NO, TOO MANY LEFTS OR TOO MANY RIGHTS.    F1A15502
ER0032 TSX     DIAG,4        *TOO MANY RIGHT PARENS.                    F1A15510
ER0074 TSX     DIAG,4        *TOO MANY LEFT PARENS.                     F1A15511
END01  NZT     NOTAF          IS THE NON-ARITHMETIC FLAG SET.           F1A15520
       NZT     EQSFG          NO. DOES STATEMENT LACK AN = SIGN.        F1A15521
       TRA     CC000         *YES. GO TO DICTIONARY LOOK-UP.            F1A15522
       AXT     ARITH,4        LOAD ARITHMETIC TRANSFER ADDRESS.         F1A15530
       PXA     ,4             SET IN AC FOR WTXQ ROUTINE.               F1A15531
       TRA     BGPCH         *WRITE STATEMENT ON INTERMEDIATE          $F1A15532
       REM                    STORAGE FOR PASS TWO.                     F1A15533
       REM                                                              F1A15540
       REM                                                              F1A15541
       REM                    TABLE FOR SCANNING A STATEMENT.           F1A15542
       REM                                                              F1A15543
       REM     00 01 02 03 04 05 06 07 10 11 12  = 14 15 16 17  +       F1A15550
SCANT  OCT     02,02,02,02,02,02,02,02,02,02,14,06,15,01,01,01,03       F1A15551
       REM                                                              F1A15552
       REM      A  B  C  D  E  F  G  H  I +0  .            ) 35 36 37  -F1A15560
       OCT     01,01,01,01,01,01,01,11,01,20,01,077777000007,01,01,01,03F1A15561
       REM                                                              F1A15562
       REM      J  K  L  M  N  O  P  Q  R -0  $  * 55 56 57 BL  /       F1A15570
       OCT     01,01,01,01,01,01,01,01,01,17,21,22,01,01,01,00,04      $F1A15571
       REM                                                              F1A15572
       REM      S  T  U  V  W  X  Y  Z RM  ,            ( 75 76 ENDMARK F1A15580
       OCT     01,01,01,01,01,12,01,01,16,05,000001000010,01,01,13      F1A15581
       REM                                                              F1A15582
       REM                    CLASSIFICATION FLAGS.                     F1A15590
       REM                                                              F1A15591
LITFG  PZE     **             HOLLERITH LITERAL FLAG.                   F1A15600
HOLFG  PZE     **             HOLLERITH FIELD FLAG.                     F1A15601
EQSFG  PZE     **             EQUALS SIGN FLAG.                         F1A15602
NOTAF  PZE     **             NON-ARITHMETIC FLAG.                      F1A15603
C(MQ)  PZE     **             CELL FOR SAVING MQ OR AC.                 F1A15604
       REM                                                              F1A15605
       REM                                                              F1A15610
       REM *************************************************************F1A15620
       REM                                                              F1A15630
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A16290
       REM                                                              F1A16300
       REM CC000/ CALLS=CC500,C0190X,DIAG,C0190.                        F1A16310
       REM CC000 CLASSIFIES STATEMENT AS TO WHICH NON-ARITHMETIC.       F1A16320
CC000  STZ 2G                        SET DICTIONARY WORD TAG, AND       F1A16330
       LXA L(0),3                    CHARACTER COUNT AND ENTRY COUNT.   F1A16340
CC001  TSX C0190X,4                * RESET CHCTR AND FWA TO BEGIN SCAN. F1A16350
       TSX CC500,4                 * EXAMINE NEXT DICTIONARY CHARACTER. F1A16360
       CAS ENDMK                     TEST FOR CONSECUTIVE ENDMARKS.     F1A16370
       TSX     MRTN77,4      *CHARACTER GREATER THAN 77 OCTAL, IMPOSS.  F1A16380
       TRA     ER0033              *  ERROR, NOT FOUND IN DICTIONARY.   F1A16390
       TXI     CC004,,0              BEGIN COMPARISON.                  F1A16400
CC002  TSX CC500,4                 * EXAMINE NEXT DICTIONARY CHARACTER. F1A16410
       CAS ENDMK                     TEST FOR END OF DIC ENTRY.         F1A16420
       TSX     MRTN77,4      *CHARACTER GREATER THAN 77 OCTAL, IMPOSS.  F1A16430
       TRA     WTXQ0         *IF END OF ENTRY, LOOK NO FURTHER.         F1A16440
CC004  STO 1C+3                      OTHERWISE, SAVE CHARACTER          F1A16450
       STQ 1C+1                      AND REMAINDER OF DICTIONARY WORD.  F1A16460
       TSX C0190,4                 * GO GET NEXT FORMULA CHARACTER,     F1A16470
       LDQ 1C+1                      AND RESTORE DICTIONARY WORD.       F1A16480
       SUB 1C+3                      IF CHARACTERS ARE EQUAL,           F1A16490
       TZE CC002                     THEN GO COMPARE NEXT CHARACTERS.   F1A16500
CC005  TSX CC500,4                 * OTHERWISE, EXAMINE NEXT DIC CHAR.  F1A16510
       SUB ENDMK                     CONTINUE UNTIL AN ENDMARK IS       F1A16520
       TNZ CC005                     FOUND, THEN                        F1A16530
       TXI CC001,1,-1                COUNT ENTRY, AND BEGIN AGAIN.      F1A16540
       REM  END OF PROGRAM CC000.                                       F1A16550
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A16560
       REM                                                              F1A16570
       REM CC500,4/                                                     F1A16580
       REM CC500 BRINGS NEXT CHARACTER OF DICTIONARY INTO AC(30-35).    F1A16590
CC500  PXD ,0                        CLEAR THE AC.                      F1A16600
       TIX CC502,2,1                 IF NO DICTIONARY CHARACTERS        F1A16610
       LXD 2G,2                      REMAIN IN THE MQ, THEN             F1A16620
       LDQ DIC,2                     REFILL WITH NEXT DICTIONARY WORD.  F1A16630
       TXI CC501,2,-1                RESET THE                          F1A16640
CC501  SXD 2G,2                      DICTIONARY WORD TAG, AND           F1A16650
       LXA L(6),2                    SET THE CHARACTER COUNT = 6.       F1A16660
CC502  LGL 6                         SHIFT CHAR INTO AC(30-35),         F1A16670
       TRA 1,4                     * AND RETURN TO CALLER.              F1A16680
       REM  END OF PROGRAM CC500.                                       F1A16690
       REM                                                              F1A16700
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A16710
       REM                                                              F1A16720
       REM DIC/ DICTIONARY OF NON-ARITHMETIC STATEMENTS (USED BY CC500).F1A16730
DIC    OCT 244677274663              DO-GOT                             F1A16740
       OCT -67731267462              O-IF(S                             F1A16750
       OCT 254562256266              ENSESW                             F1A16760
       OCT 316323307731              ITCH-I                             F1A16770
       OCT 267462254562              F(SENS                             F1A16780
       OCT 254331273063              ELIGHT                             F1A16790
       OCT -373126243165             -IFDIV                             F1A16800
       OCT 312425233025              IDECHE                             F1A16810
       OCT 234277312621              CK-IFA                             F1A16820
       OCT 232364446443              CCUMUL                             F1A16830
       OCT 216346514665              ATOROV                             F1A16840
       OCT 255126434666              ERFLOW                             F1A16850
       OCT -373126506446             -IFQUO                             F1A16860
       OCT -233125456346             TIENTO                             F1A16870
       OCT -252551264346             VERFLO                             F1A16880
       OCT -267731267721             W-IF-A                             F1A16890
       OCT -226231274577             SSIGN-                             F1A16900
       OCT -226346477747             STOP-P                             F1A16910
       OCT 216462257762              AUSE-S                             F1A16920
       OCT 254562254331              ENSELI                             F1A16930
       OCT 273063772431              GHT-DI                             F1A16940
       OCT -42545623146              MENSIO                             F1A16950
       OCT -57725506431              N-EQUI                             F1A16960
       OCT -252143254523             VALENC                             F1A16970
       OCT 257726512550              E-FREQ                             F1A16980
       OCT -242545237077             UENCY-                             F1A16990
       OCT 234645633145              CONTIN                             F1A17000
       OCT -242577512521             UE-REA                             F1A17010
       OCT 246321472577              DTAPE-                             F1A17020
       OCT -112521243145             READIN                             F1A17030
       OCT -76463632147              PUTTAP                             F1A17040
       OCT 257751252124              E-READ                             F1A17050
       OCT 245164447751              DRUM-R                             F1A17060
       OCT 252124776651              EAD-WR                             F1A17070
       OCT 316325632147              ITETAP                             F1A17080
       OCT 257766513163              E-WRIT                             F1A17090
       OCT 254664634764              EOUTPU                             F1A17100
       OCT -236321472577             TTAPE-                             F1A17110
       OCT -265131632524             WRITED                             F1A17120
       OCT -116444774751             RUM-PR                             F1A17130
       OCT 314563774764              INT-PU                             F1A17140
       OCT -52330775125              NCH-RE                             F1A17150
       OCT -263145247722             WIND-B                             F1A17160
       OCT 212342624721              ACKSPA                             F1A17170
       OCT 232577254524              CE-END                             F1A17180
       OCT 263143257726              FILE-F                             F1A17190
       OCT -65144216377              ORMAT-                             F1A17200
       OCT -226422514664             SUBROU                             F1A17210
       OCT -233145257723             TINE-C                             F1A17220
       OCT -064444464577             OMMON-                             F1A17230
       OCT -112563645145             RETURN                             F1A17240
       OCT -372321434377             -CALL-                             F1A17250
       OCT 254524772664              END-FU                             F1A17260
       OCT -052363314645             NCTION                             F1A17270
       OCT 777777777777      ------    END OF DICTIONARY MARKER.        F1A17280
       BSS     10                                                       F1A17290
       REM  END OF DICTIONARY.                                          F1A17300
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A17310
       REM                                                              F1A17320
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A17330
       REM                                                              F1A17340
       REM CF000/ CALLS=SR6DC1,TET00.                                   F1A17350
       REM CF000 SETS EIFNO, NONEXC, FOR NON-EXECUTABLE STATEMENTS.     F1A17360
CF000  LXD     EIFNO,1               INCREASE INTERNAL                  F1A17370
       TXI     *+1,1,1               FORMULA NUMBER                     F1A17380
       SXD     EIFNO,1               BY ONE.                            F1A17390
       CAL     EFN                   EXAMINE EXTERNAL FORMULA NUMBER.   F1A17400
       TZE     CFNEXC                IF NON-ZERO, THEN                  F1A17410
       STA     EIFNO                 MAKE                               F1A17420
       TSX     TET00,1             * AN ENTRY                           F1A17430
       PZE     0                     IN TEIFNO.                         F1A17440
CFNEXC TSX     TET00,1             * THEN MAKE AN ENTRY                 F1A17450
       PZE     14                    IN THE NONEXC TABLE,               F1A17460
       TRA*    TLABEL              * AND GO PROCESS THIS STATEMENT.     F1A17470
       REM  END OF PROGRAM CF000.                                       F1A17480
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A17490
       REM                                                              F1A17500
       REM T/ TRANSFER TABLE (USED BY CF000).                           F1A17510
T      PZE     C0100,,2              DO.                                F1A17520
       PZE     C0200,,4              GO TO.                             F1A17530
       PZE     C0400,,14             IF (SENSE SWITCH.                  F1A17540
       PZE     C0500,,13             IF (SENSE LIGHT.                   F1A17550
       PZE     C0600,,13             IF DIVIDE CHECK.                   F1A17560
       PZE     C0700,,21             IF ACCUMULATOR OVERFLOW.           F1A17570
       PZE     C0700,,18             IF QUOTIENT OVERFLOW.              F1A17580
       PZE     C0300,,0              IF.                                F1A17590
       PZE     C1000,,6              ASSIGN.                            F1A17600
       PZE     C1300,,4              STOP.                              F1A17610
       PZE     C0900,,5              PAUSE.                             F1A17620
       PZE     C1100,,10             SENSE LIGHT.                       F1A17630
       MZE     C1200,,9              DIMENSION.                         F1A17640
       MZE     C1500,,11             EQUIVALENCE.                       F1A17650
       MZE     C1400,,9              FREQUENCY.                         F1A17660
       PZE     C1600,,8              CONTINUE.                          F1A17670
       PZE     TSB,,8                READ TAPE.                         F1A17680
       PZE     TSH,,13               READ INPUT TAPE.                   F1A17690
       PZE     DRS,,8                READ DRUM.                         F1A17700
       PZE     CSH,,4                READ.                              F1A17710
       PZE     STB,,9                WRITE TAPE.                        F1A17720
       PZE     STH,,15               WRITE OUTPUT TAPE.                 F1A17730
       PZE     SDR,,9                WRITE DRUM.                        F1A17740
       PZE     SPH,,5                PRINT.                             F1A17750
       PZE     SCH,,5                PUNCH.                             F1A17760
       PZE     RWT,,6                REWIND.                            F1A17770
       PZE     BST,,9                BACKSPACE.                         F1A17780
       PZE     EFT,,7                END FILE.                          F1A17790
       MZE     FOR,,6                FORMAT.                            F1A17800
       MZE     C3000,,10             SUBROUTINE.                        F1A17810
       MZE     C3100,,6              COMMON.                            F1A17820
       PZE     C3200,,6              RETURN.                            F1A17830
       PZE     C3300,,4              CALL.                              F1A17840
       MZE     C3400,,3              END.                               F1A17850
       MZE     C3500,,8              FUNCTION.                          F1A17860
       BSS     10                                                       F1A17870
       REM  END OF TRANSFER TABLE.                                      F1A17880
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A17890
       REM                                                              F1A17900
       REM  END OF PASS1 CLASSIFICATION.                                F1A17910
       REM                                                              F1A17920
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A17930
       REM                                                              F1A17940
       REM PASS 1/2-PROCESS NON-EXECUTABLE STATEMENTS=                  F1A17950
       REM                                                              F1A17960
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A17970
       REM                                                              F1A17980
       REM C1200/ CALLS=C0190,C0160,TEST..,DIM.SR,DIAG,C0180X.          F1A17990
       REM C1200 PROCESSES DIMENSION STATEMENTS.                        F1A18000
C1200  TSX C0190,4                 * PROCEED TO ASSEMBLE IN 1G          F1A18010
       TSX C0160,2                 * THE VARIABLE SYMBOL.               F1A18020
       TSX TESTE0,4                * NEXT NB CHARACTER SHOULD BE LPAREN.F1A18030
       TSX     C12SUB,1      USE SUBROUTINE TO COLLECT SPECIFICATION.   F1A18040
       TRA     C1200         NOT LAST SPECIFICATION, CONTINUE.          F1A18050
       TRA     PASS1               * EXIT TO PASS1.                     F1A18060
       REM SUBROUTINE TO COLLENT SPECIFICATIONS OF ARRAYS AND MAKE      F1A18070
       REM ENTRIES IN PROPER DIMENSION TABLE.                           F1A18080
       REM ENTRY HAS VARIABLE NAME IN 1G, SCAN IS POSITIONED AFTER (    F1A18090
C12SUB CLA 1G                        PUT VARIABLE SYMBOL                F1A18100
       STO 1C                        IN 1C.                             F1A18110
       STO E+2                       ALSO IN E+2. THEN                  F1A18120
       STZ     1C+2                                                     F1A18130
       STZ     1C+3                                                     F1A18140
       STZ     1C+4                                                     F1A18150
       REM                                                              F1A18160
       TSX DIM1SR,4                * GO SEARCH DIM1 TABLE.              F1A18170
       TRA C1280                     THEN IF NOT                        F1A18180
       TRA C1299                     FOUND,                             F1A18190
C1280  TSX DIM2SR,4                * GO SEARCH DIM2 TABLE.              F1A18200
       TRA C1281                     THEN IF NOT                        F1A18210
       TRA C1299                     FOUND,                             F1A18220
C1281  TSX DIM3SR,4                * GO SEARCH DIM3 TABLE.              F1A18230
       TRA C1282                     DO NOT CONTINUE IF                 F1A18240
ER0036 BSS 0                                                            F1A18250
C1299  TSX DIAG,4                  * VARIABLE PREVIOUSLY APPEARED.      F1A18260
C1282  TSX C0180X,2                * FORM IN 1G THE BINARY OF D1.       F1A18270
       TSX TESTB0,4          TEST FOR COMMA OR CLOSE PARENTHESIS.       F1A18280
       TZE C1210                     THEN                               F1A18290
       CLA 1G                        PUT D1                             F1A18300
       ALS 18                        IN DECR                            F1A18310
       STO 1C+1                      OF 1C+1.                           F1A18320
       TSX C0180X,2                * FORM IN 1G THE BINARY OF D2.       F1A18330
       TSX TESTB0,4          TEST FOR COMMA OR CLOSE PARENTHESIS.       F1A18340
       TZE C1220                     THEN                               F1A18350
       CLA 1G                        PUT D2                             F1A18360
       STA 1C+1                      IN ADDRESS OF 1C+1.                F1A18370
       TSX C0180X,2                * FORM IN 1G THE BINARY OF D3.       F1A18380
       SUB CLOS                      IF MORE THAN 3 DIMENSION,          F1A18390
       TZE *+2                       THIS IS AN                         F1A18400
ER0037 BSS 0                                                            F1A18410
       TSX DIAG,4                  * ERROR - GO TO THE DIAGNOSTIC.      F1A18420
       CLA 1G                        IF 3 DIMENSION, PUT D3             F1A18430
       STO 1C+2                      IN 1C+2, AND                       F1A18440
       TSX DIM3IX,4                * GO MAKE DIM3 ENTRY.                F1A18450
       TRA     DPDIM         GO TEST FOR DP-CA                          F1A18460
C1210  CLA 1G                        IF 1 DIMENSION, PUT D1             F1A18470
       STO 1C+1                      IN 1C+1, AND                       F1A18480
       TSX DIM1IX,4                * GO MAKE DIM1 ENTRY. THEN           F1A18490
       TRA     DPDIM         GO TEST FOR DP-CA                          F1A18500
C1220  CLA 1G                        IF 2 DIMENSION, PUT D2 IN          F1A18510
       STA 1C+1                      ADDRESS PART OF 1C+1. AND          F1A18520
       TSX DIM2IX,4                * GO MAKE DIM2 ENTRY. THEN           F1A18530
DPDIM  CLA     MODECL                                                   F1A18540
       CAS     L(D)                                                     F1A18550
       TRA     *+2                                                      F1A18560
       TRA     *+3                                                      F1A18570
       SUB     L(I)                                                     F1A18580
       TNZ     DPDIM2                                                   F1A18590
       CLA     1C+1          GET D1, D2                                 F1A18600
       STA     1C+3                                                     F1A18610
       STD     1C+4                                                     F1A18620
       NZT     1C+4                                                     F1A18630
       TRA     DPDIM3        ONE-DIMENSIONAL                            F1A18640
       LDQ     1C+3                                                     F1A18650
       MPY     1C+4                                                     F1A18660
       STQ     1C+1                                                     F1A18670
       NZT     1C+2                                                     F1A18680
       TRA     DPDIM1        TWO-DIMENSIONAL                            F1A18690
       MPY     1C+2                                                     F1A18700
       STQ     1C+1                                                     F1A18710
       TRA     DPDIM1                                                   F1A18720
DPDIM3 ALS     18                                                       F1A18730
       STO     1C+1                                                     F1A18740
DPDIM1 TSX     DLIST1,4      ENTER IN LIST OF DP CA ARRAYS              F1A18750
C1201  SYN     *                                                        F1A18760
DPDIM2 TSX     C0190,4       GET NEXT NON-BLANK CHARACTER               F1A18770
       TSX TESTA0,4                * TEST FOR COMMA OR ENDMARK.         F1A18780
       TNZ     1,1           RETURN TO +1 ON COMMA.                     F1A18790
       TRA     2,1           RETURN TO +2 ON ENDMARK.                   F1A18800
       REM  END OF PROGRAM C1200.                                       F1A18810
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A18820
       REM                                                              F1A18830
       REM C1400/ CALLS=C0190,C0180,TEST..,TET00.                       F1A18840
       REM C1400 PROCESSES FREQUENCY STATEMENTS.                        F1A18850
C1400  TSX C0180X,2                * GO COLLECT BINARY EFN. NEXT        F1A18860
       TSX TESTE0,4                * CHARACTER SHOULD BE A LPAREN.      F1A18870
       CLS 1G                        CHANGE SIGN OF EFN                 F1A18880
       STO 1G                        TO MINUS.                          F1A18890
       TSX TET00,1                 * GO MAKE AN ENTRY                   F1A18900
       PZE 7                         IN THE FRET TABLE.                 F1A18910
C1401  TSX C0180X,2                * COLLECT AND CONVERT CONSTANT.      F1A18920
       STO 1C                        SAVE THE NEXT CHARACTER.           F1A18930
       TSX TET00,1                 * GO ENTER CONSTANT                  F1A18940
       PZE 7                         INTO TABLE FRET (TABLE7), AND      F1A18950
       CLA 1C                        RESTORE CHAR IN ACC, AND           F1A18960
       TSX TESTB0,4                * TEST FOR , OR ).                   F1A18970
       TNZ C1401                     IF RIGHT PARENTHESIS, THEN         F1A18980
       TSX C0190,4                 * OBTAIN IN ACC NEXT NBCHAR, AND     F1A18990
       TSX TESTA0,4                * TEST FOR COMMA OR ENDMARK.         F1A19000
       TNZ C1400                     IF ENDMARK, THIS STATEMENT IS DONE.F1A19010
       TRA     PASS1               * EXIT TO PASS1.                     F1A19020
       REM  END OF PROGRAM C1400.                                       F1A19030
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A19040
       REM                                                              F1A19050
       REM C1500/ CALLS=C0190,TEST..,C0160,C0180,TET00.                 F1A19060
       REM C1500 PROCESSES EQUIVALENCE STATEMENTS.                      F1A19070
C1500  TSX C0190,4                 * OBTAIN NEXT NBCHAR IN ACC.         F1A19080
       TSX TESTE0,4                * CHARACTER SHOULD BE A LPAREN.      F1A19090
C1501  CLA L(1)                      INITIALIZE 1C                      F1A19100
       STO 1C+1                      TO 1.                              F1A19110
       TSX C0190,4                 * OBTAIN NEXT NBCHAR IN ACC AND      F1A19120
       TSX C0160,2                 * OBTAIN IN 1G THE SYMBOL V.         F1A19130
       LDQ 1G                        MOVE V                             F1A19140
       STQ 1C                        INTO 1C.                           F1A19150
       CAS OPEN                      EXAMINE CHARACTER LEFT IN THE AC,  F1A19160
       TXI     C1503,,0              AND IF                             F1A19170
       TXI     C1502,,0              CHARACTER IS A LEFT PARENTHESIS,   F1A19180
       TXI     C1503,,0              THEN                               F1A19190
C1502  TSX C0180X,2                * FORM IN 1G THE BINARY OF N.        F1A19200
       TSX TESTF0,4                * 1ST NON-NUMERIC SHOULD BE A RPAREN.F1A19210
       CLA 1G                        PUT BIN EQUIV OF N                 F1A19220
       STO 1C+1                      IN 1C+1.                           F1A19230
       TSX C0190,4                 * OBTAIN NEXT NBCHAR IN AC, AND      F1A19240
C1503  TSX TESTB0,4                * TEST FOR COMMA OR RPAREN.          F1A19250
       TZE C1504                     IF COMMA, THEN                     F1A19260
       TSX TET00,1                 * GO TO PROGRAM TET TO ENTER SYMBOL  F1A19270
       PZE 8                         AND N IN EQUIT (TABLE 8), AND      F1A19280
       TXI     C1501,,0              RETURN TO CONTINUE PROCESSING X.   F1A19290
C1504  CLS 1C+1                      MAKE SIGN OF N MINUS SINCE         F1A19300
       STO 1C+1                      THIS IS LAST ITEM.                 F1A19310
       TSX TET00,1                 * GO TO PROGRAM TET TO ENTER SYMBOL  F1A19320
       PZE 8                         AND N IN EQUIT (TABLE 8), AND      F1A19330
       TSX C0190,4                 * OBTAIN NEXT NBCHAR IN ACC, AND     F1A19340
       TSX TESTA0,4                * TEST FOR COMMA OR ENDMARK.         F1A19350
       TNZ C1500                     IF ENDMARK, THEN                   F1A19360
       TRA     PASS1               * EXIT TO PASS1.                     F1A19370
       REM  END OF PROGRAM C1500.                                       F1A19380
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A19390
       REM                                                              F1A19400
       REM C3000/ CALLS=DIAG,C0190,C0160,TEST..,SUBX00,TET00,TESTFX.    F1A19410
       REM C3000 PROCESSES SUBROUTINE AND FUNCTION STATEMENTS.          F1A19420
C3500  CAL TXHOP                     SET OP-SWITCH                      F1A19430
       STP C3003                     TO NOP CASE.                       F1A19440
       REM                                                              F1A19450
C3000  LXD EIFNO,4                   EXAMINE INTERNAL FORMULA NO., AND  F1A19460
       TXL     P1PCH,4,1      IF NOT THE 1ST STATEMENT, THEN           $F1A19470
ER0038 TSX DIAG,4                  * ERROR - GO TO THE DIAGNOSTIC.      F1A19480
       SXD     CITCNT,4       DELETE (FPT) INSTRUCTIONS FROM CITS      $F1A19490
       SXD CLSBCN,0                  SET CLOSUB P TO ZERO.              F1A19500
       TSX C0190,4                 * IF 1ST CHARACTER OF NAME IS        F1A19510
       TSX C0160,2                 * ASSEMBLE NAME IN 1G.               F1A19520
       TSX TESTC0,4                * NEXT CHAR SHD BE LPAREN OR ENDMARK.F1A19530
C3003  TXL     *+3,,0                OP SWITCH (TXL/TXH).               F1A19540
       CLA 1G                        IF FUNCTION STATEMENT,             F1A19550
       STO FSNAME                    THEN SAVE NAME IN FSNAME.          F1A19560
       TSX TET00,1                 * GO ENTER NAME                      F1A19570
       PZE 11                        IN SUBDEF TABLE.                   F1A19580
       LXD EIFNO,4                   PLACE                              F1A19590
       PXD ,4                        INTERNAL FORMULA NUMBER            F1A19600
       STO G                         IN G.                              F1A19610
       TXI     C3002,,0              TEST FOR END OF STATEMENT.         F1A19620
C3001  ADD ENDMK                     IF NOT ENDMARK, RESTORE CHARACTER  F1A19630
       STO FIRSTC                    1ST CHARACTER OF ARGUMENT.         F1A19640
       TSX C0160,2                 * ASSEMBLE ARGUMENT IN 1G.           F1A19650
       TSX TESTB0,4                * NEXT CHAR SHD BE COMMA OR RPAREN.  F1A19660
       CLA 1G                        MOVE ARGUMENT                      F1A19670
       STO G+1                       INTO G+1.                          F1A19680
       TSX TESTFX,1                * GO TEST FOR FIXED OR FLOATING PT.  F1A19690
       TXI     C3004,,0              IF FLOATING PT., SKIP FORVAL ENTRY.F1A19700
       TSX TET00,1                 * IF FIXED POINT, GO MAKE ENTRY      F1A19710
       PZE 6                         IN FORVAL TABLE.                   F1A19720
C3004  TSX TET00,1                 * IN BOTH CASES, MAKE ENTRIES IN     F1A19730
       PZE 11                        SUBDEF TABLE.                      F1A19740
       CLA ARGCNT                    UPDATE                             F1A19750
       ADD 2E18                      ARGUMENT COUNT                     F1A19760
       STO ARGCNT                    BY 1.  AND                         F1A19770
C3002  TSX C0190,4                 * EXAMINE NEXT NON-BLANK CHARACTER.  F1A19780
       SUB ENDMK                     IF NOT ENDMARK, THEN               F1A19790
       TNZ C3001                     GO PROCESS NEXT ARGUMENT.          F1A19800
       TRA     PASS1               * EXIT TO PASS1.                     F1A19810
       REM  END OF PROGRAM C3000.                                       F1A19820
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A19830
       REM                                                              F1A19840
       REM C3100/ CALLS=C0190,DIAG,TEST..,C0160,TET00,TESTFX+1.         F1A19850
       REM C3100 PROCESSES COMMON STATEMENTS.                           F1A19860
C3100  TSX     C0190,4             * GET FIRST NON-BLANK CHAR OF SYMBOL F1A19870
       TSX     C0160,2             * ASSEMBLE SYMBOL IN 1G, AND TEST    F1A19880
       STO     CHSAVE        SAVE PUNCTUATION FOR LATER TEST.           F1A19890
       TSX     TET00,1             * GO ENTER THIS SYMBOL               F1A19900
       PZE     12                    IN COMMON TABLE.                   F1A19910
       CLA     2E18                  SET AN IFN OF 1 INCASE THIS IS A   F1A19920
       STO     G                     FIXED POINT VARIABLE, IN WHICH     F1A19930
       CAL     1G                    CASE COMMON IS A FORVAL DEFINITION.F1A19940
       SLW     G+1                                                      F1A19950
       ARS     30                    ENTER ANY                          F1A19960
       TSX     TESTFX+1,1          * FIXED POINT                        F1A19970
       TRA     C3101                 VARIABLES                          F1A19980
       TSX     TET00,1             * IN                                 F1A19990
       PZE     6                     FORVAL TABLE.                      F1A20000
C3101  CLA     CHSAVE        GET PUNCTUATION CHARACTER.                 F1A20010
C3102  TSX     TESTA0,4            * NEXT CHARACTER FOR COMMA OR ENDMK. F1A20020
       TNZ     C3100         NOT LAST SPECIFICATION, CONTINUE.          F1A20030
       TRA     PASS1         FINISHED, RETURN TO CLASSIFICATION.        F1A20040
       REM  END OF PROGRAM C3100.                                       F1A20050
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A20060
       REM                                                              F1A20070
       REM C3400/ CALLS=C0190,TET00,TEST..,DIAG.                        F1A20080
       REM C3400 PROCESSES END STATEMENTS.                              F1A20090
C3400  TSX     C0190,4             * FIRST CHARACTER SHOULD BE          F1A20100
       TSX     TESTC0,4            * LEFT PARENTHESIS OR ENDMK.         F1A20110
       TZE     C3402               * EXIT IF ENDMK, OTHERWISE           F1A20120
C3401  TSX     C0190,4             * NEXT CHARACTER SHOULD BE           F1A20130
       CAS     L(2)                  0,1,2 --OTHERWISE,                 F1A20140
ER0040 TSX     DIAG,4              * CALL DIAGNOSTIC.                   F1A20150
       NOP                           MAKE                               F1A20160
       STO     G                     ENTRY                              F1A20170
       TSX     TET00,1             * IN TAPE TABLE                      F1A20180
       PZE     19                    ENDI.                              F1A20190
       TSX     C0190,4             * NEXT CHARACTER SHOULD BE           F1A20200
       TSX     TESTB0,4            * COMMA OR RIGHT PARENTHESIS.        F1A20210
       TNZ     C3401                 WHEN RIGHT PARENTHESIS IS MET,     F1A20220
       TSX     C0190,4             * NEXT CHARACTER SHOULD BE           F1A20230
       TSX     TESTD0,4            * ENDMK.                             F1A20240
C3402  AXT     9,1            INITIALIZE CHARACTER SKIP COUNTER.        F1A20250
       TSX     C0190X,4       RESET SCAN TO FIRST WORD OF STATEMENT.    F1A20260
       TSX     C0190,4        SKIP UP TO THIRD PARAMETER.               F1A20270
       TIX     *-1,1,1                                                  F1A20280
       SLW     ONLINE         SAVE IN ON-LINE FLAG CELL.                F1A20290
       SUB     L(2)           IS THE SETTING A TWO.                     F1A20300
       TMI     *+2          *NO, LEAVE IT THE WAY IT IS                $F1A20310
       STZ     ONLINE         NO ON-LINE PRINT REQUESTED.               F1A20330
       LXD     LDFT2,4        LOAD EOF FLAG FOR INPUT TAPE.             F1A20340
       TXL     PASS1,4,0      HAS AN END-OF-FILE BEEN SENSED.           F1A20350
ER1008 TSX     DIAG,4         NO, END CARD OUT OF SEQUENCE.             F1A20360
       REM  END OF PROGRAM C3400.                                       F1A20370
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A20380
       REM                                                              F1A20390
       REM FOR/ CALLS=TET00,C0190,TEST..,C0180,DIAG.                    F1A20400
       REM FOR PROCESSES FORMAT STATEMENTS.                             F1A20410
 FOR   NZT     EFN           TEST FOR STATEMENT NUMBER                  F1A20420
ER1009 TSX     DIAG,4        NONE, ERROR                                F1A20430
       TRA     FORCHK+2       BRANCH TO PATCH.                         $F1A20431
       LXD     FWA,2          LOAD CURRENT F-REGION INDEX.              F1A20432
       LDI     RESIDU         SAVE RESIDU.                              F1A20433
       TSX     C0190,4        GET NEXT CHARACTER.                       F1A20434
       TSX     TESTE0,4       TEST FOR OPEN PAREN.                      F1A20435
       STI     RESIDU         RESTORE RESIDU.                           F1A20436
       STZ     1G                                                       F1A20440
       LXD     BFCNT,4       PICK UP BUFFER COUNT                       F1A20450
       CAL     SET           FIRST ENTRY IS 8) EIFNO.                   F1A20460
       ORA     EIFNO                                                    F1A20470
       SLW     TABORG,4                                                 F1A20480
       STL     FRXT                                                     F1A20490
       TNX     FRWR,4,1      UPDATE COUNT, TEST FOR FULL BUFFER.        F1A20500
       STZ     EFLAG          INITIALIZE CLOSING PAREN FLAG.            F1A20520
       ZAC                                                              F1A20530
       TNX     FORMV,1,1                                                F1A20540
       LDQ     RESIDU        FILL REMAINDER OF FIRST WORD               F1A20550
       CAL BLANKS            IN RESIDU WITH BLANKS                      F1A20560
       LGL     6                                                        F1A20570
       TIX     *-1,1,1                                                  F1A20580
       XCL                   PUT FIRST WORD IN MQ                       F1A20590
       ZAC                                                              F1A20600
       TXI     *+1,2,1       BACK UP SCAN FOR THIS WORD.                F1A20610
BFCNT  TXI     *+2,0,BFSZ                                               F1A20620
 FORMV LDQ     **,2                                                     F1A20630
       SXA     FORT2,2                                                  F1A20640
       AXT     6,2           INIT FOR SIX CHARACTERS                    F1A20650
       REM     EACH CHARACTER PRODUCES A TRANSFER CODE IN IR(1) FOR     F1A20660
       REM     THE APPROPRIATE ACTION ON LEGAL, ILLEGAL, NUMERIC OR     F1A20670
       REM     POSSIBLE HOLLERITH CHARACTERS.  SCAN ENDS ON ENDMARK.    F1A20680
FORCHK CAQ     FTBL,1,1                                                 F1A20690
       TRA     TBLKP,1        BRANCH TO PATCH.                         $F1A20700
       STL     FORSW          INITIALIZE FORSW TO 'ON' FOR COMMA PATCH.$F1A20701
       LXA     XCHCTR,1       LOAD CHARACTER COUNT FOR RESIDU.         $F1A20710
       TRA     FOR+3          RETURN TO NON-PATCHED PORTION.           $F1A20720
ER1002 BSS     0                                                        F1A20730
FORERR TSX     DIAG,4        CHAR IS ILLEGAL IN FORMAT                  F1A20740
 FORSW PZE     **             MISSING COMMA INDICATOR                  $F1A20750
       STZ     1G            CHARACTER IS LEGAL, ERASE PREVIOUS NUM.    F1A20760
TBLK   TIX     FORCHK,2,1    CHARACTER IS BLANK                         F1A20770
       STQ     TABORG,4      PUT IT AWAY                                F1A20780
       STL     FRXT                                                     F1A20790
       TNX     FRWR,4,1                                                 F1A20800
FORT2  AXT     **,2                                                     F1A20810
       TXI     FORMV,2,-1    *GET NEXT WORD FROM F-REGION.              F1A20820
       REM                                                              F1A2082A
CLSPR  PDX     ,1             LOAD PAREN COUNT.                         F1A2082B
       TXH     ER0032,1,-100 *ARE THERE TOO MANY RIGHT PARENS, YES.     F1A2082C
       TXH     SLORCM,1,0    *NO, IS THIS THE CLOSING PAREN            $F1A2082D
       ZET     EFLAG          YES. HAS PAREN COUNT GONE TO ZERO BEFORE. F1A2082E
       TRA     ER0019        *YES. ENDMARK DOES NOT FOLLOW CLOSING ).   F1A2082F
       STL     EFLAG          NO. SET CLOSING PAREN FLAG.               F1A2082G
       ZAC                    RESET PAREN COUNT.                        F1A2082H
       TRA     TBLK-1        *RETURN TO SCAN.                           F1A2082I
       REM                                                              F1A2082J
FOREND STQ     TABORG,4                                                 F1A20830
       STL     FRXT                                                     F1A20840
       TNX     FRWR,4,1                                                 F1A20850
       PDX     0,1           PAREN BALANCE KEPT IN DECR. OF AC BY CAQ.  F1A20860
       TXH     END00,1,0     *DO PARENS BALANCE, NO.                    F1A20870
       SUB     L(5)           WAS THE CLOSING RIGHT PAREN FOLLOWED      F1A20871
       TNZ     ER0019        *BY THE ENDMARK, NO.                       F1A20872
       SXD     BFCNT,4                                                  F1A20880
       TRA     PASS1                                                    F1A20890
       REM     SUBROUTINE TO CONVERT BCI TO BINARY FOR POSSIBLE         F1A20900
       REM     SPACING OVER HOLLERITH FIELDS.                           F1A20910
CVR    STQ     C(MQ)          SAVE WORD IN PROCESS.                     F1A20920
       XCL                   SAVE PAREN COUNT, MOVE CHAR. TO AC.        F1A20930
       ANA     ENDMK         ISOLATE CHARACTER, AND CONVERT             F1A20940
       SLW     2G                                                       F1A20950
       CLA     1G                                                       F1A20960
       ALS     2                                                        F1A20970
       ADD     1G                                                       F1A20980
       ALS     1                                                        F1A20990
       ADD     2G                                                       F1A21000
       STO     1G                                                       F1A21010
       XCL                   RESTORE PAREN COUNT                        F1A21020
       LDQ     C(MQ)          RESTORE WORD IN PROCESS.                  F1A21030
       TRA     TBLK                                                     F1A21040
       REM     SUBROUTINE TO SPACE OVER N HOLLERITH CHARACTERS.         F1A21050
 HF    LXA     1G,1                                                     F1A21060
       STZ     1G             RESET HOLLERITH CHARACTER COUNT.          F1A21061
       TXL     FORERR,1,0    N MUST NOT BE ZERO                         F1A21070
       TNX     *+4,2,1       SKIP REMAINING CHARACTERS                  F1A21080
       RQL     6             THIS WORD.                                 F1A21090
       TIX     *-2,1,1       COUNT DOWN N                               F1A21100
       TRA     TBLK                                                     F1A21110
       STQ     TABORG,4                                                 F1A21120
       STL     FRXT                                                     F1A21130
       TNX     FRWR,4,1                                                 F1A21140
       XEC     FORT2         GET ANOTHER WORD.                          F1A21150
       TIX     *+1,2,1                                                  F1A21160
       XEC     FORMV                                                    F1A21170
       TNX     *+6,1,6       IS IT ALL IN A HOLLERITH FIELD.            F1A21180
       STQ     TABORG,4      YES, PUT IT ALL AYAY.                      F1A21190
       STL     FRXT                                                     F1A21200
       TNX     FRWR,4,1                                                 F1A21210
       TIX     *-5,2,1                                                  F1A21220
       TRA     FORERR        HOLLERITH GOES BEYOND STATEMENT            F1A21230
       SXA     FORT2,2                                                  F1A21240
       AXT     6,2           NO , SPACE OVER THE REST OF THE CHARS.     F1A21250
       RQL     6                                                        F1A21260
       TNX     TBLK+1,2,1                                               F1A21270
       TIX     *-2,1,1                                                  F1A21280
       TRA     FORCHK        CHECK OUT REST OF WORD.                    F1A21290
       REM     SUBROUTINE TO DUMP TEMPORARY FORMAT BUFFER ONTO TAPE.    F1A21300
FRWR   ZET     DGFLAG         HAS THERE BEEN AN ERROR.                  F1A21310
       TRA     FRWRA         *YES, RETURN TO CALLER.                    F1A21311
       LXD     INTETK+1,4     NO. LOAD COUNT OF WORDS ON TAPE.          F1A21312
       TXI     *+1,4,BFSZ     UPDATE WORD COUNT AND SAVE.               F1A21320
       SXD     INTETK+1,4    COUNT OF WORDS ON TAPE.                    F1A21330
       LXD     FLBL,4                                                   F1A21340
       TXI     *+1,4,1                                                  F1A21350
       SXD     FLBL,4        COUNT OF HOW MANY DUMPS.                   F1A21360
       TSX     (TAPE),4                                                 F1A21370
       PZE     FORIO,,(WBNC)                                            F1A21380
       PZE     INTETK+2,,FRMTTP                                         F1A21390
       STL     TETFLG         SET BUFFER DUMP FLAG.                     F1A21400
FRWRA  LXA     FRXT,4         LOAD LOCATION OF TNX CALLER.              F1A21410
       TXI     *+1,4,1        INCREMENT AND SET RETURN ADDRESS.         F1A21420
       SXA     FRXT,4                                                   F1A21421
       AXT     BFSZ,4                                                   F1A21430
 FRXT  TRA     **                                                       F1A21440
FLBL   PZE     10,,**        ** TAPE BLOCK NUMBER                       F1A21450
FORIO  IOCP    FLBL,,1                                                  F1A21460
       IOCT    TABORG-BFSZ,,BFSZ                                       $F1A21470
       REM                                                              F1A21471
EFLAG  PZE     **                    INDICATOR FOR CLOSING PAREN.       F1A21472
       REM                                                              F1A21480
  FTBL OCT     4,4,4,4,4,4,4,4,4,4,3,3,3,3,3,3,3,11,3,3,3,11,11,3,2,11 $F1A21481
       OCT     3,1,077777000006,3,3,3,1,3,3,3,3,3,11,1,3,3,3,3,3,3,3,3 $F1A21490
       OCT     0,10,3,3,3,3,3,7,3,3,3,10,000001000001,3,3,5            $F1A21500
       REM                                                              F1A21510
       REM  END OF PROGRAM FOR.                                         F1A21520
       REM                                                              F1A21530
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1A21540
       REM                                                              F1A21550
       REM  END OF PROCESSORS FOR NON-EXECUTABLE STATEMENTS.            F1A21560
       REM                                                              F1A21570
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1A21580
       REM                                                              F1A21590
       REM PASS 1/3-PATCH AREA=                                         F1A21600
BEGP1P SYN     *              BEGINNING OF PASS 1 PATCH SPACE.          F1A21610
 P1PCH PXD     0,4            AND SAVE FOR CLA 2                       $F1A21611
       STO     CLAIFN                                                  $F1A21612
       STD     EIFNO                                                   $F1A21613
       LXD     CITCNT,4       DELETES (FPT) INSTRUCTIONS               $F1A21614
       TXI     ER0038+1,4,12  BUT LEAVES IN SAVING OF LOCATION 2       $F1A21615
       TRA     AEFIO          CHAR IS A, E, F, I, OR O.                $F1A21616
       TRA     SLORCM         CHAR IS , OR /.         .                $F1A21617
       TRA     ITISX          CHAR IS X.                               $F1A21618
       TRA     CLSPR         CHAR IS ).                                $F1A21619
       TRA     FOREND         CHAR IS ENDMARK.                         $F1A2161A
       TRA     CVR            CHAR IS NUMERIC.                         $F1A2161B
       TRA     FORERR         CHAR IS ILLEGAL IN FORMAT.               $F1A2161C
       TRA     HFPCH          CHAR IS H.                               $F1A2161D
       STZ     1G             CHAR IS LEGAL, ERASE PREVIOUS NUMBER.    $F1A2161E
 TBLKP TRA     TBLK           CHAR IS BLANK.                           $F1A2161F
SLORCM STL     FORSW          TURN ON FORSW.                           $F1A2161G
       TRA     TBLK-1                                                  $F1A2161H
 AEFIO NZT     FORSW         IS FORSW ON.                              $F1A2161I
       TRA     FORERR         NO --MISSING COMMA.                      $F1A2161J
       STZ     FORSW          YES--TURN IT OFF                         $F1A2161K
       TRA     TBLK-1                                                  $F1A2161L
 ITISX NZT     FORSW          IS FORSW ON.                             $F1A2161M
       TRA     FORERR         NO--MISSING COMMA.                       $F1A2161N
       TRA     TBLK-1         YES.  LEAVE IT ON                        $F1A2161O
 HFPCH NZT     FORSW          IS FORSW ON.                             $F1A2161P
       TRA     FORERR         NO --MISSING COMMA.                      $F1A2161Q
       TRA     HF             YES--LEAVE IT ON AND GO TO H PROG.       $F1A2161R
P1PCH3 SYN     *              NEXT PATCH BEGINS HERE.                  $F1A2161S
SCAN00 STZ     CHSV3          CLEAR CHARACTER CODE CELL                $F1A21620
       STZ     1G             CLEAR CONVERSION CELL                    $F1A21630
       STZ     BUGSW1         INITIALIZE SWITCHES                      $F1A21640
       STZ     BUGSW2                                                  $F1A21650
       TRA     SCAN0+1                                                 $F1A21651
 CHSV1 TXL     CHSV2,1,0      STORE CHARACTER CODE UNLESS CHARACTER IS $F1A21652
       TXH     CHSV2,1,17     OPERATOR OR BLANK                        $F1A21653
       TXH     CHSV2-1,1,4                                             $F1A21654
       TXH     CHSV2,1,2                                               $F1A21655
       SXA     CHSV3,1        STORE CHARACTER CODE                     $F1A21656
 CHSV2 TRA     SCAN3,1                                                 $F1A21657
 CHSV3 PZE     **             CHARACTER CODE CELL                      $F1A21658
PMS01  SXA     PMS02+1,2      SAVE XR2                                 $F1A21660
       LXA     CHSV3,2        LOAD PREVIOUS CHARACTER CODE             $F1A21670
       TXH     DBLER,2,18     DOUBLE OPERATOR ERROR                    $F1A21680
       TXH     DBLR,2,17      DOUBLE OPERATOR ERROR IF NO **           $F1A21690
       TXH     PMS02,2,8                                               $F1A21700
       TXL     PMS02,2,2                                               $F1A21710
       TXL     DBLER,2,4      DOUBLE OPERATOR ERROR                    $F1A21720
       TXL     PMS02,1,3                                               $F1A21730
       TXH     BINER,2,7      ERROR-BINARY OPERATOR                    $F1A21740
       TXL     BINER,2,6      USED AS UNARY                            $F1A21750
 PMS02 SXA     CHSV3,1        STORE CHARACTER CODE                     $F1A21760
       AXT     **,2                                                    $F1A21770
       TXH     PMS00,1,17     TRANSFER TO PMS00 IF                     $F1A21780
       TXL     PMS00,1,3      OPERATOR IS +,-,*                        $F1A21790
       TRA     SLSH0          OPERATOR IS /                            $F1A21800
  DBLR TXL     DBLER,1,4      DOUBLE OPERATOR ERROR *-,*+,*1           $F1A21810
       TXI     *+1,1,1        OPERATOR IS **,                          $F1A21820
       SXA     CHSV3,1        CHARACTER CODE IS 19                     $F1A21830
       TXI     PMS02+1,1,-1                                            $F1A21840
 DBLER STL     BUGSW1         DBL OPERATOR ERROR ONLY IF ARITHMETIC    $F1A21842
       TRA     PMS02          STATEMENT                                $F1A21843
 BINER STL     BUGSW2         BINARY OP ERROR ONLY IF ARITHMETIC       $F1A21850
       TRA     PMS02          STATEMENT                                $F1A21860
 BGPCH ZET     BUGSW1         WAS THERE A DOUBLE OP ERROR              $F1A21870
ER0080 TSX     DIAG,4         YES                                      $F1A21880
       ZET     BUGSW2         NO,WAS THERE BINARY OP ERROR             $F1A21890
ER0081 TSX     DIAG,4         YES                                      $F1A21895
       TRA     WTXQ1          NO                                       $F1A21900
BUGSW1 PZE     **             DOUBLE OP SWITCH                         $F1A21910
BUGSW2 PZE     **             BINARY OP ERROR SWITCH                   $F1A21914
       REM                    ADDITIONAL PATCH SPACE                   $F1A21915
       DUP     1,102                                                   $F1A21916
       PZE                                                             $F1A21917
       BSS     29             REMAINDER OF PASS 1 PATCH SPACE.         $F1A99000
ENDP1P SYN     *                                                       $F1A99010
       REM                                                             $F1A99020
       REM ************************************************************$F1A99030
       REM                                                             $F1A99040
       REM     FT-REGION DEFINITION -TEMPORARY F-REGION.               $F1A99050
       REM                                                             $F1A99060
       IORT    FTBUF,,FTBFSZ            FT BUFFER 1 I/O COMMAND.       $F1A99070
 FTREG PZE     **,2                     ADDRESS OF CURRENT FT-BUFFER.  $F1A99080
       IORT    FTBUF+FTBFSZ,,FTBFSZ     FT BUFFER 2 I/O COMMAND.       $F1A99090
       REM                                                             $F1A99100
BEGFTR SYN     *              ORIGIN OF FT-REGION.                     $F1A99110
       REM                                                             $F1A99120
 FTBUF BSS     FTBFSZ         BUFFER 1.                                $F1A99130
       BSS     FTBFSZ         BUFFER 2.                                $F1A99140
       REM                                                             $F1A99150
ENDFTR SYN     *              END OF FT-REGION.                        $F1A99160
       REM                                                             $F1A99170
       REM ************************************************************$F1A99180
       REM                                                             $F1A99190
ENDF10 BSS 0                                                           $F1A99200
 ENDP1 BSS     0                                                       $F1A99210
       REM                           RECORD LIMIT FOR PASS ONE.        $F1A99220
       TCD     -1                                                      $F1A99225
       TTL * SECTION ONE PASS TWO * RECORD 9F14 *                       F1B00000
       LBL     9F14,THE WORKS                                           F1B00010
       REM                                                              F1B00030
       ORG     SYSCUR                                                  $F1B00040
       BCI     1,9F1400                                                $F1B00050
       ORG     (LODR)                                                  $F1B00060
       TXI     PASS2I,,140             ENTRY POINT,,RECORD NUMBER       F1B00070
       REM                                                              F1B00080
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B00090
       REM                                                              F1B00100
       REM SECTION 1 / PASS2 =                                          F1B00110
       ABS                                                              F1B00120
ORGP2  ORG  ORGP1                                                       F1B00130
       REM                                                              F1B00140
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B00150
       REM                                                              F1B00160
       REM PASS 2/1-COMMON=                                             F1B00170
P2CON  BSS 0                                                            F1B00180
L(S)   BCD 100000S                   S                                  F1B00190
L(T)   BCD 100000T                   T                                  F1B00200
L(X)   BCD 100000X                   X                                  F1B00210
L(Z)   BCD 100000Z                   Z                                  F1B00220
BIT29  OCT 100                                                          F1B00230
L(96)  OCT 140                       USED BY C0500.                     F1B00240
L(112) OCT 160                       USED BY C0400.                     F1B00250
L(A()  BCD 10000A(                   INTERNAL FLO-PT VARIABLE PREFIX.   F1B00260
L(H()  BCD 10000H(                                                      F1B00270
L(I()  BCD 10000I(                   INTERNAL FXD-PT VARIABLE PREFIX.   F1B00280
2E17   OCT 400000                    TAG=4                              F1B00290
ABTAG2 OCT 1000002                   CONSTANT USED BY C3200.            F1B00300
ABTAG1 PZE 4,0,1             ADD OF 1, TAG OF 4.                        F1B00310
M1BAR  MZE 0,0,-1            MASK                                       F1B00320
2E19   PZE 0,0,2                                                        F1B00330
 D2    PZE ,,2                       CONSTANT USED BY IOT.              F1B00340
2AND2  PZE 2,0,2                                                        F1B00350
DEC3   PZE     ,,3                                                      F1B00360
2E20   PZE     ,,4                                                      F1B00370
DECMI4 MZE 0,0,4                                                        F1B00380
DEC5   PZE     ,,5                                                      F1B00390
ABTAG3 OCT 2000004                   CONSTANT USED BY C3200.            F1B00400
BETAD2 OCT 3077775                   3*2**18+(-3)       -ARITHMETIC.    F1B00410
 D4A4  PZE  4,,4                                                        F1B00420
FSIND  PZE ,,16                                                         F1B00430
DEC17  PZE ,,17                                                         F1B00440
DEC18  PZE ,,18                                                         F1B00450
MASK5  OCT 37777600                                     -ARITHMETIC.    F1B00460
FNIND  PZE ,,32                                                         F1B00470
DEC35  PZE ,,35                                                         F1B00480
NGTBIT OCT 000200000000                                                 F1B00490
E(     BCD 1100000                                      -ARITHMETIC.    F1B00500
I(     BCD 1200000                                      -ARITHMETIC.    F1B00510
A(     BCD 1300000                                      -ARITHMETIC.    F1B00520
P(     BCD 1400000                                      -ARITHMETIC.    F1B00530
O(     BCD 1600000                                      -ARITHMETIC.    F1B00540
X(     BCD 1700000                                      -ARITHMETIC.    F1B00550
BETAD1 OCT 77775077775               (-3(*2**18+(-3)    -ARITHMETIC.    F1B00560
PROCTR DEC 15B5                      CONSTANT USED BY IOT, ARITH.       F1B00570
ADPLUS OCT 200000000000              ADDITION SIGN -ARITHMETIC.         F1B00580
FLOVAR BCD 1A(0000                   A( INTERNAL FLOATING PT. VARIABLE. F1B00590
FXFX   BCD 1EXP(1                                                       F1B00600
FLFX   BCD 1EXP(2                                                       F1B00610
FLFL   BCD 1EXP(3                                                       F1B00620
FIXVAR BCD 1I(0000                   I( INTERNAL FIXED PT. VARIABLE.    F1B00630
MINUS0 MZE 0                                                            F1B00640
DECMI1 MZE ,,1                                                          F1B00650
 M1T   MZE 8,,1                                                         F1B00660
DECMI2 MZE ,,2                                                          F1B00670
MI205  MZE ,,205                                                        F1B00680
ADSPOP OCT 530000000000              $00000                             F1B00690
DOLSGN BCI     1,$                   CONSTANT USED BY C32000            F1B00700
ADSTAR OCT -140000000000             MULTIPLICATION SIGN -ARITHMETIC.   F1B00710
STRSTR OCT -145400000000             EXPONENTIATION SIGN -ARITHMETIC.   F1B00720
FAKEN3 OCT 017777777776      CONSTANT FOR DO STATEMENTS WITHOUT N3.     F1B00730
MASK1  OCT -377777700000             -(2**20-U.*2**15   -ARITHMETIC.    F1B00740
MASK4  OCT -377777777737                                -ARITHMETIC.    F1B00750
       REM                                                              F1B00760
L(ADD) BCD 1ADD000                   SYMBOLIC OPERATION CODE.           F1B00770
L(ALS) BCD 1ALS000                   SYMBOLIC OPERATION CODE.           F1B00780
L(ANA) BCD 1ANA000                   SYMBOLIC OPERATION CODE.           F1B00790
L(ARS) BCD 1ARS000                                                      F1B00800
L(BSS) BCD 1BSS000                   SYMBOLIC OPERATION CODE.           F1B00810
L(CAL) BCD 1CAL000                                                      F1B00820
L(CHS) BCD 1CHS000                   SYMBOLIC OPERATION CODE.           F1B00830
L(CLA) BCD 1CLA000                   SYMBOLIC OPERATION CODE.           F1B00840
L(CLM) BCD 1CLM000                   SYMBOLIC OPERATION CODE.           F1B00850
L(CLS) BCD 1CLS000                   SYMBOLIC OPERATION CODE.           F1B00860
L(COM) BCD 1COM000                                                      F1B00870
L(CPY) BCD 1CPY000                                                      F1B00880
L(DCT) BCD 1DCT000                   SYMBOLIC OPERATION CODE.           F1B00890
L(DED) BCD 1DED000                                                      F1B00900
L(DVP) BCD 1DVP000                   SYMBOLIC OPERATION CODE.           F1B00910
L(FAD) BCD 1FAD000                   SYMBOLIC OPERATION CODE.           F1B00920
L(FDP) BCD 1FDP000                   SYMBOLIC OPERATION CODE.           F1B00930
L(FMP) BCD 1FMP000                   SYMBOLIC OPERATION CODE.           F1B00940
L(FSB) BCD 1FSB000                   SYMBOLIC OPERATION CODE.           F1B00950
L(HPR) BCD 1HPR000                   SYMBOLIC OPERATION CODE.           F1B00960
L(LDA) BCD 1LDA000                                                      F1B00970
L(LDQ) BCD 1LDQ000                   SYMBOLIC OPERATION CODE.           F1B00980
L(LLS) BCD 1LLS000                   SYMBOLIC OPERATION CODE.           F1B00990
L(LRS) BCD 1LRS000                   SYMBOLIC OPERATION CODE.           F1B01000
L(LXD) BCD 1LXD000                   SYMBOLIC OPERATION CODE.           F1B01010
L(MPY) BCD 1MPY000                   SYMBOLIC OPERATION CODE.           F1B01020
L(MSE) BCD 1MSE000                   SYMBOLIC OPERATION CODE.           F1B01030
L(ORA) BCD 1ORA000                   SYMBOLIC OPERATION CODE.           F1B01040
L(PSE) BCD 1PSE000                   SYMBOLIC OPERATION CODE.           F1B01050
L(PXA) BCD 1PXA000                                                      F1B01060
L(PXD) BCD 1PXD000                                                      F1B01070
L(PZE) BCD 1PZE000                                                      F1B01080
L(QPR) BCD 1QPR000                   CONSTANT USED BY C3200.            F1B01090
L(QXD) BCD 1QXD000                   CONSTANT USED BY C3200.            F1B01100
L(SLW) BCD 1SLW000                                                      F1B01110
L(STA) BCD 1STA000                   SYMBOLIC OPERATION CODE.           F1B01120
L(STO) BCD 1STO000                   SYMBOLIC OPERATION CODE.           F1B01130
L(STQ) BCD 1STQ000                   SYMBOLIC OPERATION CODE.           F1B01140
L(STR) BCD 1STR000                                                      F1B01150
L(STZ) BCD 1STZ000                                                      F1B01160
L(SUB) BCD 1SUB000                   SYMBOLIC OPERATION CODE.           F1B01170
L(SXD) BCD 1SXD000                   SYMBOLIC OPERATION CODE.           F1B01180
L(SXQ) BCD 1SXQ000                                                      F1B01190
L(TIX) BCD 1TIX001                                                      F1B01200
L(TNZ) BCD 1TNZ000                                                      F1B01210
L(TRA) BCD 1TRA000                   SYMBOLIC OPERATION CODE.           F1B01220
L(TSX) BCD 1TSX000                   SYMBOLIC OPERATION CODE.           F1B01230
L(UFA) BCD 1UFA000                   SYMBOLIC OPERATION CODE.           F1B01240
L(XCA) BCD 1XCA000                                                      F1B01250
P2VAR  BSS 0                                                            F1B01260
HOLCNT BCD 1H(0000                   WORKING STORAGE USED BY C3300.     F1B01270
 RAT   PZE 8,,**                     VARIABLE USED BY IOT.              F1B01280
 TL    PZE 31*8,,**                                                     F1B01290
ENT    BCD 1NTR000                   P2VAR USED BY FLTR00.              F1B01300
NZE    BCD 1PZE000                   P2VAR USED BY FLTR00.              F1B01310
       EJECT                                                            F1B01320
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B01330
       REM                                                              F1B01340
       REM READS A CONDENSED EXECUTABLE STATEMENT FROM TAPE, ASSIGNS    F1B01350
       REM AN IFN AND MAKES AN ENTRY IN TEIFNO IF AN EFN EXISTS.        F1B01360
       REM                                                              F1B01370
PASS2I TSX     (TAPE),4       INITIALIZATION FOR PASS 2.                F1B01380
       PZE     DCF-1,,(RBNP)  LOAD F-REGION (BUFFER 1).                 F1B01390
       PZE     WTXQ5,,EXEQTP                                            F1B01400
       CAL     DLIST1-1       INITIALIZE DLIST1                         F1B01410
       STA     ACDP01         ADDRESS IN                                F1B01420
       ADD     L(1)           ADDRESS COMPLETION                        F1B01430
       STA     ACDP07         ROUTINE.                                  F1B01440
       CLA     FLCNIX-1       GET ADDRESS OF FLOCON TABLE.              F1B01450
       STA     ENFC01         INITIALIZE SEARCH ROUTINE WITH            F1B01460
       STA     ENFC05         ADDRESS OF FIRST LOCATION.                F1B01470
       CLA     FLCNIX-2       GET ADDRESS OF FLOCON TABLE PLUS ONE.     F1B01480
       STA     ENFC06         INITIALIZE ADDRESS IN SEARCH ROUTINE TO   F1B01490
       STA     ENFC07         THE NEXT CORE ADDRESS.                    F1B01500
       REM                                                              F1B01510
       REM     NORMAL RE-ENTRY TO GET THE NEXT EXECUTABLE STATEMENT.    F1B01520
       REM                                                              F1B01530
PASS2  LXA     XEQCTR,4       LOAD COUNT OF EXECUTABLE STATEMENTS.      F1B01540
       TXL     ENDTST,4,0    *HAVE ALL STATEMENTS BEEN PROCESSED, YES.  F1B01550
       TXI     *+1,4,-1       REDUCE COUNT.                             F1B01560
       SXA     XEQCTR,4       SAVE DECREMENTED COUNT.                   F1B01570
RDXQ1  AXC     1,2            FLIP BUFFER SWITCH.                       F1B01580
       TSX     (TAPE),4       READ ANOTHER STATEMENT.                   F1B01590
       PZE     DCF,2,(RBNP)                                             F1B01600
       PZE     WTXQ5,,EXEQTP                                            F1B01610
       SXA     RDXQ1,2        RESET BUFFER SWITCH.                      F1B01620
       LAC     RDXQ1,2        FLIP TO CURRENT BUFFER.                   F1B01630
       CLA     DCF,2          GET LOAD ADDRESS OF I/O COMMAND.          F1B01640
       ADD     L(4)           COMPUTE ADDRESS OF STATEMENT.             F1B01650
       PAC     ,2             GET 2S COMPLEMENT OF ORIGIN OF F-REGION   F1B01660
       SXD     DCF,2          AND SAVE OTHER ROUTINES.                  F1B01670
       STA     DCF            SAVE TRUE ADDRESS.                        F1B01680
       AXT     4,2            MOVE CONTROL WORDS                        F1B01690
RDXQ2  CAL*    DCF            INTO CURRENT BUFFER.                      F1B01700
       SLW     TLABEL+4,2                                               F1B01710
       TIX     RDXQ2,2,1                                                F1B01720
       LXD     EIFNO,1        INCREMENT IFN (INTERNAL FORMULA NUMBER).  F1B01730
       TXI     *+1,1,1                                                  F1B01740
       SXD     EIFNO,1        SAVE NEW IFN.                             F1B01750
       PXD     ,1             STORE IFN IN DECREMENT FIELD OF 1C.       F1B01760
       STO     1C                                                       F1B01770
       CAL     EFN            GET EFN FOR THIS STATEMENT (IF ANY).      F1B01780
       TZE     RDXQ3         *NONE.                                     F1B01790
       STA     EIFNO          SET BINARY EQUIVALENT EFN IN EIFNO        F1B01800
       TSX     TET00,1        IN ORDER TO MAKE ENTRY IN TEIFNO.         F1B01810
       PZE     0                                                        F1B01820
RDXQ3  LXD     TLABEL,2       LOAD SCAN POSITION.                       F1B01830
       TSX     C0190X,4       RESET SCAN.                               F1B01840
       TXL     *+4,2,-3       HAS THE MARKER RECORD BEEN READ.          F1B01850
LOST1  TSX     (TAPE),4      *YES, MACHINE ERROR.                       F1B01860
       PZE     RDXQ5,,(TPER)                                            F1B01870
       PZE     RDXQ6,,EXEQTP                                            F1B01880
       TXL     *+3,2,0       *START SCAN AT FIRST CHARACTER.            F1B01890
       TSX     C0190,4        GET FIRST NON-DICTIONARY CHARACTER        F1B01900
       TIX     *-1,2,1        OF STATEMENT.                             F1B01910
       STZ     LEFT+2         RESET LEFT SIDE SYMBOL.                   F1B01920
RDXQ4  TRA*    TLABEL         GO TO PROCESSOR FOR THIS STATEMENT.       F1B01930
       REM                                                              F1B01940
RDXQ5  BCI     1,REC CT       A STATEMENT IS MISSING,                   F1B01950
RDXQ6  BCI     1,EXEQ         SKIPPED A RECORD OR SOMETHING.            F1B01960
       REM *************************************************************F1B01970
       REM                                                              F1B01980
       REM     TERMINAL ROUTINE FOR PASS 2 OF SECTION I.                F1B01990
       REM                                                              F1B02000
ENDTST TSX     (TAPE),4       CHECK LAST READ ON THE                    F1B02010
       PZE     EXEQTP,,(CHKU) EXECUTABLE STATEMENT TAPE.                F1B02020
       LXA     RDXQ1,2        LOAD THE BUFFER SWITCH.                   F1B02030
       CAL*    DCF,2          GET TLABEL WHICH SHOULD BE                F1B02040
       ERA     ALL1           ALL ONES, THE END MARK.                   F1B02050
       TNZ     LOST1         *IS THIS THE END MARK, NO.                 F1B02060
CLOSP2 AXT     0,4            SET END OF SECTION ONE FLAG.              F1B02070
       ZET     DGFLAG         HAS THERE BEEN A DIAGNOSTIC.              F1B02080
       TRA     DIAG          *YES, GET DIAGNOSTIC FOR THE LAST TIME.    F1B02090
       TSX     (TAPE),4       SKIP OVER DIAGNOSTIC ON SYSTEM TAPE.      F1B02100
       PZE     FRSP,,(SKBP)                                             F1B02110
       PZE     ,,SYSTAP                                                 F1B02120
       NZT     TETFLG         ARE ANY BUFFERS DUMPED ON TAPE.           F1B02130
       TRA     CLSP2A        *NO, LEAVE DUMP TAPE ALONE.                F1B02140
       REM                                                              F1B02150
       REM                    YES, HOWEVER, IF BUFFERS ARE SHOT-GUNNED  F1B02160
       REM                    ON TAPES, THEN THIS CLOSE OUT IS NOT      F1B02170
       TSX     (TAPE),4       SUFFICIENT.                               F1B02180
       PZE     ,,(WEFP)       WRITE END-OF-FILE.                        F1B02190
       PZE     EXEQF,,BUFTAP                                            F1B02200
       TSX     (TAPE),4       REWIND TAPE.                              F1B02210
       PZE     REWD,,(SKBP)                                             F1B02220
       PZE     ,,BUFTAP                                                 F1B02230
       REM                                                              F1B02240
CLSP2A STZ     CITA0          CLOSE OUT CIT BUFFER.                     F1B02250
       TSX     CIT00,4                                                  F1B02260
       CLA     1PL           SET TO EXIT TO ONE PRIME.                 $F1B02270
       TRA     1TOCS-1                                                 $F1B02273
   1PL BCI     1,9F1600                                                $F1B02277
       REM *************************************************************F1B02280
       REM                                                              F1B02290
       REM BSS,2/ CALLS=CIT00.                                          F1B02300
       REM BSS COMPILES= IFN BSS 0.                                     F1B02310
 BSS   TSX CIT00,4                 * GO MAKE FOLLOWING CIT ENTRY=       F1B02320
       PZE  SL,,L(BSS)               LOC,,OP-DEC                        F1B02330
       PZE  L(0),,L(0)               ADR,,RA-TAG                        F1B02340
       TRA 1,2                     * EXIT TO CALLER+1.                  F1B02350
       REM  END OF PROGRAM BSS.                                         F1B02360
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B02370
       REM                                                              F1B02380
       REM LIB,4/ USES=CIT00. CALLS=TET00.                              F1B02390
       REM LIB MAKES CLOSUB ENTRY BEFORE COMPILING CIT.                 F1B02400
 LIB   CAL* 2,4                      PICKUP SUBROUTINE                  F1B02410
       SLW  G                        NAME, AND                          F1B02420
       TSX  TET00,1                * GO ENTER IN CLOSUB TABLE.          F1B02430
       PZE  9                      * THEN GO MAKE CIT ENTRY.            F1B02440
       TRA     CIT00         GO COMPILE  TSX NAME,4                     F1B02450
       REM  END OF PROGRAM LIB.                                         F1B02460
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B02470
       REM                                                              F1B02480
       REM                                                              F1B02490
       REM FLTR00,4/ CALLS=CIT00.                                       F1B02500
       REM FLTR00 COMPILES FLOW TRACING INFORMATION.                    F1B02510
FLTR00 SXD FLTR05,4                  SAVE CALLING TAG.                  F1B02520
       CLA EIFNO                     GET LAST INTERNAL AND EXTERNAL NOS.F1B02530
       STA ENT                       LAST EFN TO DECREMENT              F1B02540
       ARS 18                        OF NTR INSTRUCTION.                F1B02550
       STA NZE                       LAST IFN TO DECREMENT              F1B02560
       LXD ARGCTR,4                  OF PZE INSTRUCTION.                F1B02570
       TXL FLTR01,4,0                IF THIS IS A FN FUNCTION,          F1B02580
       STZ 1C+2                      THEN                               F1B02590
       CLA 1BAR                      SET ADDRESS TO -1.                 F1B02600
       TRA FLTR03                    IF THIS IS                         F1B02610
FLTR01 LXD     SBDFCN,4              A MAIN PROGRAM                     F1B02620
       TXH     FLTR02,4,0     (SBDFCN = 0), THEN                        F1B02630
       STZ 1C+2                      SET ADDRESS                        F1B02640
       STZ 1C+3                      TO +0.                             F1B02650
       TRA FLTR04                    IF THIS IS A                       F1B02660
FLTR02 CLA DOLSGN                    SUB-PROGRAM, THEN                  F1B02670
       STO 1C+2                      SET ADDRESS                        F1B02680
       CLA D2                        TO $+2.                            F1B02690
FLTR03 STO 1C+3                      SET RELATIVE ADDRESS FOR CIT.      F1B02700
FLTR04 TSX CIT00,4                   GO MAKE FOLLOWING CIT ENTRY=       F1B02710
       PZE L(0),,ENT                 LOC,,OP-DEC                        F1B02720
       PZE PROCTR,,D2                ADR,,RA-TAG                        F1B02730
       TSX CIT00,4                 * GO MAKE FOLLOWING CIT ENTRY=       F1B02740
       PZE L(0),,NZE                 LOC,,OP-DEC                        F1B02750
       PZE 1C+2,,1C+3                ADR,,RA-TAG                        F1B02760
       LXD FLTR05,4                  RESTORE CALLING TAG.               F1B02770
FLTR05 TXI CIT00,0,**              * EXIT TO CIT00.                     F1B02780
       REM  END OF PROGRAM FLTR00.                                      F1B02790
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B02800
       REM                                                              F1B02810
       REM GETIFN,4/                                                    F1B02820
       REM GETIFN PLACES THE INTERNAL FORMULA NUMBER IN AC AND IN 1C.   F1B02830
GETIFN LXD EIFNO,1                   PLACE THE INTERNAL FORMULA         F1B02840
       PXD ,1                        NUMBER IN XR1, IN THE DECREMENT    F1B02850
       STO 1C                        OF THE AC, 1C, AND CW.             F1B02860
       TRA 1,4                     * RETURN TO CALLER.                  F1B02870
       REM  END OF PROGRAM GETIFN.                                      F1B02880
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B02890
       REM                                                              F1B02900
       REM JIF(GIF),4/                                                  F1B02910
       REM JIF JUMPS IFN, AND USES GIF.                                 F1B02920
JIF    CAL EIFNO                     INCREASE THE                       F1B02930
       ADD 2E18                      INTERNAL FORMULA NUMBER            F1B02940
       STD EIFNO                     BY 1.                              F1B02950
       REM GIF GETS IFN, AND SETS SL AND TL.                            F1B02960
GIF    CAL EIFNO                     PICKUP IFN,                        F1B02970
       ANA 1BAR                      CLEAR SL, AND                      F1B02980
L(SL)  SLW SL                        PLACE IFN IN THE DECREMENTS        F1B02990
L(TL)  STD TL                        OF SL AND TL.                      F1B03000
       TRA 1,4                     * EXIT TO CALLER.                    F1B03010
       REM  END OF PROGRAM JIF(GIF).                                    F1B03020
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B03030
       REM                                                              F1B03040
       REM LXD,2/ CALLS=CIT00.                                          F1B03050
       REM LXD COMPILES=     LXD 6)+4,4.                                F1B03060
 LXD   TSX  CIT00,4                * GO MAKE FOLLOWING CIT ENTRY=       F1B03070
       PZE  L(0),,L(LXD)             LOC,,OP-DEC                        F1B03080
       PZE  O(,,D4A4                 ADR,,RA-TAG                        F1B03090
       TRA  1,2                    * EXIT TO CALLER+1.                  F1B03100
       REM  END OF PROGRAM LXD.                                         F1B03110
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B03120
       REM                                                              F1B03130
       REM RA000,4/                                                     F1B03140
       REM RA000 COMPUTES RELATIVE ADDRESS.                             F1B03150
RA000  SXA RAXR4,4                   SAVE THE C(XR4) FOR RETURN.        F1B03160
       STZ EPS                       CLEAR EPSILON (WORKING STORAGE).   F1B03170
       CLA DIMSAV                    EXAMINE THE                        F1B03180
 ED2   PAX E+4,4                     DIMENSION COUNT, AND               F1B03190
       TXL ED1,4,2                   IF 3 DIMENSION,                    F1B03200
       ADD L(1)                      INCREASE IT 1.                     F1B03210
ED1    ADM ED2                       THEN SET                           F1B03220
       STA ED3                       ED3 ADDRESS TO                     F1B03230
 ED3   CLA **,4                      EXAMINE SUCCESSIVE                 F1B03240
       LDQ 2E18                      SUBSCRIPT                          F1B03250
       TZE ED4                       VARIABLES, AND                     F1B03260
       STQ EPS                       ACCORDINGLY SET                    F1B03270
       LDQ L(0)                      EPSILON AND                        F1B03280
 ED4   STQ EPS,4                     EPSILON SUB I                      F1B03290
       TIX ED3,4,1                   TO 1 OR TO 0. WHEN DONE,           F1B03300
       CLA 2E18                      IF 1 DIMENSION, PICKUP DECREMENT 1,F1B03310
       LXA DIMSAV,4                  AND GO SUBTRACT ADDEND 1.          F1B03320
       TXL 1D1,4,1                   IF 2 OR 3 DIMENSION, THEN          F1B03330
       LDQ E+11                      PICKUP ADDENDS 1 AND 2,            F1B03340
       STZ E+11                      CLEAR E+11, AND                    F1B03350
       SLQ E+11                      RESTORE ADDEND 1 TO E+11.          F1B03360
       LGL 18                        ADJUST AND PLACE                   F1B03370
       STQ N2                        ADDEND 2 IN N2.                    F1B03380
       LDQ E+6                       AND, IF 2 DIMENSION                F1B03390
       CLA EPS-1                     PICKUP EPSILON SUB 1,              F1B03400
       TXL 2D1,4,2                   AND GO SUBTRACT ADDEND 2.          F1B03410
       SUB E+12                      IF 3 DIMENSION, SET GTAG           F1B03420
       STO GTAG                      TO EPSILON SUB 1 - ADDEND 3.       F1B03430
       LDQ E+8                       PICKUP DIMENSIONS 1 AND 2,         F1B03440
       STZ E+8                       CLEAR E+8, AND                     F1B03450
       SLQ E+8                       RESTORE DIMENSION 1 TO E+8.        F1B03460
       LGL 18                        ADJUST, AND MULTIPLY               F1B03470
       MPY GTAG                      DIMENSION 2 TIMES GTAG.            F1B03480
       ALS 17                        THEN ADD                           F1B03490
       ADD EPS-2                     EPSILON SUB 2                      F1B03500
       LDQ E+8                       TO THE PRODUCT, AND                F1B03510
2D1    SUB N2                        SUBTRACT ADDEND 2.                 F1B03520
       STO GTAG                      MULTIPLY                           F1B03530
       MPY GTAG                      THE RESULT                         F1B03540
       ALS 17                        TIMES                              F1B03550
       ADD EPS,4                     DIMENSION 1, AND ADD IN EPSILON    F1B03560
       ADD EPS                       SUB I AND EPSILON.                 F1B03570
 1D1   SUB E+11                      SUBTRACT ADDEND 1,                 F1B03580
       TRA     1D1P                                                    $F1B03590
       CAL E                         IN THE DECREMENT OF GTAG,          F1B03600
       ARS 24                        WITH I-TAUTAG                      F1B03610
       STA GTAG                      IN THE ADDRESS.                    F1B03620
RAXR4  AXT ..,4                      RESTORE THE C(XR4), AND            F1B03630
       TRA 1,4                     * EXIT TO CALLER.                    F1B03640
       REM  END OF PROGRAM RA000.                                       F1B03650
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B03660
       REM                                                              F1B03670
       REM SS000,4/ CALLS=C0190,DIAG,SR6DC1,DIM.SR,TBSR00,TET00,TESTFX. F1B03680
       REM SS000 SCANS SUBSCRIPT COMBINATIONS AND MAKES TABLE ENTRIES.  F1B03690
SS000  SXD SXR2,2                    SAVE C(XR2),                       F1B03700
       SXD SXR1,1                    SAVE C(XR1),                       F1B03710
       SXD SXR4,4                    SAVE C(XR4), AND                   F1B03720
       STZ ERASE                     SET DIMCTR = 0.                    F1B03730
       LXA L(6),4                    INITIALIZE                         F1B03740
       SXD SBS2,4                    FOR EACH SUBSCRIPT MEMBER.         F1B03750
       CAL TXHOP                     PICK UP TXH OP, AND                F1B03760
       STP SBC6                      SET OP                             F1B03770
       STP SBC8                      SWITCHES.                          F1B03780
       CAL TXLOP                     PICK UP TXL OP, AND                F1B03790
       STP SBC4                      SET OP SWITCH.                     F1B03800
SS001  LXA L(6),3                    SET FOR 6 CHARACTERS OF MULTIPLIER.F1B03810
       STZ SYMBOL                    CLEAR WORKING STORAGE.             F1B03820
       TSX C0190,4                 * GET FIRST NON BLANK CHAR IN THE AC.F1B03830
       CAS L(9)                      COMPARE IT WITH 9.                 F1B03840
       TXI     SS0045,,0             RETURN TO EXPLICIT CODING.         F1B03850
       NOP                           IF NUMERIC,                        F1B03860
       STO FIRSTC                    SAVE RIGHT-ADJUSTED DIGIT, AND     F1B03870
SS0012 ALS 36,2                      LEFT-ADJUST DIGIT TO               F1B03880
       ORS SYMBOL                    BUILD SYMBOL.                      F1B03890
       TXI SS0013,2,6                UPDATE SHIFT DECREMENT, AND        F1B03900
SS0013 TXI SS0014,1,-1               UPDATE COUNT OF CHARS COLLECTED.   F1B03910
SS0014 TSX C0190,4                 * GET NEXT NB CHARACTER IN THE AC.   F1B03920
       AXT CTEST-ENDMK,4             SET XR4 = NO. OF PUNCTUATION MARKS.F1B03930
SS0015 CAS CTEST,4                   TEST THIS CHARACTER AGAINST        F1B03940
       TXI     SS0016,,0             ALL PUNCTUATION.                   F1B03950
       TRA SUBTR,4                   IF EQUALITY IS FOUND, TRANSFER.    F1B03960
SS0016 TIX SS0015,4,1                IF NOT FOUND TO BE PUNCTUATION,    F1B03970
       CAS L(9)                      TEST FOR NUMERIC.                  F1B03980
       TXI     SS0017,,0             AND IF                             F1B03990
       NOP                           FOUND TO BE NUMERIC,               F1B04000
       TXH SS0012,1,0                CONTINUE BUILDING SYMBOL. BUT IF   F1B04010
       TXI     STOP49,,0             SEVENTH CHARACTER, GO TO DIAGNOSTICF1B04020
SS0017 TSX TESTFX+1,1              * GO TEST FOR FIXED POINT VARIABLE.  F1B04030
ER0005 BSS 0                                                            F1B04040
SSERR  TSX DIAG,4                  * NOT FIXED POINT --GO TO DIAGNOSTIC.F1B04050
       LGL 30                        RESTORE FIXED POINT VARIABLE       F1B04060
       SLW RESIDU                    TO RESIDU, AND                     F1B04070
       LXA     XCHCTR,4       RESET CHARACTER COUNTER                   F1B04080
       TXI SS0018,4,1                TO BEGIN PROCESSING                F1B04090
SS0018 SXA     XCHCTR,4       SUBSCRIPT MULTIPLIER.                     F1B04100
 SBX   CLS SBC6                      TEST FOR                           F1B04110
       TMI SBX1                      PREVIOUS MULTIPLIER.               F1B04120
ER0006 BSS 0                                                            F1B04130
       TSX DIAG,4                  * DOUBLE MULTIPLIER FOR SUBSCRIPT.   F1B04140
 SBX1  STO SBC6                      RESET MULTIPLIER SWITCH.           F1B04150
       CLA FIRSTC                    TEST                               F1B04160
       SUB TEN                       MULTIPLIER                         F1B04170
       TMI SBX2                      FOR CONSTANT.                      F1B04180
ER0007 BSS 0                                                            F1B04190
       TSX DIAG,4                  * SUBS-MULTIPLIER NOT A CONSTANT.    F1B04200
SBX2   CAL SYMBOL                    ADJUST MULTIPLIER                  F1B04210
       ARS 42,2                      TO LOW ORDER POSITION.             F1B04220
       LXD SBS2,4                    GET STORING TAG,                   F1B04230
       SLW E+9,4                     AND STORE MULTIPLIER.              F1B04240
       STZ E+15,4                    SET ADDEND = 0.                    F1B04250
SS003  LXA L(6),3                    SET FOR 6 CHARS OF VARIABLE/ADDEND.F1B04260
       STZ SYMBOL                    CLEAR WORKING STORAGE.             F1B04270
SS004  TSX C0190,4                 * GO GET NEXT NB CHARACTER IN THE AC.F1B04280
SS0045 AXT CTEST-ENDMK,4             COMPARE CHARACTER                  F1B04290
SS005  CAS CTEST,4                   TO ALL                             F1B04300
       TXI     SS006,,0              PUNCTUATION.                       F1B04310
       TRA SUBTR,4                   IF EQUALITY IS FOUND, TRANSFER.    F1B04320
SS006  TIX SS005,4,1                 IF NOT FOUND TO BE PUNCTUATION,    F1B04330
       TXL SS008,1,5                 IF 1ST CHARACTER OF VARIABLE OR    F1B04340
       STO FIRSTC                    ADDEND, SAVE FOR LATER TESTS.      F1B04350
SS008  ALS 36,2                      POSITION EACH CHARACTER. BUT       F1B04360
SS009  TXL STOP49,1,0              * ON 7TH CHARACTER, GO TO STOP.      F1B04370
       ORS SYMBOL                    BUILD SYMBOL.                      F1B04380
       TXI SS007,2,6                 UPDATE EFFECTIVE ADDRESS OF SHIFT. F1B04390
SS007  TXI SS004,1,-1                UPDATE FOR ANOTHER CHAR COLLECTED. F1B04400
ER0008 BSS 0                                                            F1B04410
STOP49 TSX DIAG,4                  * GO TO DIAGNOSTIC ON 7TH CHARACTER. F1B04420
       REM SUBTR/ CONTROL TRANSFERS FOR SUBSCRIPT SCAN=                 F1B04430
       TXI     ISC,,0                EMK (ILLEGAL IN LIST SUBSCRIPT).   F1B04440
ER0009 BSS 0                                                            F1B04450
 ISC   TSX DIAG,4                  * (   (ILLEGAL IN LIST SUBSCRIPT).   F1B04460
       TXI     SBC,,0                ,                                  F1B04470
       TXI     SBR,,0                )                                  F1B04480
       TXI     ISC,,0                =  (ILLEGAL IN LIST SUBSCRIPT).    F1B04490
SBS2   TXI SBM,0,**                  - ,,SUBSCRIPT ELEMENT COUNTER.     F1B04500
       TXI     ISC,,0                /  (ILLEGAL IN LIST SUBSCRIPT).    F1B04510
SXR1   TXI ISC,0,**                  .   (ILLEGAL IN LIST SUBSCRIPT).   F1B04520
SXR2   TXI SBP,0,**                  +                                  F1B04530
SXR4   TXI SBX,0,**                  *                                  F1B04540
SUBTR  BSS 0                         INDEXING ADDRESS FOR ABOVE LIST.   F1B04550
 SBM   SSM                           MINUS ADDEND.                      F1B04560
 SBP   CLM                           PLUS ADDEND.                       F1B04570
       LXD SBS2,4                    GET STORING TAG, AND               F1B04580
       STO E+15,4                    STORE SIGN OF ADDEND.              F1B04590
       CLS SBC8                      TEST SWITCH                        F1B04600
       TMI SBP1                      FOR PREVIOUS ADDEND.               F1B04610
ER0010 BSS 0                                                            F1B04620
       TSX DIAG,4                  * DOUBLE ADDEND FOR SUBSCRIPT.       F1B04630
 SBP1  STO SBC8                      RESET ADDEND SWITCH.               F1B04640
       TSX TESTFX,1                * GO TO TEST FOR FIXED POINT.        F1B04650
       TRA SSERR                   * NOT FIXED POINT --GO TO DIAGNOSTIC.F1B04660
       LXD SBS2,4                    GET STORING TAG, AND               F1B04670
       CLS SBC6                      TEST SWITCH                        F1B04680
       TPL SBP2                      FOR PREVIOUS MULTIPLIER.           F1B04690
       CLA L(1)                      IF NONE,                           F1B04700
       STO E+9,4                     SET MULTIPLIER                     F1B04710
       TXI     SBP4,,0               TO 1, AND CONTINUE.                F1B04720
 SBC1  CLS SBC6                      RESET MULTIPLIER                   F1B04730
SBP2   STO SBC6                      OP SWITCH.                         F1B04740
SBP4   CAL SYMBOL                    IF VARIABLE SUBSCRIPT,             F1B04750
       TXH SBP41,2,36                ADD BLANKS                         F1B04760
       PXD ,0                                                           F1B04770
       LDQ BLANKS                    IF LESS                            F1B04780
       LGL 42,2                      THAN 6                             F1B04790
       ORA SYMBOL                    CHARACTERS, AND                    F1B04800
 SBP41 SLW E+10,4                    PLACE IN E-REGION.                 F1B04810
       TSX TESTFX,1                * GO TO TEST FOR FIXED POINT.        F1B04820
       TRA SSERR                   * NOT FIXED POINT --GO TO DIAGNOSTIC.F1B04830
       CLA SBC8                      IF THERE IS AN ADDEND,             F1B04840
       TMI SS003                     GO COLLECT, OTHERWISE              F1B04850
       TXI     SBC7,,0               GO UPDATE STORING TAG.             F1B04860
SBR    CLS SBC4                      SET SWITCH                         F1B04870
       STO SBC4                      FOR CLOSING PARENTHESIS.           F1B04880
SBC    CAL ERASE                     UPDATE                             F1B04890
       ADD L(1)                      DIMENSION COUNTER                  F1B04900
       STA ERASE                     BY 1.                              F1B04910
       LXD SBS2,4                    GET STORING TAG.                   F1B04920
SBC6   TXH     SBC1,,0               SWITCH - IF NO MULTIPLIER, AND     F1B04930
SBC8   TXH     SBC2,,0               SWITCH - IF NO ADDEND, THEN        F1B04940
       CLA L(1)                      SET                                F1B04950
       STO E+9,4                     MULTIPLIER = 1.                    F1B04960
       STZ E+15,4                    SET ADDEND = 0.                    F1B04970
       CLA FIRSTC                    TEST FOR                           F1B04980
       SUB TEN                       CONSTANT OR VARIABLE.              F1B04990
       TPL SBP4                      IF CONSTANT, THEN                  F1B05000
       STZ E+10,4                    SET VARIABLE = 0.                  F1B05010
SBC9   CAL SYMBOL                    ADJUST                             F1B05020
       ARS 42,2                      CONSTANT                           F1B05030
       ORS E+15,4                    TO LOW ORDER POSITION.             F1B05040
SBC7   TNX SBC3,4,2                  UPDATE STORING TAG                 F1B05050
       SXD SBS2,4                    BY -2, AND SAVE.                   F1B05060
SBC4   TXL     SS001,,0              SWITCH - REPEAT FOR NEXT SUB-COMB. F1B05070
       TXI     SA000,,0                                                 F1B05080
 SBC2  CLS SBC8                      RESET ADDEND                       F1B05090
       STO SBC8                      OP SWITCH.                         F1B05100
       CLS TEN                       TEST                               F1B05110
       ADD FIRSTC                    ADDEND                             F1B05120
       TMI SBC9                      FOR CONSTANT.                      F1B05130
ER0011 BSS 0                                                            F1B05140
       TSX DIAG,4                  * SUBSCRIPT ADDEND NOT A CONSTANT.   F1B05150
SBC3   CLS SBC4                      AFTER SCANNING 3 SUBSCRIPTS,       F1B05160
       TMI SA000                     GO MAKE TABLE ENTRIES AND GET TAG. F1B05170
ER0012 BSS 0                                                            F1B05180
       TSX DIAG,4                  * GO TO DIAG - NO ) AFTER 3RD SUBS.  F1B05190
       REM CSA000= ENTRY POINT USED BY C0200 (GO TO ROUTINE).           F1B05200
CSA000 SXD SXR4,4                    SAVE C(XR4) FOR RETURN TO C0200.   F1B05210
SA000  CLA ERASE                     SAVE                               F1B05220
       STO DIMSAV                    THE CONTENTS OF DIMCTR.            F1B05230
       ALS 33                        POSITION AND                       F1B05240
       STO E                         STORE I TAG.                       F1B05250
       CLA E+11                      MOVE SUBSCRIPT ADDENDS             F1B05260
       STO E+12                      INTO POSITION                      F1B05270
       CLA E+9                       FOR FOLLOWING                      F1B05280
       STO E+11                      PROGRAM.                           F1B05290
       CLA L(2)                      EXAMINE DIMCTR                     F1B05300
       CAS ERASE                     TO DETERMINE                       F1B05310
       TXI     1D0000,,0             WHETHER DIMENSION OF               F1B05320
       TXI     2D0000,,0             VARIABLE IS 1,2, OR 3.             F1B05330
       LXA L(6),4                    PREPARE TO PICK UP 3 COEFFICIENTS. F1B05340
3D0001 LDQ E+9,4                     CONVERT THEM FROM BCD TO BINARY    F1B05350
       TSX SR6DC1,1                * IN E+3,5,7, AND                    F1B05360
       STO E+9,4                     STORE BACK IN E+3,5,7.             F1B05370
       TIX 3D0001,4,2                WHEN DONE, PREPARE                 F1B05380
       LXA L(3),4                    TO PICK UP 3 ADDENDS.              F1B05390
3D0002 CLA E+14,4                    CONVERT ADDENDS (BCD TO BINARY)=   F1B05400
       SLW G                         STRIP OFF                          F1B05410
       LDQ G                         SIGN,                              F1B05420
       TSX SR6DC1,1                * CONVERT ADDENDS IN E+11,12,13,     F1B05430
       LDQ E+14,4                    PUT SIGN IN S-BIT OF MQ, AND       F1B05440
       TQP 3D0040                    IF PLUS--SKIP NEXT,                F1B05450
       ORA 2E17                      IF MINUS--OR SIGN INTO BIT 18,     F1B05460
3D0040 STO E+14,4                    AND STORE BACK INTO E+11,12,13.    F1B05470
       TIX 3D0002,4,1                WHEN DONE,                         F1B05480
       TSX DIM3SR,4                * GO SEARCH DIM3 TABLE.              F1B05490
ER0013 BSS 0                                                            F1B05500
       TSX DIAG,4                  * --ERROR...NOT FOUND.               F1B05510
3D0060 CLA E+3                       REFORMATIZE E-STRING =             F1B05520
       ALS 18                        PACK TOGETHER COEFFICIENTS 1 AND 2 F1B05530
       ADD E+5                       AND STORE THEM                     F1B05540
       STO E+3                       IN E+3.                            F1B05550
       CLA E+4                       MOVE SUBSCRIPT 1                   F1B05560
       STO E+5                       TO E+5.                            F1B05570
       CLA E+7                       AND MOVE                           F1B05580
       ALS 18                        COEFFICIENT 3                      F1B05590
       STO E+4                       INTO E+4.                          F1B05600
       CLA E+8                       MOVE SUBSCRIPT 3 INTO E+7,         F1B05610
       STO E+7                       NEXT TO SUBSCRIPT 2 IN E+6.        F1B05620
       CLA ERASE1                    MOVE DIMENSIONS 1 AND 2            F1B05630
       STO E+8                       INTO E+8.                          F1B05640
       CAL E+11                      PACK TOGETHER                      F1B05650
       ALS 18                        ADDENDS 1 AND 2                    F1B05660
       ORA E+12                      AND                                F1B05670
       SLW E+11                      STORE THEM IN E+11.                F1B05680
       CAL E+13                      MOVE                               F1B05690
       ALS 18                        ADDEND 3                           F1B05700
       SLW E+12                      INTO E+12.                         F1B05710
       TSX TAU3IX,4                * GO SEARCH TAU3 TABLE.              F1B05720
       ALS 24                        POSITION TAU3 TAG, AND             F1B05730
       ORS E                         PLACE TAU3 TAG IN TAG WORD.        F1B05740
       CAL E+7                       COMBINE                            F1B05750
       ORA E+6                       SUBSCRIPTS 3,2, AND 1,             F1B05760
3D0340 ORA E+5                       AND IF THEY ARE ALL ZERO,          F1B05770
3D0350 TZE NOTAG                     --DONT ENTER FORTAG.               F1B05780
FTG000 CAL EIFNO                     ENTER FORTAG=                      F1B05790
       ANA MASK1                     BRING UP ALPHA (INTFORMNO)         F1B05800
       SLW G                         AND STORE IN G.                    F1B05810
       CAL E                         BRING UP TAUTAG FOR I,             F1B05820
       ARS 24                        ADJUST, AND                        F1B05830
       ORS G                         PLACE IN G WITH ALPHA.  THEN       F1B05840
       NZT ACFTG                     IS THIS ARITHMETIC FORTAG.     (23)F1B05850
       TSX CFTAG,2                   NO, MAKE TABLE ENTRY.          (23)F1B05860
       TXI     SAEXIT,,0             GO TO EXIT.                        F1B05870
2D0000 LXA L(4),4                    IF 2 DIM, PICKUP AND               F1B05880
2D0001 LDQ E+7,4                     CONVERT COEFFICIENTS               F1B05890
       TSX SR6DC1,1                * (BCD TO BINARY),                   F1B05900
       STO E+7,4                     AND STORE BACK IN E+3 AND E+5.     F1B05910
       TIX 2D0001,4,2                WHEN DONE,                         F1B05920
       LXA L(2),4                    PREPARE TO                         F1B05930
2D0002 CLA E+13,4                    PICKUP THE TWO ADDENDS.            F1B05940
       SLW G                         STRIP OFF                          F1B05950
       LDQ G                         THEIR SIGNS,                       F1B05960
       TSX SR6DC1,1                * CONVERT THEM FROM BCD TO BINARY,   F1B05970
       LDQ E+13,4                    PUT SIGN IN S-BIT OF MQ, AND       F1B05980
       TQP 2D0040                    IF PLUS--SKIP NEXT,                F1B05990
       ORA 2E17                      IF MINUS--OR SIGN INTO BIT 18,     F1B06000
2D0040 STO E+13,4                    AND STORE BACK IN E+11 AND E+12.   F1B06010
       TIX 2D0002,4,1                WHEN DONE,                         F1B06020
       TSX DIM2SR,4                * GO SEARCH DIM2 TABLE.              F1B06030
ER0014 TSX DIAG,4                  * --ERROR...NOT FOUND.               F1B06040
2D0060 CLA E+3                       REFORMATIZE E-STRING =             F1B06050
       ALS 18                        PACK TOGETHER                      F1B06060
       ADD E+5                       COEFFICIENTS 1 AND 2,              F1B06070
       STO E+3                       AND STORE THEM IN E+3.             F1B06080
       CLA E+6                       MOVE SUBSCRIPT 2 INTO E+5          F1B06090
       STO E+5                       (NEXT TO SUBSCRIPT 1 IN E+4).      F1B06100
       CLA ERASE1                    OBTAIN                             F1B06110
       ANA MASK1                     DIMENSION 1, AND MOVE IT           F1B06120
       STO E+6                       INTO E+6.                          F1B06130
       CAL E+11                      PACK TOGETHER                      F1B06140
       ALS 18                        ADDENDS 1 AND 2,                   F1B06150
       ORA E+12                      AND STORE THEM                     F1B06160
       SLW E+11                      IN E+11.                           F1B06170
       TSX TAU2IX,4                * GO SEARCH TAU2 TABLE.              F1B06180
       ALS 24                        POSITION TAU2 TAG, AND             F1B06190
       ORS E                         PLACE TAU2 TAG IN TAG WORD.        F1B06200
       CAL E+4                       COMBINE SUBSCRIPTS 1 AND 2, AND    F1B06210
       TXI     3D0340,,0             GO TO FORTAG SECTION.              F1B06220
1D0000 LDQ E+3                       IF 1 DIM, PICKUP AND CONVERT COEF. F1B06230
       TSX SR6DC1,1                * (BCD TO BINARY), AND               F1B06240
       ALS 18                        THEN ADJUST THEM,                  F1B06250
       STO E+3                       AND STORE THEM BACK IN E+3.        F1B06260
       CLA E+11                      PICKUP ADDEND,                     F1B06270
       SLW G                         STRIP OFF SIGN,                    F1B06280
       LDQ G                         CONVERT ADDEND                     F1B06290
       TSX SR6DC1,1                * (BCD TO BINARY), AND THEN          F1B06300
       LDQ E+11                      PUT SIGN IN S-BIT OF MQ, AND       F1B06310
       TQP 1D0001                    IF PLUS--SKIP NEXT,                F1B06320
       ORA 2E17                      IF MINUS--OR SIGN INTO BIT 18.     F1B06330
1D0001 ALS 18                        THEN ADJUST AND STORE              F1B06340
       SLW E+11                      BACK INTO E+11.                    F1B06350
       TSX TAU1IX,4                * GO SEARCH TAU1 TABLE.              F1B06360
       ALS 24                        POSITION TAU1 TAG, AND             F1B06370
       ORS E                         PLACE TAU1 TAG IN TAG WORD.        F1B06380
       CAL E+4                       TAKE SUBSCRIPT, AND                F1B06390
       TXI     3D0350,,0             GO TO FORTAG SECTION.              F1B06400
NOTAG  CAL 2E18                      PLACE SIGMA1                       F1B06410
       ALS 5                         TAG IN                             F1B06420
       ORS E                         TAGWORD.                           F1B06430
SAEXIT LXD SXR1,1                    RESTORE THE C(XR1),                F1B06440
       LXD SXR2,2                    RESTORE THE C(XR2),                F1B06450
       LXD SXR4,4                    RESTORE THE C(XR4), AND            F1B06460
       TRA 1,4                     * EXIT TO MAIN ROUTINE.              F1B06470
       REM  END OF PROGRAM SS000.                                       F1B06480
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B06490
       REM                                                              F1B06500
       REM SXD,2/ CALLS=CIT00.                                          F1B06510
       REM SXD COMPILES= IFN SXD 6)+4,4.                                F1B06520
 SXD   TSX  CIT00,4                * GO MAKE FOLLOWING CIT ENTRY=       F1B06530
       PZE  SL,,L(SXD)               LOC,,OP-DEC                        F1B06540
       PZE  O(,,D4A4                 ADR,,RA-TAG                        F1B06550
       TRA  1,2                    * EXIT TO CALLER+1.                  F1B06560
       REM  END OF PROGRAM SXD.                                         F1B06570
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B06580
       REM                                                              F1B06590
       REM CHSIFN/ CALLS=TET00.                                         F1B06600
       REM CHSIFN MAKES MINUS EIFNO ENTRY AND REENTERS PASS2.           F1B06610
CHSIFN CAL     EFN                   IF THIS STATEMENT HAS              F1B06620
       TZE     PASS2               * AN EXTERNAL STATEMENT NUMBER,      F1B06630
       CAL  MINUS0                   THEN MAKE A                        F1B06640
       ORS  EIFNO                    NEGATIVE ENTRY                     F1B06650
       TSX  TET00,1                * IN THE TAPE TABLE                  F1B06660
       PZE  0                        TEIFNO.                            F1B06670
       CAL  EIFNO                    THEN RESET THE SIGN OF EIFNO,      F1B06680
       STO  EIFNO                    AND REENTER PASS2.                 F1B06690
       TRA  PASS2                                                       F1B06700
       REM  END OF PROGRAM CHSIFN.                                      F1B06710
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B06720
       REM                                                              F1B06730
       REM  END OF PASS2 COMMON.                                        F1B06740
       REM                                                              F1B06750
       REM C0100/ CALLS=TEST..,C0180,C0160,C0150,TET00.                 F1B06760
       REM C0100 PROCESSES DO STATEMENTS.                               F1B06770
C0100  TSX C0180X,2                * FORM BINARY EQUIV OF BETA IN 1G.   F1B06780
       STO 2G                        SAVE THE 1ST CHAR OF SUBSCRIPT.    F1B06790
       CLA 1G                        TAKE CONVERTED RESULT FOR BETA     F1B06800
       STA 1C                        AND STORE IN ADDR OF 1C.           F1B06810
       CLA 2G                        1C IS NOW COMPLETE EXCEPT FOR TAG. F1B06820
       TSX C0160,2                 * OBTAIN IN 1G THE SUBSCRIPT.        F1B06830
       LDQ     1G                    MOVE SUBSCRIPT                     F1B06840
       STQ     1C+1                  TO 1C+1.                           F1B06850
       ERA     EQUAL                 IS PUNCTUATION AN EQUALS SIGN.     F1B06860
       TZE     *+2           *YES.                                      F1B06861
ER2003 TSX     DIAG,4         NO. GO TO DIAGNOSTIC.                     F1B06862
       LGL     6                     SHIFT FIRST CHARACTER INTO AC.     F1B06870
       TSX     TESTFX+1,1            TEST FOR FIXED POINT NAME.         F1B06880
       TRA     ER2001                ERROR, NAME IS NOT FIXED POINT.    F1B06890
       TSX C0150,2                 * OBTAIN IN 1G THE PROPER N1.        F1B06900
       TSX     TESTG0,4       TEST FOR COMMA BETWEEN N1 AND N2.         F1B06910
       CLA 1G                        STORE N1                           F1B06920
       STO 1C+2                      IN 1C+2.                           F1B06930
       CAL I                         OBTAIN I IN LOGICAL ACC AND        F1B06940
       ARS 18                        STORE IN POS 18 OF 1C              F1B06950
       ORS 1C                        0 IF NUMERIC, OR 1 IF NON-NUMERIC. F1B06960
       TSX C0150,2                 * OBTAIN IN 1G THE PROPER N2.        F1B06970
       TSX TESTA0,4                * TEST THE AC FOR COMMA OR ENDMARK.  F1B06980
       TNZ C0113                     IF ENDMARK, THEN                   F1B06990
       LDQ FAKEN3                                                       F1B07000
       STQ RESIDU                    AND PLACE IN RESIDU.               F1B07010
C0113  CLA 1G                        STORE N2                           F1B07020
       STO 1C+3                      IN 1C+3.                           F1B07030
       CAL I                         OBTAIN I IN LOG ACC AND            F1B07040
       ARS 19                        STORE IN POS 19 OF 1C              F1B07050
       ORS 1C                        0 IF NUMERIC, OR 1 IF NON-NUMERIC. F1B07060
       TSX C0150,2                 * OBTAIN IN 1G THE PROPER N3.        F1B07070
       TSX TESTD0,4                * THE AC SHOULD CONTAIN AN ENDMARK.  F1B07080
       CLA 1G                        STORE N3                           F1B07090
       STO 1C+4                      IN 1C+4.                           F1B07100
       CAL I                         OBTAIN I IN LOG ACC AND            F1B07110
       ARS 20                        STORE IN POS 20 OF 1C              F1B07120
       ORS 1C                        0 IF NUMERIC, OR 1 IF NON-NUMERIC. F1B07130
       TSX TET00,1                 * GO TO TET PROGRAM TO ENTER         F1B07140
       PZE 1                         1C,1C+1,..1C+4 IN TDO TABLE 1.     F1B07150
       TRA     PASS2               * EXIT TO PASS2.                     F1B07160
       REM  END OF PROGRAM C0100.                                       F1B07170
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B07180
       REM                                                              F1B07190
       REM C0150,2/ CALLS=C0190,C0180,C0160.      CALLER=C0100.         F1B07200
       REM C0150 INSPECTS 1ST NB CHAR STARTING IN MQ. IF NUMERIC, SETS IF1B07210
       REM = 0, AND CONVERTS SUCCESSIVE NUMERICS TO BINARY. IF NON-     F1B07220
       REM NUMERIC, SETS I = -0, AND PACKS INTO 1G SUCCESSIVE CHARACTERSF1B07230
       REM UNTIL A ,()= OR ENDMK IS MET, AND LEFT IN THE AC.            F1B07240
C0150  SXD C015X,2                   SAVE THE C(XR2).                   F1B07250
       TSX C0190,4                 * TEST 1ST NON-BLANK CHARACTER       F1B07260
       CAS L(9)                      FOR NUMERIC OR NON-NUMERIC.        F1B07270
C015X  TXI C0151,0,**                IF NON-NUMERIC, TRANSFER.          F1B07280
       NOP                           IF NUMERIC, THEN                   F1B07290
       TSX C0180,2                 * GO CONVERT TO BINARY.              F1B07300
       STO 2G                        SAVE NEXT NON-NUMERIC CHARACTER.   F1B07310
       CLA L(0)                      PREPARE TO SET I TO +0.            F1B07320
       TXI     C0152,,0              GO SET I FOR NUMERIC.              F1B07330
C0151  TSX     TESTFX+1,1     TEST FOR FIXED POINT VARIABLE.            F1B07340
ER2001 TSX     DIAG,4         ERROR, NOT FIXED POINT BEGINNING.         F1B07350
       TSX     C0160,2        ASSEMBLE NON-NUMERICS IN 1G.              F1B07360
       STO 2G                        SAVE PUNCTUATION MARK, AND         F1B07370
       CLS L(0)                      PREPARE TO SET I TO -0.            F1B07380
C0152  STO I                         SET I = +0, OR -0.                 F1B07390
       CLA 2G                        PICKUP NEXT CHARACTER,             F1B07400
       LXD C015X,2                   RESTORE THE C(XR2), AND            F1B07410
       TRA 1,2                     * RETURN TO CALLER.                  F1B07420
       REM  END OF PROGRAM C0150.                                       F1B07430
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B07440
       REM                                                              F1B07450
       REM C0200/ CALLS=CIT00,SS000,TEST..,C0190,C0180,TET00,C0160,     F1B07460
       REM C0200 PROCESSES GO TO STATEMENTS.                            F1B07470
C0200  CLA 1C                        PLACE                              F1B07480
       STO 1C+2                      IFN IN 1C+2.                       F1B07490
       TSX C0190,4                 * OBTAIN IN ACC NEXT NB CHARACTER    F1B07500
       CAS L(9)                      AND COMPARE IT WITH 9.             F1B07510
       TXI     C0205,,0              IF NON-NUMERIC, COMPARE WITH (.    F1B07520
       NOP                           IF NUMERIC, THEN                   F1B07530
       TSX C0180,2                 * OBTAIN IN 1G THE BINARY EQUV BETA. F1B07540
       TSX TESTD0,4                * THE AC SHOULD CONTAIN AN ENDMARK.  F1B07550
       CLA 1G                        STORE BETA IN 1C+1 TO CONSTRUCT    F1B07560
       STO 1C+1                      THE 2ND WORD OF TIFGO TABLE ENTRY. F1B07570
       TXI     C0202,,0              GO TO ENTER 1C,1C+1 INTO TIFGO.    F1B07580
C0205  CAS OPEN                      TEST CHARACTER FOR ALPHABETIC.     F1B07590
       TXI     C0210,,0              IF NOT ALPHABETIC, THEN            F1B07600
       TXI     C0212,,0              THIS IS TYPE  ..... GO TO ( ),I    F1B07610
C0210  TSX C0160,2                 * TYPE= GO TO N,(),SO OBTAIN IN 1G N F1B07620
       TSX TESTG0,4                * WHICH SHOULD BE FOLLOWED BY COMMA. F1B07630
       CLA 1G                        SAVE THE SYMBOL N IN 1C+3          F1B07640
       STO 1C+3                      FOR COMPILED INSTRUCTION.          F1B07650
       TSX C0190,4                 * OBTAIN IN ACC NEXT NB CHARACTER,   F1B07660
       TSX TESTE0,4                * WHICH SHOULD BE A LPAREN.          F1B07670
       CLA L(1)                      PREPARE TO SET ADDRESS PART OF 1C  F1B07680
       TRA C0213                     TO 1 TO INDICATE CLASS OF TRANSFER.F1B07690
C0212  CLA L(2)                      PREPARE TO SET ADDR OF 1C TO 2.    F1B07700
C0213  STA 1C                        STORE 1 OR 2 IN ADDR OF 1C.        F1B07710
       LXD CTRAD,2                   OBTAIN 250-(NO. TRAD ENTRIES), AND F1B07720
       PXD ,2                        PLACE IN THE DECREMENT OF THE AC   F1B07730
       STO 1C+1                      AND STORE IN 1C+1.                 F1B07740
C0215  TSX C0180X,2                * OBTAIN BINARY TRA ADDRESS IN 1G.   F1B07750
       STO 2G                        SAVE CHAR IN ACC.                  F1B07760
       TSX TET00,1                 * GO TO ENTER 1G                     F1B07770
       PZE 3                         INTO TRAD TABLE (TABLE 3).         F1B07780
       LXD CTRAD,2                   REDUCE COUNTER                     F1B07790
       TIX C0216,2,1                 CTRAD                              F1B07800
C0216  SXD CTRAD,2                   BY 1.                              F1B07810
       CLA 2G                        RESTORE CHAR TO ACC.               F1B07820
       TSX TESTB0,4                * TEST FOR COMMA OR RPAREN.          F1B07830
       TNZ C0215                     IF RIGHT PARENTHESIS, THEN         F1B07840
       LXD CTRAD,4                   OBTAIN 250 MINUS NO. TRAD ENTRIES  F1B07850
       SXA 1C+1,4                    IN ADDR OF 1C+1.                   F1B07860
       CLA 1C                        OBTAIN 1C IN ACC                   F1B07870
       LBT                           AND TEST LOW ORDER BIT.            F1B07880
       TRA C0220                     THIS IS A TYPE GO TO (),I FORMULA. F1B07890
       TSX C0190,4                 * OBTAIN NEXT NB CHAR AND            F1B07900
       TSX TESTD0,4                * TEST FOR ENDMK.                    F1B07910
       TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B07920
       PZE 1C+2,,L(TRA)              LOC,,OP-DEC                        F1B07930
       PZE 1C+3,,L(0)                ADR,,RA-TAG                        F1B07940
       TRA C0202                     GO TO ENTER 1C,1C+1 INTO TIFGO.    F1B07950
C0220  TSX C0190,4                 * EXAMINE NEXT NB CHARACTER,         F1B07960
       TSX TESTG0,4                * WHICH SHOULD BE A COMMA.           F1B07970
       TSX C0190,4                 * OBTAIN IN ACC NEXT NB CHAR, AND    F1B07980
       TSX TESTFX+1,1        TEST FOR FIXED OR FLOATING POINT.          F1B07990
       TRA ER0055            FLOATING POINT RETURN IS ERROR.            F1B08000
       TSX C0160,2                 * OBTAIN IN 1G THE FXD-PT. VARIABLE, F1B08010
       TSX TESTD0,4                * WHICH SHOULD BE FOLLOWED BY ENDMK. F1B08020
       CLA L(1)                      PREPARE PROPER FORM OF SUBSCRIPT   F1B08030
       STO E+3                       COMBINATION AS                     F1B08040
       STO ERASE                     INPUT TO SUBSCRIPT ANALYSIS=       F1B08050
       CLA 1G                        E+3 = 1ST COEFFICIENT,             F1B08060
       STO E+4                       E+4 = 1ST SUBSCRIPT VARIABLE,      F1B08070
       STZ E+9                       E+9 = ADDEND OF SUBSCRIPT,         F1B08080
       TSX CSA000,4                * DIMCTR = DIMENSION OF VARIABLE.    F1B08090
       CLA E                         OUTPUT FROM CSA IS FOUND IN        F1B08100
       ARS 24                        E = I--TAUTAG (GENERAL TAG) 1-11.  F1B08110
       STO 2G                        ADJUST AND SAVE FOR COMP. INSTR.   F1B08120
       TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B08130
       PZE 1C+2,,L(TRA)              LOC,,OP-DEC                        F1B08140
       PZE L(0),,2G                  ADR,,RA-TAG                        F1B08150
       REM C0200= ENTRY POINT USED BY C0400,C1000.                      F1B08160
C0202  TSX TET00,1                 * GO TO TET TO ENTER 1C AND 1C+1     F1B08170
       PZE 2                         INTO TIFGO TABLE (TABLE 2).        F1B08180
 CTRAD TXI PASS2,0,TRADMX          * EXIT TO PROCESS NEXT STATEMENT.    F1B08190
       REM  END OF PROGRAM C0200.                                       F1B08200
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B08210
       REM                                                              F1B08220
       REM C0300/ CALLS= ARITH,C0190,C0390,TEST..,DIAG,C0180,TET00.     F1B08230
       REM C0300 PROCESSES IF STATEMENTS.                               F1B08240
C0300  CAL MINUS0                    SET SIGN OF                        F1B08250
       ORS 1C                        1C TO MINUS.                       F1B08260
       TSX C0190,4                 * OBTAIN IN AC THE 1ST NB CHAR (I).  F1B08270
       LDQ L(X)                      REPLACE THE CHARACTER I            F1B08280
       TSX C0390,4                 * WITH THE CHARACTER X.              F1B08290
       LDQ TEN                       REPLACE THE CHARACTER F            F1B08300
       TSX C0390,4                 * WITH THE CHARACTER 001010.         F1B08310
       TSX TESTE0,4                * IF NOT LPAREN -- THEN ERROR.       F1B08320
       LDQ EQUAL                     REPLACE THE CHARACTER LPAREN       F1B08330
       TSX C0390,4                 * WITH THE CHARACTER EQUAL.          F1B08340
       LXA L(1),2                    SET XR2 FOR COUNTING PARENTHESES.  F1B08350
       LDQ IFSYM2            SET LEFT+2 TO INTERNAL QUASI-ARITHMETIC IF F1B08360
       STQ LEFT+2            SYMBOL FOR DIAGNOSTIC IN CASE OF NEXT CALL.F1B08370
       TRA *+2                       THEN                               F1B08380
C0302  TSX C0190,4                 * MAKE SURE THAT NEXT NB CHARACTER   F1B08390
       CAS ENDMK                     IS NOT AN ENDMARK.                 F1B08400
       TSX     MRTN77,4      *CHARACTER GREATER THAN 77 OCTAL, IMPOSS.  F1B08410
ER0034 TSX DIAG,4                  * PROGRAM ERROR, GO TO DIAGNOSTIC.   F1B08420
       CAS OPEN                      IF IT IS A LPAREN,                 F1B08430
       TXI     C0303,,0              THEN ADD 1 TO PAREN COUNT, AND     F1B08440
       TXI C0302,2,1                 GO EXAMINE NEXT CHARACTER.         F1B08450
C0303  SUB CLOS                      IF IT IS A RPAREN,                 F1B08460
       TNZ C0302                     THEN TEST PAREN COUNT, AND IF IT   F1B08470
       TIX C0302,2,1                 CAN NOT BE REDUCED,MATE IS FOUND.  F1B08480
       LDQ ENDMK                     SO REPLACE THE CHARACTER RPAREN    F1B08490
       TSX C0390,4                 * WITH THE CHARACTER ENDMK.          F1B08500
       TSX C0180,2                 * OBTAIN BINARY BETA1.               F1B08510
       TSX TESTG0,4                * THIS SHOULD BE FOLLOWED BY A COMMA.F1B08520
       CLA 1G                        MOVE BETA1                         F1B08530
       STA 1C                        TO ADDRESS OF 1C.                  F1B08540
       TSX C0180X,2                * OBTAIN BINARY BETA2.               F1B08550
       TSX TESTG0,4                * THIS SHOULD BE FOLLOWED BY A COMMA.F1B08560
       CLA 1G                        MOVE BETA2                         F1B08570
       ALS 18                        TO DECR PART                       F1B08580
       STO 1C+1                      OF 1C+1.                           F1B08590
       TSX C0180X,2                * OBTAIN BINARY BETA3.               F1B08600
       TSX TESTD0,4                * THIS SHOULD BE FOLLOWED BY ENDMARK.F1B08610
       CLA 1G                        MOVE BETA3                         F1B08620
       STA 1C+1                      TO ADDRESS OF 1C+1.                F1B08630
       TXI     ARITH,,0              EXIT TO ARITHMETIC.                F1B08640
       REM  END OF PROGRAM C0300.                                       F1B08650
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B08660
       REM                                                              F1B08670
       REM C0400/ CALLS=C0180X,TEST..,CIT00,C0200.                      F1B08680
       REM C0400 PROCESSES IF (SENSE SWITCH STATEMENTS.                 F1B08690
C0400  CLA L(112)                    FOR SENSE SWITCH                   F1B08700
       STO 1H                        SET 1H TO 112, AND PREPARE TO      F1B08710
       CLA L(PSE)                    SET 2H TO PSE.                     F1B08720
C0401  STO 2H                        SET 2H FOR SENSE SWITCH OR LIGHT.  F1B08740
       TSX C0180X,2                * OBTAIN BINARY SENSE SWITCH OR LITE.F1B08750
       TSX TESTF0,4                * THIS SHOULD BE FOLLOWED BY RPAREN. F1B08760
       REM     ENTRY FROM C0501 (IF SENSE LIGHT) ROUTINE            (30)F1B08769
       CLA L(3)                      STORE 3                            F1B08770
       STA 1C                        IN ADDRESS OF 1C.                  F1B08780
       CLA 1G                        ADD THE PROPER INCREMENT TO THE    F1B08790
       ADD 1H                        NUMBER OF SENSE SWITCH OR LIGHT,   F1B08800
       ALS 18                        AND ADJUST TO THE DECREMENT.       F1B08810
       REM C0402= ENTRY POINT USED BY C0600.                            F1B08820
C0402  STO 1C+3                      SET 1C+3 FOR CIT ENTRY.            F1B08830
       LXD EIFNO,4                   PLACE THE CURRENT INTERNAL FORMULA F1B08840
       PXD ,4                        NUMBER IN THE DECREMENT OF         F1B08850
       STO 1C+2                      1C+2 FOR FUTURE CIT ENTRY.         F1B08860
       TSX C0180X,2                * OBTAIN BINARY BETA1.               F1B08870
       TSX TESTG0,4                * WHICH SHOULD BE FOLLOWED BY COMMA. F1B08880
       CLA 1G                        BRING UP,                          F1B08890
       ALS 18                        ADJUST AND                         F1B08900
       STO 1C+1                      STORE BETA1 IN DECR OF 1C+1.       F1B08910
       TSX C0180X,2                * OBTAIN BINARY BETA2.               F1B08920
       TSX TESTD0,4                * WHICH SHOULD BE FOLLOWED BY ENDMK. F1B08930
       CLA 1G                        BRING UP AND                       F1B08940
       STA 1C+1                      STORE BETA2 IN ADDR OF 1C+1.       F1B08950
       TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B08960
       PZE 1C+2,,2H                  LOC,,OP-DEC                        F1B08970
       PZE L(0),,1C+3                ADR,,RA-TAG                        F1B08980
       TXI     C0202,,0              MAKE TIFGO ENTRY, AND RETURN TO CA.F1B08990
       REM  END OF PROGRAM C0400.                                       F1B09000
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B09010
       REM                                                              F1B09020
       REM C0500/ USES=C0400.                                           F1B09030
       REM C0500 PROCESSES IF (SENSE LIGHT STATEMENTS.                  F1B09040
C0500  CLA L(96)                     STORE 96 IN                        F1B09050
       STO 1H                        1H AND                             F1B09060
       CLA L(MSE)                    OBTAIN (MSE000) IN ACC.            F1B09070
       TRA     C0501         CHECK LIGHT NUMBER                     (30)F1B09080
       REM  END OF PROGRAM C0500.                                       F1B09090
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B09100
       REM                                                              F1B09110
       REM C0600/ USES=C0400.                                           F1B09120
       REM C0600 PROCESSES IF DIVIDE CHECK STATEMENTS.                  F1B09130
C0600  CLA L(DCT)                    STORE (DCT000)                     F1B09140
       STO 2H                        IN 2H                              F1B09150
       CLA L(4)                      AND PICK UP 4 TO SET 1C.           F1B09160
       REM C0601= ENTRY POINT USED BY C0700.                            F1B09170
C0601  STA 1C                        SET 1C FOR FUTURE TIFGO ENTRY.     F1B09180
       PXD ,0                        CLEAR THE AC,                      F1B09190
       TRA C0402                   * AND CONTINUE BY USING PROGRAM C04. F1B09200
       REM  END OF PROGRAM C0600.                                       F1B09210
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B09220
       REM                                                              F1B09230
       REM C0700/ USES C0600. CALLS=CIT00,JIF.                          F1B09240
       REM C0700 PROCESSES IF AC (OR MQ) OVERFLOW STATEMENTS.           F1B09250
C0700  TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B09260
       PZE 1C,,L(CAL)                LOC,,OP-DEC                        F1B09270
       PZE P(,,MI205                 ADR,,RA-TAG                        F1B09280
       TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B09290
       PZE L(0),,L(STZ)              LOC,,OP-DEC                        F1B09300
       PZE P(,,MI205                 ADR,,RA-TAG                        F1B09310
       TSX JIF,4                   * GO JUMP IFN, AND                   F1B09320
       STO 1C                        SET 1C.                            F1B09330
       CLA L(TNZ)                    PREPARE TO COMPILE=                F1B09340
       STO 2H                        IFN TNZ BETA1.                     F1B09350
       CLA L(5)                      PICKUP 5 TO SET 1C, AND            F1B09360
       TRA C0601                   * CONTINUE BY USING PROGRAM C06.     F1B09370
       REM  END OF PROGRAM C0700.                                       F1B09380
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B09390
       REM                                                              F1B09400
       REM C0900/ CALLS=C0190,CIT00,DIAG.                               F1B09410
       REM C0900 PROCESSES PAUSE STATEMENTS.                            F1B09420
C0900  LXD     C090X,2               SET XR2 FOR EXIT TO RDXQ.          F1B09430
       REM C0901= ENTRY POINT USED BY C1300.                            F1B09440
C0901  STZ 1G                        CLEAR 1G.                          F1B09450
C0902  TSX C0190,4                 * TEST NEXT NON-BLANK CHARACTER      F1B09460
       CAS ENDMK                     FOR END OF STATEMENT MARK.         F1B09470
       TSX     MRTN77,4      *CHARACTER GREATER THAN 77 OCTAL, IMPOSS.  F1B09480
C090X  TXI     C0903,,-PASS2+1       IF NOT END OF STATEMENT, THEN      F1B09490
       CAS L(7)                      TEST WHETHER DIGIT EXCEEDS 7,      F1B09500
ER1005 TSX DIAG,4                  * IF SO, GO CALL DIAGNOSTIC.         F1B09510
       NOP                           IF NOT,                            F1B09520
       ADD 1G                        ADD 1G TO DIGIT,                   F1B09530
       ALS 3                         MULTIPLY BY 8,                     F1B09540
       STO 1G                        AND STORE BACK IN 1G.              F1B09550
       TXI     C0902,,0              CONTINUE UNTIL END OF SEGMENT.     F1B09560
C0903  CLA 1G                        THEN PLACE OCTAL ALPHA             F1B09570
       ALS 15                        IN THE DECREMENT                   F1B09580
       ANA 1BAR                      ONLY                               F1B09590
       STO 1C+1                      OF 1C+1,WITH ZEROS ELSEWHERE.      F1B09600
       TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B09610
       PZE 1C,,L(HPR)                LOC,,OP-DEC                        F1B09620
       PZE L(0),,1C+1                ADR,,RA-TAG                        F1B09630
       TRA 1,2                     * EXIT TO CA000, OR TO C1300.        F1B09640
       REM  END OF PROGRAM C0900.                                       F1B09650
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B09660
       REM                                                              F1B09670
       REM C1000/ USES=C0200. CALLS=GETIFN,C0190,C0180,DIAG,C0160,TEST..F1B09680
       REM CIT00.                                                       F1B09690
       REM C1000 PROCESSES ASSIGN STATEMENTS.                           F1B09700
C1000  TSX GETIFN,4                * GET INTERNAL FORMULA NUMBER IN 1C  F1B09710
       STO 1C+2                      AND 1C+2,WITH ZEROS ELSEWHERE.     F1B09720
       CLA L(6)                      STORE 6 IN                         F1B09730
       STA 1C                        ADDRESS OF 1C.                     F1B09740
       TSX C0180X,2                * FORM IN 1G THE BINARY OF ALPHA.    F1B09750
       SUB L(T)                      IF NEXT CHARACTER IS NOT T, THEN   F1B09760
       TZE *+2                       THIS IS AN                         F1B09770
ER0035 TSX DIAG,4                  * ERROR - GO TO THE DIAGNOSTIC.      F1B09780
       TSX C0190,4                 * EXAMINE NEXT NON-BLANK CHARACTER   F1B09790
       SUB L(O)                      AND IF IT IS NOT O, THEN           F1B09800
       TNZ *-3                       ERROR, GO TO DIAGNOSTIC.           F1B09810
       CLA 1G                        PUT BIN EQUIV OF ALPHA             F1B09820
       STO 1C+1                      IN ADDRESS OF 1C+1.                F1B09830
       TSX C0190,4                 * PROCEED TO ASSEMBLE IN 1G          F1B09840
       TSX TESTFX+1,1        TEST FOR FIXED OR FLOATING POINT.          F1B09850
       TRA ER0055            FLOATING POINT RETURN IS ERROR.            F1B09860
       TSX C0160,2                 * THE SYMBOL N.                      F1B09870
       TSX TESTD0,4                * THE NEXT NB CHAR SHOULD BE ENDMK.  F1B09880
       TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B09890
       PZE 1C+2,,L(CLA)              LOC,,OP-DEC                        F1B09900
       PZE L(0),,L(0)                ADR,,RA-TAG                        F1B09910
       TSX CIT00,4                 * STORE SECOND COMPILED INSTRUCTION= F1B09920
       PZE L(0),,L(STO)              LOC,,OP-DEC                        F1B09930
       PZE 1G,,L(0)                  ADR,,RA-TAG                        F1B09940
       TRA C0202                   * CONTINUE BY USING PROGRAM C02.     F1B09950
       REM  END OF PROGRAM C1000.                                       F1B09960
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B09970
       REM                                                              F1B09980
       REM C1100/ CALLS=C0180X,TEST..,CIT00.                            F1B09990
       REM C1100 PROCESSES SENSE LIGHT STATEMENTS.                      F1B10000
C1100  TSX C0180X,2                * FORM IN 1G THE BINARY OF SLN.      F1B10010
       TSX TESTD0,4                * THE NEXT NB CHARACTER SHD BE ENDMK.F1B10020
       CLA 1G                        STORE SENSE LIGHT NUMBER           F1B10030
       ADD L(96)                     PLUS 96                            F1B10040
       ALS 18                        IN DECR                            F1B10050
       STO 1G                        OF 1G.                             F1B10060
       TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B10070
       PZE 1C,,L(PSE)                LOC,,OP-DEC                        F1B10080
       PZE L(0),,1G                  ADR,,RA-TAG                        F1B10090
       TRA     PASS2               * EXIT TO PASS2.                     F1B10100
       REM  END OF PROGRAM C1100.                                       F1B10110
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B10120
       REM                                                              F1B10130
       REM C1300/ CALLS=C0901,TET00,CIT00.                              F1B10140
       REM C1300 PROCESSES STOP STATEMENTS.                             F1B10150
C1300  TSX TET00,1                 * GO MAKE EIFNO ENTRY                F1B10160
       PZE 15                        IN TSTOP TABLE.                    F1B10170
       TSX C0901,2                 * USE C0900 TO BEGIN PROCESSING.     F1B10180
       TSX CIT00,4                 * GO MAKE FOLLOWING CIT ENTRY=       F1B10190
       PZE L(0),,L(TRA)              LOC,,OP-DEC                        F1B10200
       PZE 1C,,L(0)                  ADR,,RA-TAG                        F1B10210
       TRA     PASS2               * EXIT TO PASS2.                     F1B10220
       REM  END OF PROGRAM C1300.                                       F1B10230
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B10240
       REM                                                              F1B10250
       REM C1600/ CALLS=C0190,TEST..,GIF,BSS.                           F1B10260
       REM C1600 PROCESSES CONTINUE STATEMENTS.                         F1B10270
C1600  TSX C0190,4                 * OBTAIN NEXT NBCHAR IN ACC.         F1B10280
       TSX TESTD0,4                * CHARACTER SHOULD BE AN ENDMARK.    F1B10290
       TSX GIF,4                   * GET INTERNAL FORMULA NUMBER, AND   F1B10300
       TSX BSS,2                   * GO COMPILE= IFN BSS 0.             F1B10310
       TRA     PASS2               * EXIT TO PASS2.                     F1B10320
       REM  END OF PROGRAM C1600.                                       F1B10330
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B10340
       REM                                                              F1B10350
       REM C3200/ CALLS=C0190,TEST..,JIFGIF,DIAG,CIT00.                 F1B10360
       REM C3200 PROCESSES RETURN STATEMENTS.                           F1B10370
C3200  TSX C0190,4                 * EXAMINE NEXT NON-BLANK CHARACTER,  F1B10380
       TSX TESTD0,4                * WHICH SHOULD BE AN ENDMARK.        F1B10390
       TSX JIF,4                   * SET SL TO ALPHA+1.                 F1B10400
       TSX     TET00,1       ENTER THIS IFN IN TSTOPS TABLE.            F1B10410
       PZE     15                                                       F1B10420
       LXD     SBDFCN,4              IS THIS RETURN IN A SUBPROGRAM.    F1B10430
       TXH     *+2,4,0             * YES.                               F1B10440
ER0039 TSX DIAG,4                  * ERROR - GO TO THE DIAGNOSTIC.      F1B10450
       CLA FSNAME                    UNLESS FUNCTION NAME IS ZERO,      F1B10460
       TZE C3201                     THEN                               F1B10470
       REM DOUBLE PRECISION - COMPLEX ARITHMETIC PATCH.                 F1B10480
       CLA     MODECL        GET SPECIAL MODE INDICATOR, IF ANY.        F1B10490
       STZ     MODECL        CLEAR INDICATOR.                           F1B10500
       NZT     FSNAME        TEST WHETHER WITHIN A FUNCTION SUBPROGRAM. F1B10510
       TRA     C3201         SUBROUTINE TYPE SUBPROGRAM                 F1B10520
       CAS     L(B)          TEST FOR BOOLEAN                           F1B10530
       TRA     C3204         NOT BOOLEAN, EXIT                          F1B10540
       TRA     *+2           BOOLEAN                                    F1B10550
       TRA     C3204         NOT BOOLEAN, EXIT                          F1B10560
       TSX     CIT00,4       COMPILE                                    F1B10570
       PZE     1C,,L(CAL)              CAL FSNAME                       F1B10580
       PZE     FSNAME,,L(0)                                             F1B10590
       TRA     C3201-1                                                  F1B10600
C3204  CAS L(D)              TEST FOR DOUBLE PRECISION.                 F1B10610
       TRA *+2                                                          F1B10620
       TRA C3203             YES                                        F1B10630
       SUB L(I)              TEST FOR COMPLEX ARITHMETIC.               F1B10640
       TNZ C3202             NEITHER.                                   F1B10650
C3203  CLA 1C                SET UP  AND                                F1B10660
       STO CW                COMPILE                                    F1B10670
CORR03 CAL     FSNAME                                                   F1B10680
       SLW     CW+2                                                     F1B10690
       SLW     E+2                                                      F1B10700
       LGR     30                                                       F1B10710
       LAS     L(H)                                                     F1B10720
       LAS     L(O)                                                     F1B10730
       TRA     *+3           FLOATING                                   F1B10740
       TRA     *+2           DITTO                                      F1B10750
       TRA     C3202         FIXED TREATED SAME AS NORMAL FORTRAN       F1B10760
       STZ     CW+3                                                     F1B10770
       CLS     2E18                                                     F1B10780
       STO     DPCW                                                     F1B10790
       TSX     CPDCLA,2      COMPILE SEQUENCE FOR DP AND CA  CLA        F1B10800
       TRA     C3201-1                                                  F1B10810
       REM                                                              F1B10820
C3202  TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B10830
       PZE 1C,,L(CLA)                LOC,,OP-DEC                        F1B10840
       PZE FSNAME,,L(0)              ADR,,RA-TAG                        F1B10850
       STZ 1C                        CLEAR 1C, AND                      F1B10860
C3201  TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B10870
       PZE 1C,,L(LXD)                LOC,,OP-DEC                        F1B10880
       PZE DOLSGN,,L(1)              ADR,,RA-TAG                        F1B10890
       TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B10900
       PZE L(0),,L(LXD)              LOC,,OP-DEC                        F1B10910
       PZE DOLSGN,,ABTAG2            ADR,,RA-TAG                        F1B10920
       TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B10930
       PZE L(0),,L(QXD)              LOC,,OP-DEC                        F1B10940
       PZE DOLSGN,,ABTAG3            ADR,,RA-TAG                        F1B10950
       TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B10960
       PZE SL,,L(QPR)                LOC,,OP-DEC                        F1B10970
       PZE L(0),,ARGCNT              ADR,,RA-TAG                        F1B10980
       TSX CIT00,4                 * GO MAKE THE FOLLOWING CIT ENTRY=   F1B10990
       PZE L(0),,L(TRA)              LOC,,OP-DEC                        F1B11000
       PZE SL,,L(0)                  ADR,,RA-TAG                        F1B11010
       TRA     PASS2               * EXIT TO PASS2.                     F1B11020
       REM  END OF PROGRAM C3200.                                       F1B11030
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B11040
       REM                                                              F1B11050
       REM C3300/ CALLS=C0390,C0190X,C0190,TEST..,ARITH,SUBX00,TET00,   F1B11060
       REM GIF,SXD,LIB.                                                 F1B11070
       REM C3300 PROCESSES CALL STATEMENTS.                             F1B11080
C3300  TSX C0190,4                 * IF 1ST CHARACTER OF NAME IS        F1B11090
       TSX C0160,2                 * COLLECT THE REST OF THE NAME, WHICHF1B11100
       TSX TESTC0,4                * SHD BE FOLLOWED BY LPAREN OR ENDMK.F1B11110
       TRA     C3302         CHECK DIMENSION TABLE ENTRIES          (29)F1B11120
       TSX C0190X,4                * PSEUDO-ARITHMETIC FORMULA (Z10=).  F1B11130
       TSX C0190,4                 * PICKUP THE CHARACTER C,            F1B11140
       LDQ L(Z)                      AND                                F1B11150
       TSX C0390,4                 * REPLACE C WITH Z.                  F1B11160
       LDQ TEN                       AND                                F1B11170
       TSX C0390,4                 * REPLACE A WITH TEN.                F1B11180
       LDQ EQUAL                     AND                                F1B11190
       TSX C0390,4                 * REPLACE FIRST L WITH =.            F1B11200
       LDQ 12Z                       AND                                F1B11210
       TSX C0390,4                 * REPLACE SECOND L WITH +.           F1B11220
       TXI     ARITH,,0              THEN EXIT TO ARITHMETIC.           F1B11230
C3301  TSX GIF,4                   * GET CURRENT IFN AND                F1B11240
       TSX SXD,2                   * COMPILE  SXD  6)+4,4.              F1B11250
       TSX LIB,4                   * GO ENTER NAME IN CLOSUB, COMPILE=  F1B11260
       PZE L(0),,L(TSX)              LOC,,OP-DEC                        F1B11270
       PZE 1G,,L(4)                  ADR,,RA-TAG                        F1B11280
       TSX     FLTR00,4      COMPILE FLOW TRACE CITS IF ACTIVATED.      F1B11290
       PZE     L(0),,L(LXD)  THEN COMPILE LXD 6(+4,4                    F1B11300
       PZE     O(,,D4A4                                                 F1B11310
       TRA     PASS2               * EXIT TO PASS2.                     F1B11320
       REM  END OF PROGRAM C3300.                                       F1B11330
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B11340
       REM                                                              F1B11350
       REM                                                              F1B11360
       REM                                                              F1B11370
       REM  END OF CONTROL STATEMENT PROCESSORS.                        F1B11380
       REM                                                              F1B11390
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B11400
       REM                                                              F1B11410
       REM PASS 2/3-PROCESS INPUT-OUTPUT STATEMENTS=                    F1B11420
       REM                                                              F1B11430
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B11440
       REM                                                              F1B11450
       REM  READ INPUT TAPE N                                           F1B11460
       REM  TSH / ENTRY FROM CLASSIFICATION.                            F1B11470
 TSH   TSX  UNIT,4                 * GO PROCESS UNIT DESIGNATION.       F1B11480
       AXT  (TSH),4                  PICKUP FIRST TSX ADDRESS.          F1B11490
       REM  HI / ENTRY FROM CSH.                                        F1B11500
 HI    TSX  INPUT,2                * GO PROCESS CALLING SEQUENCE.       F1B11510
       TSX     FMTDSG,1            * GO PROCESS FORMAT DESIGNATION.     F1B11520
       AXT  (RTN),4                  PICKUP FINAL TSX ADDRESS.          F1B11530
       TRA  SCAN                   * EXIT TO SCAN LIST.                 F1B11540
       REM  EXIT TSH.                                                   F1B11550
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B11560
       REM                                                              F1B11570
       REM  READ                                                        F1B11580
       REM  CSH / ENTRY FROM CLASSIFICATION.                            F1B11590
 CSH   TSX  GIF,4                  * GO SET SYMBOLIC LOCATION.          F1B11600
       AXT  (CSH),4                  PICKUP FIRST TSX ADDRESS.          F1B11610
       TRA  HI                     * CONTINUE ABOVE.                    F1B11620
       REM  EXIT CSH.                                                   F1B11630
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B11640
       REM                                                              F1B11650
       REM  WRITE OUTPUT TAPE N                                         F1B11660
       REM  STH / ENTRY FROM CLASSIFICATION.                            F1B11670
 STH   TSX  UNIT,4                 * GO PROCESS UNIT DESIGNATION.       F1B11680
       AXT  (STH),4                  PICKUP FIRST TSX ADDRESS.          F1B11690
       REM  HO / ENTRY FROM SPH, SCH.                                   F1B11700
 HO    TSX  OUTPUT,2               * GO PROCESS CALLING SEQUENCE.       F1B11710
       TSX     FMTDSG,1            * GO PROCESS FORMAT DESIGNATION.     F1B11720
       AXT  (FIL),4                  PICKUP FINAL TSX ADDRESS.          F1B11730
       TRA  SCAN                   * EXIT TO SCAN LIST.                 F1B11740
       REM  EXIT STH.                                                   F1B11750
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B11760
       REM                                                              F1B11770
       REM  PRINT                                                       F1B11780
       REM  SPH / ENTRY FROM CLASSIFICATION.                            F1B11790
 SPH   TSX  GIF,4                  * GO SET SYMBOLIC LOCATION.          F1B11800
       AXT  (SPH),4                  PICKUP FIRST TSX ADDRESS.          F1B11810
       TRA  HO                     * CONTINUE ABOVE.                    F1B11820
       REM  EXIT SPH.                                                   F1B11830
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B11840
       REM                                                              F1B11850
       REM  PUNCH                                                       F1B11860
       REM  SCH / ENTRY FROM CLASSIFICATION.                            F1B11870
 SCH   TSX  GIF,4                  * GO SET SYMBOLIC LOCATION.          F1B11880
       AXT  (SCH),4                  PICKUP FIRST TSX ADDRESS.          F1B11890
       TRA  HO                     * CONTINUE ABOVE.                    F1B11900
       REM  EXIT SCH.                                                   F1B11910
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B11920
       REM                                                              F1B11930
       REM  WRITE TAPE N                                                F1B11940
       REM  STB / ENTRY FROM CLASSIFICATION.                            F1B11950
 STB   TSX  UNIT,4                 * GO PROCESS UNIT DESIGNATION.       F1B11960
       AXT  (STB),4                  PICKUP FIRST TSX ADDRESS.          F1B11970
       TSX  OUTPUT,2               * GO PROCESS CALLING SEQUENCE.       F1B11980
       AXT  (WLR),4                  PICKUP FINAL TSX ADDRESS.          F1B11990
       TRA  SCAN                   * EXIT TO SCAN LIST.                 F1B12000
       REM  EXIT STB.                                                   F1B12010
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12020
       REM                                                              F1B12030
       REM  READ TAPE N                                                 F1B12040
       REM  TSB / ENTRY FROM CLASSIFICATION.                            F1B12050
 TSB   TSX  UNIT,4                 * GO PROCESS UNIT DESIGNATION.       F1B12060
       AXT  (TSB),4                  PICKUP FIRST TSX ADDRESS.          F1B12070
       TSX  INPUT,2                * GO PROCESS CALLING SEQUENCE.       F1B12080
       AXT  (RLR),4                  PICKUP FINAL TSX ADDRESS.          F1B12090
       TRA  SCAN                   * EXIT TO SCAN LIST.                 F1B12100
       REM  EXIT TSB.                                                   F1B12110
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12120
       REM                                                              F1B12130
       REM  BACKSPACE N                                                 F1B12140
       REM  BST / ENTRY FROM CLASSIFICATION.                            F1B12150
 BST   TSX  UNIT,4                 * GO PROCESS UNIT DESIGNATION.       F1B12160
       AXT  (BST),4                  PICKUP FIRST TSX ADDRESS.          F1B12170
       REM  TP / ENTRY FROM EFT,RWT.                                    F1B12180
 TP    TSX  TAPE,2                 * GO PROCESS CALLING SEQUENCE.       F1B12190
       TRA  FINI                   * EXIT TO FINISH.                    F1B12200
       REM  EXIT BST.                                                   F1B12210
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12220
       REM                                                              F1B12230
       REM  ENDFILE N                                                   F1B12240
       REM  EFT / ENTRY FROM CLASSIFICATION.                            F1B12250
 EFT   TSX  UNIT,4                 * GO PROCESS UNIT DESIGNATION.       F1B12260
       AXT  (EFT),4                  PICKUP FIRST TSX ADDRESS.          F1B12270
       TRA  TP                     * CONTINUE ABOVE.                    F1B12280
       REM  EXIT EFT.                                                   F1B12290
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12300
       REM                                                              F1B12310
       REM  REWIND N                                                    F1B12320
       REM  RWT / ENTRY FROM CLASSIFICATION.                            F1B12330
 RWT   TSX  UNIT,4                 * GO PROCESS UNIT DESIGNATION.       F1B12340
       AXT  (RWT),4                  PICKUP FIRST TSX ADDRESS.          F1B12350
       TRA  TP                     * CONTINUE ABOVE.                    F1B12360
       REM  EXIT RWT.                                                   F1B12370
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12380
       REM                                                              F1B12390
       REM  WRITE DRUM N,J                                              F1B12400
       REM  SDR / ENTRY FROM CLASSIFICATION.                            F1B12410
 SDR   TSX  UNIT,4                 * GO PROCESS UNIT DESIGNATION.       F1B12420
       AXT  (SDR),4                  PICKUP FIRST TSX ADDRESS.          F1B12430
       AXT  5,1                      PICKUP FORVAR DESIGNATION.         F1B12440
       REM  DR / ENTRY FROM DRS.                                        F1B12450
 DR    CAL  TRA                      PICKUP DRUM-SWITCH DESIGNATION.    F1B12460
       TSX  DRUM,2                 * GO PROCESS CALLING SEQUENCE.       F1B12470
       CAL  NOP                      SET DRUM SWITCH                    F1B12480
       STD  DSW                      IN UNIT.                           F1B12490
       STD     ER2002                                                   F1B12500
       TSX  UNIT,4                 * GO PROCESS DRUM ADDRESS.           F1B12510
       CAL  *-1                      RESET DRUM SWITCH                  F1B12520
       STD  DSW                      IN UNIT.                           F1B12530
       STD     ER2002                                                   F1B12540
       TSX  CIT00,4                * GO COMPILE LDA.                    F1B12550
       PZE  L(0),,L(LDA)             LOC,,OP-DEC                        F1B12560
       PZE  L(0),,L(0)               ADR,,RA-TAG                        F1B12570
       TRA  LIST                   * EXIT TO SCAN LIST.                 F1B12580
       REM  EXIT SDR.                                                   F1B12590
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12600
       REM                                                              F1B12610
       REM  READ DRUM N,J                                               F1B12620
       REM  DRS / ENTRY FROM CLASSIFICATION.                            F1B12630
 DRS   TSX  UNIT,4                 * GO PROCESS UNIT DESIGNATION.       F1B12640
       AXT  (DRS),4                  PICKUP FIRST TSX ADDRESS.          F1B12650
       AXT  6,1                      PICKUP FORVAL DESIGNATION.         F1B12660
       TRA  DR                     * CONTINUE ABOVE.                    F1B12670
       REM  EXIT DRS.                                                   F1B12680
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B12690
       REM  SCAN / ENTRY FROM TSH, STH, STB, TSB.                       F1B12700
 SCAN  SXA  END,4                    SET FINAL TSX ADDRESS.             F1B12710
       TSX  LXD,2                  * GO COMPILE LXD 6)+4,4.             F1B12720
       REM  LIST / ENTRY FROM SDR. SWITCH SET DURING BEG SCAN.          F1B12730
 LIST  NOP  ENDSW                    SWITCH (LIST / NO LIST).           F1B12740
       REM  RSC / ENTRY FROM SPC.                                       F1B12750
 RSC   TSX  JIF,4                  * JUMP IFN AND SET SYMBOLIC LOC.     F1B12760
       AXT  TLDOS,4                  RESET TEMPORARY                    F1B12770
       SXA  TLINE,4                  TABLE LINE COUNTER.                F1B12780
       STZ  DOLEV                    CLEAR DO LEVEL COUNTER.            F1B12790
       TRA     LSCP           GO TO PATCH.                             $F1B12800
       REM  LSC / ENTRY FROM SPC.                                       F1B12810
 LSC   AXT  LISTR,4                  PREPARE FOR LIST SCAN.             F1B12820
       REM  CXS / ENTRY FROM EQS, BEG.                                  F1B12830
 CXS   SXA  CEXIT,4                  SET CONTROL TRANSFER.              F1B12840
       REM  NXS / ENTRY FROM LPR, SPC, CMA.                             F1B12850
 NXS   AXT  6,2                      RESET SYMBOL CHARACTER COUNT       F1B12860
       SXD     CSJ,2                 AND SHIFT COUNT.                   F1B12870
       STZ     CHR-6          CLEAR SYMBOL BUFFER.                      F1B12880
       STZ  SYM                      CLEAR SYMBOL WORKING STORAGE.      F1B12890
       REM  NXC / ENTRY FROM CMA.                                       F1B12900
 NXC   TSX  C0190,4                * EXAMINE NEXT NON-BLANK             F1B12910
       AXT  CTEST-ENDMK,4            CHARACTER.                         F1B12920
       LAS  CTEST,4                  IF CONTROL                         F1B12930
       TRA  *+2                      PUNCTUATION, THEN                  F1B12940
 CEXIT TRA  ..,4                   * TAKE INDICATED TRANSFER.           F1B12950
       TIX  *-3,4,1                  OTHERWISE,                         F1B12960
       LXD  CSJ,4                    SAVE EACH                          F1B12970
       STO  CHR,4                    CHARACTER                          F1B12980
       TIX  *+4,4,1                  SEPARATELY,                        F1B12990
       TXL  *+2,2,36                 AND UNLESS THERE ARE               F1B13000
ER0041 TSX  DIAG,4                 * MORE THAN SIX CHARACTERS,          F1B13010
       TXI  *+2,4,-1                 ALSO                               F1B13020
       ALS  36,2                     PACK                               F1B13030
       SXD  CSJ,4                    CHARACTERS                         F1B13040
       ORS  SYM                      INTO                               F1B13050
       TXI  NXC,2,6                  ONE WORD.                          F1B13060
       REM  END SCAN.                                                   F1B13070
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B13080
       REM  LISTR/ CONTROL TRANSFERS FOR LIST SCAN =                    F1B13090
       TRA  EMK                    * ENDMARK                            F1B13100
       TRA  LPR                    * (                                  F1B13110
       TRA  CMA                    * ,                                  F1B13120
       TRA  RPR                    * )                                  F1B13130
       TRA     EQSP                * = (TEST FOR LEGALITY).            $F1B13140
       TRA  *+4                      - (ILLEGAL CHARACTER IN I/O LIST). F1B13150
       TRA  *+3                      / (ILLEGAL CHARACTER IN I/O LIST). F1B13160
       TRA  *+2                      . (ILLEGAL CHARACTER IN I/O LIST). F1B13170
       TRA  *+1                      + (ILLEGAL CHARACTER IN I/O LIST). F1B13180
ER0042 TSX  DIAG,4                 * * (ILLEGAL CHARACTER IN I/O LIST). F1B13190
 LISTR BSS  0                        INDEXING ADDRESS FOR ABOVE LIST.   F1B13200
       REM  END LISTR.                                                  F1B13210
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B13220
       REM  LPR / ENTRY FROM LIST SCAN ON LEFT PARENTHESIS.             F1B13230
 LPR   CAL  SYM                      TEST FOR SUBSCRIPT OR DO NEST.     F1B13240
       TZE  LPRDO                    IF SUBSCRIPT, THEN                 F1B13250
       TSX  TYP,4                  * IF VARIABLE SYMBOL CONTAINS LESS   F1B13260
       TRA  *+2                      THAN 6 CHARACTERS, ADD A BLANK.    F1B13270
ER0043 TSX  DIAG,4                 * ON CONSTANT RETURN, GO TO DIAG.    F1B13280
       CAL  SYM                      MOVE SYMBOL                        F1B13290
       SLW  E+2                      FOR SUBSCRIPT PROCESSOR.           F1B13300
       SLW  SA                       SET SYMBOLIC ADDRESS.              F1B13310
       TSX  SS000,4                * GO SCAN AND PROCESS SUBSCRIPT.     F1B13320
       TSX  RA000,4                * GO COMPUTE RELATIVE ADDRESS.       F1B13330
LPR1   TSX  C0190,4                * EXAMINE NEXT NON-BLANK CHARACTER.  F1B13340
       CAS  CLOS                     AND IF IT IS                       F1B13350
       TRA  *+2                      EITHER A COMMA,                    F1B13360
       TRA     RPR                 * OR AN ENDMARK,                    $F1B13370
       TSX  TESTA0,4               * THEN                               F1B13380
       TRA  CMA2                   * EXIT TO CMA.                       F1B13390
       PZE                           (NOT USED)                        $F1B13400
       PZE                           (NOT USED)                        $F1B13410
       PZE                           (NOT USED)                        $F1B13420
       REM     EQSP / TEST WHETHER = LEGAL IN THIS CONTEXT.            $F1B13430
 EQSP  LXA     DOLEV,4               USE OF = IS ILLEGAL IF NO LIST    $F1B13440
       TXL     ER0063,4,0            ELEMENT HAS BEEN COLLECTED SINCE  $F1B13450
       TRA     EQS                 * LAST LEFT PARENTHESIS.            $F1B13460
       PZE                           (NOT USED)                        $F1B13465
       REM  LPRDO / PROCESS DO NEST.                                    F1B13470
 LPRDO CAL  DOLEV                    IF DOLEV                           F1B13480
       TZE  *+4                      IS NOT ZERO, THEN                  F1B13490
       ZET  SL                       TEST FOR NULL DO.                  F1B13500
       TSX  BSS,2                  * COMPILE BSS TO ESTABLISH POSITION. F1B13510
       TSX  JIF,4                  * JUMP IFN, AND SET SYMBOLIC LOC.    F1B13520
       LXD  DOLEV,4                  INCREASE THE C(DOLEV D)            F1B13530
       TXI  *+1,4,1                  BY 1, AND                          F1B13540
       PXD  ,4                       SET THE C(DOLEV A)                 F1B13550
       SLW  DOLEV                    TO ZERO.                           F1B13560
       CAL  TLINE                    NOTE AT                            F1B13570
       STA  *+5                      THIS LEVEL                         F1B13580
       STO  DOLEV,4                  THE LOCATION IN TLDO               F1B13590
       ADD  L(5)                     OF THIS DO                         F1B13600
       STA  TLINE                    AND INCREASE TLINE COUNT.          F1B13610
       CLS  TL                       MOVE -(0(IFN)0(248)) INTO THE      F1B13620
       STO  ..                       LOCATION WORD OF CURRENT TEMP DO.  F1B13630
       TSX  JIF,4                  * GO JUMP IFN, AND SET SL AND TL.    F1B13640
       LXD  DOLEV,4                  IF 3 OR FEWER LEVELS IN LIST DO,   F1B13650
       TXL  NXS,4,3                * RETURN TO LIST SCAN.               F1B13660
ER0044 TSX  DIAG,4                 * OTHERWISE, GO TO DIAGNOSTIC.       F1B13670
       REM  END LPR.                                                    F1B13680
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B13690
       REM  EQS / ENTRY FROM LIST SCAN ON EQUAL SIGN.                   F1B13700
 EQS   LXD  DOLEV,4                  TEST THE LEGALITY OF EQUAL SIGN,   F1B13710
       TXH  *+2,4,0                  AND GO TO DIAG ON THE ATTEMPT TO   F1B13720
ER0045 TSX  DIAG,4                 * SPECIFY SUBSCRIPT RANGE WITHOUT (. F1B13730
       CAL  DOLEV,4                  INITIALIZE SPECIFICATION           F1B13740
       STA  SPC2                     OF GENERATED DO                    F1B13750
       STA  SPC5                     AT CURRENT LEVEL.                  F1B13760
       ADD  L(1)                     PREPARE TO ENTER FORMULA NUMBERS   F1B13770
       STA  EQS1                     IN LOCATION WORD, SUBSCRIPT IN     F1B13780
       ADD  L(4)                     SYMBOL WORD, AND SUBSCRIPT SPECS   F1B13790
       STA  SPC3                     IN TEMPDO ENTRY.                   F1B13800
       AXT  3,4                      PREPARE TO COUNT THE               F1B13810
       SXA  NSJ,4                    NUMBER OF SPECIFICATIONS.          F1B13820
       CAL  SYM                      OBTAIN SUBSCRIPT                   F1B13830
       TXH EQS1,2,36                 FOR THIS DO, AND                   F1B13840
       PXD ,0                        STORE IN PROPER                    F1B13850
       LDQ BLANKS                    LINE OF TEMPORARY                  F1B13860
       LGL 42,2                      ..                                 F1B13870
       ORA  SYM                      LIST DO TABLE.                     F1B13880
 EQS1  SLW  ..                       (SUBSCRIPT SYMBOL WORD)            F1B13890
       PXD     ,0             CLEAR AC.                                 F1B13900
       LDQ     SYM            GET SUBSCRIPT SYMBOL.                     F1B13910
       LGL     6              SHIFT FIRST CHARACTER INTO AC.            F1B13920
       TSX     TESTFX+1,1     TEST FOR FIXED POINT BEGINNING.           F1B13930
       TRA     ER2001        *GO TO DIAGNOSTIC, NAME IS FLOATING POINT. F1B13940
       AXT  SPCTR,4                  SET CONTROL TRANSFER FOR           F1B13950
       TRA  CXS                    * SPECIFICATION SCAN.                F1B13960
       REM  EXIT EQS.                                                   F1B13970
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B13980
       REM  SPCTR / CONTROL TRANSFERS FOR SPECIFICATION SCAN =          F1B13990
ER0046 TSX  DIAG,4                 * 77(ILLEGAL IN CONTROL FOR LIST DO).F1B14000
       TRA  *+8                      ( (ILLEGAL IN CONTROL FOR LIST DO).F1B14010
       TRA  SPC1                   * ,                                  F1B14020
       TRA  SPC                    * )                                  F1B14030
       TRA  *+5                      = (ILLEGAL IN CONTROL FOR LIST DO).F1B14040
       TRA  *+4                      - (ILLEGAL IN CONTROL FOR LIST DO).F1B14050
       TRA  *+3                      / (ILLEGAL IN CONTROL FOR LIST DO).F1B14060
       TRA  *+2                      . (ILLEGAL IN CONTROL FOR LIST DO).F1B14070
       TRA  *+1                      + (ILLEGAL IN CONTROL FOR LIST DO).F1B14080
ER0047 TSX  DIAG,4                 * * (ILLEGAL IN CONTROL FOR LIST DO).F1B14090
 SPCTR BSS  0                        INDEXING ADDRESS FOR ABOVE LIST.   F1B14100
       REM  END SPCTR.                                                  F1B14110
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B14120
       REM  SPC / ENTRY FROM SPECIFICATION SCAN ON RIGHT PARENTHESIS.   F1B14130
 SPC   CAL  SPC4                     PREPARE FOR END OF SPECIFICATION.  F1B14140
       STO  SPC4                     SET SPC4 OP-SWITCH TO NOP CASE.    F1B14150
       REM  SPC1 / ENTRY FROM SPECIFICATION SCAN ON COMMA.              F1B14160
 SPC1  TSX  TYP,4                  * GO TEST TYPE OF SUBSCRIPT SPEC.    F1B14170
       TRA  *+3                      IF FIXED POINT CONSTANT,           F1B14180
 NSJ   AXT  ..,4                     PICKUP SPECIFICATION COUNT,        F1B14190
       TRA     SPC3           AND GO ENTER CONSTANT IN TABLE.           F1B14200
       LXA  NSJ,4                    OTHERWISE, PICKUP SPEC COUNT,      F1B14210
       CAL     CHR-6          TEST VARIABLE NAME FOR FIXED POINT        F1B14220
       TSX     TESTFX+1,1     BEGINNING.                                F1B14230
       TRA     ER2001               *BEGINS WITH FLOATING CHARACTER.    F1B14240
       CAL  2E17                     AND IF VARIABLE, NOTE BY           F1B14250
       ARS  3,4                      PLACING BIT IN TAG FIELD           F1B14260
 SPC2  ORS  ..                       OF TABLE ENTRY.                    F1B14270
       CAL  SYM                      PICKUP VARIABLE SYMBOL AND         F1B14280
 SPC3  SLW  ..,4                     ENTER N SUB J IN TABLE.            F1B14290
       TNX  *+5,4,1                  REDUCE J.                          F1B14300
       SXA  NSJ,4                    SAVE SPEC COUNT, AND               F1B14310
SPC4   TXL     NXS,,0                EXIT TO SCAN, IF SWITCH IS TXL.    F1B14320
       CAL  L(1)                     SET N SUB 3 = 1 IF NOT             F1B14330
       TRA  *-5                      OTHERWISE SPECIFIED.               F1B14340
       CLS  SPC4                     RESTORE SPC4 EXIT.                 F1B14350
       STO  SPC4                     (3 SPECS HAVE BEEN TREATED)        F1B14360
       LXD  EIFNO,4                  ALSO PICKUP IFN FOR BETA IN        F1B14370
       REM  SPC5 / ENTRY FROM RPR.                                      F1B14380
 SPC5  SXA  ..,4                     TEMPDO TABLE.                      F1B14390
       LXA  DOLEV,4                  IF DOLEV ADDRESS                   F1B14400
       TXL  *+4,4,0                  IS NON-ZERO,                       F1B14410
       ZET  SL                       COMPILE BSS 0                      F1B14420
       TSX  BSS,2                  * TO ESTABLISH POSITION.             F1B14430
       TSX  JIF,4                  * JUMP IFN AND SET SL AND TL.        F1B14440
       LXD  DOLEV,4                  DECREASE DOLEV D BY 1 TO           F1B14450
       TXI  *+1,4,-1                 INDICATE A TREATED LEVEL.          F1B14460
       NOP     0                        IF NOT ZERO, THEN              $F1B14470
       SXD     DOLEV,4                  ALL LEVELS ARE NOT TREATED.    $F1B14480
       TXH  LSC,4,0                * RETURN TO SCAN NEXT LEVEL.         F1B14490
       LXA  TLINE,2                  IF LEVEL IS ZERO, THEN             F1B14500
       SXA  *+3,2                    ENTER GENERATED                    F1B14510
       TXI  *+1,2,-TLDOS             DO STATEMENTS                      F1B14520
       AXT  5,4                      INTO TDO TABLE.                    F1B14530
       CAL  ..,2                     (MOVE EACH                         F1B14540
       SLW  1C+5,4                   TEMPDO TABLE ENTRY                 F1B14550
       TNX  *+2,2,1                  INTO 1C...1C+4,                    F1B14560
       TIX  *-3,4,1                  AND WHEN DONE,                     F1B14570
       LXA  1C,4                     IF THIS IS NOT                     F1B14580
       TXL  *+3,4,0                  A NULL DO STATEMENT, THEN          F1B14590
       TSX  TET00,1                * GO MAKE AN ENTRY IN TDO TABLE.)    F1B14600
       PZE  1                        WHEN THE WHOLE DO NEST             F1B14610
       TXH  *-9,2,1                  HAS BEEN ENTERED,                  F1B14620
       TRA  RSC                    * EXIT TO LIST SCAN.                 F1B14630
       REM  END SPC.                                                    F1B14640
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B14650
       REM  RPR / ENTRY FROM LIST SCAN ON RIGHT PARENTHESIS.            F1B14660
 RPR   LXD  DOLEV,4                  TEST LEGALITY OF PUNCTUATION.      F1B14670
       TXH  *+2,4,0                  IF THERE ARE TOO MANY ) IN LIST,   F1B14680
ER0048 TSX  DIAG,4                 * GO TO DIAGNOSTIC.                  F1B14690
       CAL  DOLEV,4                  NULLIFY DO NEST                    F1B14700
       STA  SPC5                     AT CURRENT LEVEL.                  F1B14710
       TXL     *+4,2,6               IF THERE WERE ANY CHARACTERS      $F1B14720
       AXT  *+3,4                    COLLECTED IN SCAN, THEN SET        F1B14730
       SXA  CMASW,4                  SWITCH IN CMA FOR RETURN,          F1B14740
       TRA  CMA1                   * AND EXIT TO CMA.                   F1B14750
       REM  *+1 / REENTRY POINT FROM CMA.                               F1B14760
       AXT  NXS,4                    RESET                              F1B14770
       SXA  CMASW,4                  CMASWITCH,                         F1B14780
       AXT  0,4                      PICKUP ZERO,                       F1B14790
       TRA  SPC5                   * AND EXIT TO SPC.                   F1B14800
       REM  END RPR.                                                    F1B14810
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B14820
       REM  CMA / ENTRY FROM LIST SCAN OF COMMA.                        F1B14830
 CMA   TXL  NXC,2,6                * RETURN TO SCAN IF NOTHING FOUND.   F1B14840
       REM  CMA1 / ENTRY FROM RPR AND EMK.                              F1B14850
 CMA1  TSX  TYP,4                  * GO TEST TYPE OF VARIABLE.          F1B14860
       TRA  *+2                      IF CONSTANT, THEN                  F1B14870
ER0049 TSX  DIAG,4                 * GO TO DIAGNOSTIC.                  F1B14880
       CAL  SYM                      MOVE SYMBOL                        F1B14890
       SLW  SA                       INTO SYMBOLIC ADDRESS. AND         F1B14900
       REM  CMA2 / ENTRY FROM LPR.                                      F1B14910
 CMA2  LXA  DOLEV,4                  INCREASE DOLEV A                   F1B14920
       TXI  *+1,4,1                  BY 1,                              F1B14930
       SXA  DOLEV,4                  AND THEN                           F1B14940
       CAL  GTAG                     SET GENERALIZED TAG.               F1B14950
       SLW  RA                       (RELATIVE ADDRESS)                 F1B14960
       TZE  *+5                      IF THIS VARIABLE HAS A SUBSCRIPT,  F1B14970
       CAL  EPS                      AND IF SUBSCRIPT                   F1B14980
       TNZ  CMASW2                   IS A CONSTANT,                     F1B14990
       SXA  RA,0                     THEN SET RELATIVE ADDRESS TO ZERO. F1B15000
       TRA  CMASW2                   THEN GO COMPILE.                   F1B15010
       CAL  SA                       IF THIS VARIABLE                   F1B15020
       SLW  E+2                      DOES NOT HAVE A SUBSCRIPT, THEN    F1B15030
       TSX  DIM1SR,4               * GO SEARCH DIM1 TABLE.              F1B15040
       TRA  *+3                      IF FOUND, THEN                     F1B15050
       CLA  ERASE1                   PICKUP 1ST DIMENSION               F1B15060
       TRA  DVS                      AND GO TEST SIZE. OTHERWISE,       F1B15070
       TSX  DIM2SR,4               * GO SEARCH DIM2 TABLE.              F1B15080
       TRA  *+8                      AND IF FOUND,                      F1B15090
       LDQ  ERASE1                   PICKUP 1ST AND 2ND DIMENSIONS      F1B15100
       STZ  N2                       AND MULTIPLY                       F1B15110
       SLQ  N2                       THEM                               F1B15120
       LGL  18                       TOGETHER.                          F1B15130
       MPY  N2                       THEN GO TEST                       F1B15140
       ARS  1                        THEIR PRODUCT. OTHERWISE,          F1B15150
       TRA  DVS                      GO SEARCH                          F1B15160
       TSX  DIM3SR,4               * DIM3 TABLE.                        F1B15170
       TRA  NODIM                    AND IF FOUND,                      F1B15180
       LDQ  ERASE1                   PICKUP                             F1B15190
       STZ  N2                       1ST DIMENSION,                     F1B15200
       SLQ  N2                       2ND DIMENSION,                     F1B15210
       LGL  18                       AND 3RD DIMENSION.                 F1B15220
       MPY  N2                       MULTIPLY                           F1B15230
       LRS  18                       THEM TOGETHER                      F1B15240
       MPY  ERASE2                   AND IF                             F1B15250
       LLS  17                       THEIR                              F1B15260
 DVS   SUB  L(1)                     PRODUCT IS                         F1B15270
       TZE  NODIM                    GREATER THAN 1, THEN               F1B15280
CMASW1 NOP  DRMIO                    CONTINUE BELOW, IF DRUM.           F1B15290
       PAX  ,4                       OTHERWISE,                         F1B15300
       TXI  *+1,4,1                  SET                                F1B15310
       SXD  RA,4                     DIMENSION ARGUMENT,                F1B15320
       AXT  (SLO),4                  AND PICKUP (SLO),                  F1B15330
 IOSW1 NOP  *+2                      OR                                 F1B15340
       AXT  (SLI),4                  (SLI),                             F1B15350
       SXA  *+4,4                    TO SET TSX ADDRESS.                F1B15360
       TSX  SXD,2                  * GO COMPILE SXD 6)+4,4.             F1B15370
       TSX  LIB,4                  * ENTER CLOSUB AND COMPILE TSX ..,4. F1B15380
       PZE  L(0),,L(TSX)             LOC,,OP-DEC                        F1B15390
       PZE  ..,,L(4)                 ADR,,RA-TAG                        F1B15400
       TSX  CIT00,4                * GO COMPILE ARRAY ARGUMENT.         F1B15410
       PZE  L(0),,L(PZE)             LOC,,OP-DEC                        F1B15420
       PZE  SA,,2E18                 ADR,,RA-TAG                        F1B15430
       TSX  CIT00,4                * GO COMPILE DIMENSION ARGUMENT.     F1B15440
       PZE  L(0),,L(PZE)             LOC,,OP-DEC                        F1B15450
       PZE  L(0),,RA                 ADR,,RA-TAG                        F1B15460
       TSX  LXD,2                  * GO COMPILE LXD 6)+4,4.             F1B15470
       TRA  RESET                    THEN GO RESET SL AND GTAG.         F1B15480
       REM  DRMIO / DRUM INPUT /OUTPUT.                                 F1B15490
 DRMIO ALS  18                       PLACE DIMENSION-1 IN               F1B15500
       STO  G                        DECREMENT OF G, AND                F1B15510
       TSX  FXCNIX,4               * GO ENTER IN FIXCON, AND GET TAG.   F1B15520
       ALS  18                       PLACE TAG IN                       F1B15530
       STD  RAT                      DECREMENT OF RAT. THEN             F1B15540
       TSX  CIT00,4                * GO COMPILE LXD 2)+..,TAG.          F1B15550
       PZE  L(0),,L(LXD)             LOC,,OP-DEC                        F1B15560
       PZE  I(,,RAT                  ADR,,RA-TAG                        F1B15570
       TSX  CIT00,4                * GO COMPILE CPY SYMBOL,TAG          F1B15580
       PZE  L(0),,L(CPY)             LOC,,OP-DEC                        F1B15590
       PZE  SA,,L(8)                 ADR,,RA-TAG                        F1B15600
       TSX  CIT00,4                * GO COMPILE TIX *-1,TAG.            F1B15610
       PZE  L(0),,L(TIX)             LOC,,OP-DEC                        F1B15620
       PZE  PROCTR,,M1T              ADR,,RA-TAG                        F1B15630
       TSX  CIT00,4                * GO COMPILE DED TAG.                F1B15640
       PZE  L(0),,L(DED)             LOC,,OP-DEC                        F1B15650
       PZE  L(0),,L(8)               ADR,,RA-TAG                        F1B15660
DRMFIN TSX  CIT00,4                * GO COMPILE CPY SYMBOL.             F1B15670
       PZE  L(0),,L(CPY)             LOC,,OP-DEC                        F1B15680
       PZE  SA,,RA                   ADR,,RA-TAG                        F1B15690
       TRA  RESET                    THEN GO RESET SL AND GTAG.         F1B15700
       REM  NODIM / FOR SUBSCRIPTED VARIABLES OR SIMPLE VARIABLES.      F1B15710
 NODIM TSX  IFFIX,1                * GO TEST TYPE OF VARIABLE,          F1B15720
       TRA  *+3                      AND IF FIXED POINT,                F1B15730
       TSX  TET00,1                * GO ENTER VARIABLE IN EITHER        F1B15740
 INOUT PZE  ..                       FORVAL OR FORVAR TABLE.            F1B15750
CMASW2 NOP  DRMFIN                   CONTINUE ABOVE IF DRUM.            F1B15760
 IOSW2 NOP  CMAO                     CONTINUE BELOW IF OUTPUT.          F1B15770
       TSX  CIT00,4                * GO COMPILE STR.                    F1B15780
       PZE  SL,,L(STR)               LOC,,OP-DEC                        F1B15790
       PZE  L(0),,L(0)               ADR,,RA-TAG                        F1B15800
       TSX  CIT00,4                * GO COMPILE STQ SYMBOL,TAG.         F1B15810
       PZE  L(0),,L(STQ)             LOC,,OP-DEC                        F1B15820
       PZE  SA,,RA                   ADR,,RA-TAG                        F1B15830
       TRA  RESET                    THEN GO RESET SL AND GTAG.         F1B15840
 CMAO  TSX  CIT00,4                * GO COMPILE LDQ SYMBOL,TAG.         F1B15850
       PZE  SL,,L(LDQ)               LOC,,OP-DEC                        F1B15860
       PZE  SA,,RA                   ADR,,RA-TAG                        F1B15870
       TSX  CIT00,4                * GO COMPILE STR.                    F1B15880
       PZE  L(0),,L(STR)             LOC,,OP-DEC                        F1B15890
       PZE  L(0),,L(0)               ADR,,RA-TAG                        F1B15900
 RESET STZ  SL                       CLEAR SYMBOLIC LOCATION.           F1B15910
       STZ  GTAG                     CLEAR GENERALIZED TAG.             F1B15920
 CMASW TRA  NXS                    * EXIT TO RPR OR SCAN.               F1B15930
       REM  END CMA.                                                    F1B15940
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B15950
       REM  EMK / ENTRY FROM LIST SCAN ON ENDMARK.                      F1B15960
 EMK   TXH  CMA1,2,6               * IF NO CHARACTERS REMAIN, THEN      F1B15970
       LXD  DOLEV,4                  CHECK PARENTHESIS COUNT, AND       F1B15980
       TXL  *+2,4,0                  IF TOO MANY LEFT PARENTHESIS,      F1B15990
ER0050 TSX  DIAG,4                 * GO TO DIAGNOSTIC.                  F1B16000
       REM  ENDSW / ENTRY FROM SCAN ON NO LIST.                         F1B16010
 ENDSW NOP  FINI                     CONTINUE BELOW IF DRUM OR NO LIST. F1B16020
       TSX  SXD,2                  * GO COMPILE SXD 6)+4,4.             F1B16030
       TSX  LIB,4                  * ENTER CLOSUB AND COMPILE TSX ..,4. F1B16040
       PZE  L(0),,L(TSX)             LOC,,OP-DEC                        F1B16050
END    PZE  ..,,L(4)                 ADR,,RA-TAG                        F1B16060
       REM  FINI / ENTRY FROM BST.                                      F1B16070
 FINI  TSX  LXD,2                  * GO COMPILE LXD 6)+4,4.             F1B16080
       CAL  NOP                      RESET SWITCH                       F1B16090
       STD  LIST                     FOR LIST SCAN.                     F1B16100
       TRA     CHSIFN              * EXIT TO REENTER PASS2.             F1B16110
       REM  END EMK.                                                    F1B16120
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B16130
       REM  BEG,4 / BEGINNING SCAN.                                     F1B16140
 BEG   SXA  CMB,4                    SAVE XR4.                          F1B16150
       AXT  BEGTR,4                  SET CONTROL TRANSFER.              F1B16160
       TRA  CXS                    * GO BEGIN SCAN.                     F1B16170
       REM  BEGTR / CONTROL TRANSFERS FOR BEGINNING SCAN =              F1B16180
       TRA  NLS                    * ENDMARK (NO LIST SCAN)             F1B16190
       TRA  *+8                      ( (ILLEGAL CHARACTER IN I/O SETUP).F1B16200
       TRA  CMB                    * ,                                  F1B16210
       TRA  *+6                      ) (ILLEGAL CHARACTER IN I/O SETUP).F1B16220
       TRA  *+5                      = (ILLEGAL CHARACTER IN I/O SETUP).F1B16230
       TRA  *+4                      - (ILLEGAL CHARACTER IN I/O SETUP).F1B16240
       TRA  *+3                      / (ILLEGAL CHARACTER IN I/O SETUP).F1B16250
       TRA  *+2                      . (ILLEGAL CHARACTER IN I/O SETUP).F1B16260
       TRA  *+1                      + (ILLEGAL CHARACTER IN I/O SETUP).F1B16270
ER0051 TSX  DIAG,4                 * * (ILLEGAL CHARACTER IN I/O SETUP).F1B16280
 BEGTR BSS  0                        INDEXING ADDRESS FOR ABOVE LIST.   F1B16290
       REM  END BEGTR.                                                  F1B16300
 NLS   CAL  TRA                      IF ENDMARK IS MET,                 F1B16310
       STD  LIST                     SET SWITCH TO SKIP LIST SCAN.      F1B16320
       REM  CMB / ENTRY FROM BEGINNING SCAN ON COMMA.                   F1B16330
 CMB   AXT  ..,4                     RESTORE XR4.                       F1B16340
       REM  TYP,4 / ENTRY FROM LPR, SPC, CMA.                           F1B16350
 TYP   CLA  CHR-6                    TEST FIRST CHARACTER               F1B16360
       SUB  12Z                      FOR VARIABLE                       F1B16370
       TMI  *+7                      OR CONSTANT.                       F1B16380
       TXH  *+5,2,36                 IF VARIABLE,                       F1B16390
       PXD  ,0                                                          F1B16400
       LDQ  BLANKS                   ADD BLANKS                         F1B16410
       LGL  42,2                     IF SYMBOL CONTAINS                 F1B16420
       ORS  SYM                      LESS THAN 6 CHARACTERS, AND        F1B16430
       TRA  1,4                    * TAKE VARIABLE EXIT TO CALLER.      F1B16440
       AXT  5,2                      IF CONSTANT,                       F1B16450
       CLA  CHR-1,2                  THEN                               F1B16460
 SBN   STO  BIN                      CONVERT                            F1B16470
 CSJ   TXL  BEX,2,..                 BCD                                F1B16480
       ALS  2                        DIGITS                             F1B16490
       ADD  BIN                      TO THEIR                           F1B16500
       ALS  1                        BINARY                             F1B16510
       STO  BIN                      EQUIVALENT.                        F1B16520
       CLA  CHR,2                    IF A NON-NUMERIC                   F1B16530
       CAS  L(9)                     CHARACTER IS MET,                  F1B16540
ER1003 TSX  DIAG,4                 * GO TO DIAGNOSTIC.                  F1B16550
       NOP                           WHEN ALL                           F1B16560
       ADD  BIN                      DIGITS HAVE BEEN                   F1B16570
       TXI  SBN,2,-1                 CONVERTED,                         F1B16580
 BEX   TRA  2,4                    * TAKE CONSTANT EXIT TO CALLER.      F1B16590
       REM  END BEG.                                                    F1B16600
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B16610
       REM  FORMAT,1 / PROCESS FORMAT DESIGNATION.                      F1B16620
FMTDSG TSX  BEG,4                  * GO SCAN FORMAT DESIGNATION.        F1B16630
       TRA     FMTVAR        IT IS A VARIABLE                           F1B16640
       TNZ     *+2           IT IS A CONSTANT                           F1B16650
ER0054 TSX     DIAG,4       * GO TO DIAGNOSTIC IF MISSING OR ZERO       F1B16660
       STA  SET                      IF                                 F1B16670
       SXA  *+3,1                    CONSTANT,                          F1B16680
       TSX  TET00,1                * GO ENTER IN                        F1B16690
       PZE  17                       FMTEFN TABLE.                      F1B16700
       AXT  ..,1                     THEN                               F1B16710
       AXT     SET,4                 PICKUP 8)..                        F1B16720
       TRA     FMTARG                AND GO COMPILE FORMAT ARGUMENT.    F1B16730
FMTVAR CAL     SYM                   IF VARIABLE,                       F1B16740
       SLW     E+2                   THEN                               F1B16750
       TSX     DIM1SR,4            * GO SEARCH                          F1B16760
       TRA     *+2                   DIMENSION                          F1B16770
       TRA     FMTARG-1              TABLES,                            F1B16780
       TSX     DIM2SR,4            * AND IF                             F1B16790
       TRA     *+2                   NO DIMENSION                       F1B16800
       TRA     FMTARG-1              HAS BEEN ASSIGNED TO               F1B16810
       TSX     DIM3SR,4            * THIS FORMAT, THEN                  F1B16820
ER0053 TSX  DIAG,4                 * GO TO DIAGNOSTIC.                  F1B16830
       AXT     SYM,4                 OTHERWISE, PICKUP VARIABLE AND     F1B16840
FMTARG SXA     FMTSA,4               SET FORMAT SYMBOLIC ADDRESS.       F1B16850
       TSX  CIT00,4                * GO COMPILE FORMAT ARGUMENT.        F1B16860
       PZE  L(0),,L(PZE)             LOC,,OP-DEC                        F1B16870
 FMTSA PZE  ..,,L(0)                 ADR,,RA-TAG                        F1B16880
       TRA  1,1                    * EXIT TO CALLER.                    F1B16890
       REM  END FORMAT.                                                 F1B16900
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B16910
       REM  IFFIX,1 / TEST VARIABLE FOR FIXED OR FLOATING POINT.        F1B16920
 IFFIX CAL  EIFNO                    PREPARE FOR                        F1B16930
       STZ  G                        FORVAR (5)                         F1B16940
       STD  G                        OR,                                F1B16950
       CAL  SYM                      FORVAL (6)                         F1B16960
       SLW  G+1                      ENTRY.                             F1B16970
       CAL  CHR-6                    PICKUP 1ST CHARACTER OF VARIABLE   F1B16980
       TRA  TESTFX+1               * AND GO TEST FOR FIXED OR FLOATING. F1B16990
       REM  END IFFIX.                                                  F1B17000
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B17010
       REM  INPUT,2 / PROCESS CALLING SEQUENCE. ENTRY FROM TSH, TSB.    F1B17020
 INPUT AXT  6,1                      PICKUP FORVAL DESIGNATION.         F1B17030
       CAL  NOP                      PICKUP I/O SWITCH DESIGNATION.     F1B17040
       TRA  *+3                      CONTINUE BELOW.                    F1B17050
       REM  OUTPUT,2 / ENTRY FROM STH, STB.                             F1B17060
OUTPUT AXT  5,1                      PICKUP FORVAR DESIGNATION.         F1B17070
       CAL  TRA                      PICKUP I/O SWITCH DESIGNATION.     F1B17080
       STD  IOSW1                    SET I/O                            F1B17090
       STD  IOSW2                    SWITCHES.                          F1B17100
       CAL  NOP                      PICKUP DRUM SWITCH DESIGNATION.    F1B17110
       REM  DRUM,2 / ENTRY FROM SDR.                                    F1B17120
 DRUM  SXA  INOUT,1                  SET FOR FORVAR/FORVAL ENTRY.       F1B17130
       STD  CMASW1                   SET                                F1B17140
       STD  CMASW2                   DRUM                               F1B17150
       STD  ENDSW                    SWITCHES.                          F1B17160
       REM  TAPE,2 / ENTRY FROM BST.                                    F1B17170
 TAPE  SXA  TYPE,4                   SET FIRST TSX ADDRESS.             F1B17180
       SXA  *+2,2                    SAVE XR2.                          F1B17190
       TSX  SXD,2                  * GO COMPILE SXD 6)+4,4.             F1B17200
       AXT  ..,2                     RESTORE XR2.                       F1B17210
       TSX  LIB,4                  * GO ENTER TYPE IN CLOSUB AND CIT.   F1B17220
       PZE  L(0),,L(TSX)             LOC,,OP-DEC                        F1B17230
TYPE   PZE  ..,,L(4)                 ADR,,RA-TAG                        F1B17240
       STZ  SL                       RESET SYMBOLIC LOCATION.           F1B17250
       TRA  1,2                    * EXIT TO CALLER.                    F1B17260
       REM  END INPUT.                                                  F1B17270
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B17280
       REM  UNIT,4 / PROCESS UNIT AND DRUM ADDRESS DESIGNATION.         F1B17290
 UNIT  SXA  UNITX,4                  SAVE XR4.                          F1B17300
       TSX  BEG,4                  * GO BEGIN SCAN.                     F1B17310
       TRA     UNITV                *VARIABLE UNIT DESIGNATION.         F1B17320
       TNZ     *+2                   IS UNIT DESIGNATION NON-ZERO.      F1B17330
ER2002 TSX     DIAG,4               *NO, EITHER ZERO OR MISSING.        F1B17340
       ALS  18                       THEN                               F1B17350
       STO  G                        MAKE                               F1B17360
       TSX  FXCNIX,4               * FIXCON ENTRY                       F1B17370
       ALS  18                       AND                                F1B17380
       STO  RA                       SET RELATIVE ADDRESS,              F1B17390
       CAL  I(                       AND SYMBOLIC ADDRESS               F1B17400
       SLW  SYM                      FOR FIXCON TABLE.                  F1B17410
       TRA     DSW                   CONTINUE BELOW.                    F1B17420
UNITV  TSX     IFFIX,1              *IF VARIABLE IS FLOATING POINT,     F1B17430
ER0055 TSX  DIAG,4                 * GO TO DIAGNOSTIC.                  F1B17440
       TSX  TET00,1                * ENTER FIXED POINT VARIABLE         F1B17450
       PZE  5                        IN FORVAR.                         F1B17460
       STZ  RA                       RESET RELATIVE ADDRESS TO ZERO.    F1B17470
 DSW   TSX  GIF,4                  * GO SET SYMBOLIC LOCATION, IF NEC.  F1B17480
       TSX  CIT00,4                * GO COMPILE CAL.                    F1B17490
       PZE  SL,,L(CAL)               LOC,,OP-DEC                        F1B17500
       PZE  SYM,,RA                  ADR,,RA-TAG                        F1B17510
       STZ  SL                       RESET SYMBOLIC LOCATION.           F1B17520
 UNITX AXT  ..,4                     RESTORE XR4.                       F1B17530
       TRA  1,4                    * EXIT TO CALLER.                    F1B17540
       REM  END UNIT.                                                   F1B17550
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B17560
       REM  I/OCON / CONSTANTS USED BY INPUT/OUTPUT TRANSLATOR =        F1B17570
IOCON  BSS 0                         I/O CONSTANTS.                     F1B17580
 (BST) BCI 1,(BST)                   I/O CONSTANT.                      F1B17590
 (CSH) BCI 1,(CSH)                   I/O CONSTANT.                      F1B17600
 (DRS) BCI 1,(DRS)                   I/O CONSTANT.                      F1B17610
 (EFT) BCI 1,(EFT)                   I/O CONSTANT.                      F1B17620
 (FIL) BCI 1,(FIL)                   I/O CONSTANT.                      F1B17630
 (RLR) BCI 1,(RLR)                   I/O CONSTANT.                      F1B17640
 (RTN) BCI 1,(RTN)                   I/O CONSTANT.                      F1B17650
 (RWT) BCI 1,(RWT)                   I/O CONSTANT.                      F1B17660
 (SCH) BCI 1,(SCH)                   I/O CONSTANT.                      F1B17670
 (SDR) BCI 1,(SDR)                   I/O CONSTANT.                      F1B17680
 (SLI) BCI 1,(SLI)                   I/O CONSTANT.                      F1B17690
 (SLO) BCI 1,(SLO)                   I/O CONSTANT.                      F1B17700
 (SPH) BCI 1,(SPH)                   I/O CONSTANT.                      F1B17710
 (STB) BCI 1,(STB)                   I/O CONSTANT.                      F1B17720
 (STH) BCI 1,(STH)                   I/O CONSTANT.                      F1B17730
 (TSB) BCI 1,(TSB)                   I/O CONSTANT.                      F1B17740
 (TSH) BCI 1,(TSH)                   I/O CONSTANT.                      F1B17750
 (WLR) BCI 1,(WLR)                   I/O CONSTANT.                      F1B17760
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B17770
       REM                                                              F1B17780
       REM  END OF I/O STATEMENT PROCESSORS.                            F1B17790
       REM                                                              F1B17800
       REM  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F1B17810
       EJECT                                                            F1B17820
       REM PASS 2/4-PROCESS ARITHMETIC FORMULAS=                        F1B17830
       REM                                                              F1B17840
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B17850
       REM                                                              F1B17860
       REM                                                              F1B17870
       REM                                                              F1B17880
       REM STATE B CONSISTS OF TWO PARTS....SCAN AND LEVEL ANALYSIS.    F1B17890
       REM THE SCAN IS LEFT TO RIGHT OVER THE SOURCE STATEMENT WHICH IS F1B17900
       REM IN THE F REGION OF COMMON AND IS IN BCD.                     F1B17910
       REM EACH FIXED POINT CONSTANT, FLOATING POINT CONSTANT, AND BCD  F1B17920
       REM ( HOLLERITH) ARGUMENT IN CALL NAME STATEMENTS ARE ENTERED IN F1B17930
       REM TABLES AND GIVEN AN INTERNAL VARIABLE NAME.                  F1B17940
       REM LEVEL ANALYSIS IS PREFORMED FOR EACH ELEMENT OF THE STATEMENTF1B17950
       REM WHERE AN ELEMENT IS DEFINED AS A VARIABLE, FUNCTION NAME OR (F1B17960
       REM AND THE OPERATOR WHICH PRECEDES IT.                          F1B17970
ARITH  SLF                   TURN ALL LITES OFF.                        F1B17980
       TRA     ARITH1         CHECK MODE                               $F1B17990
       STO SIG1IX-2                                                     F1B18000
       STZ ARGCTR            CLEAR                                      F1B18010
       STZ CHSAVE            X                                          F1B18020
       STZ 3LBAR             X                                          F1B18030
       STZ NBAR              X                                          F1B18040
       STZ CBAR              X                                          F1B18050
       STZ ABAR              X                                          F1B18060
       STZ FSTYPE            X                                          F1B18070
       LXD 1BAR,4            SET NBAR=-1                                F1B18080
       SXD NBAR,4            X                                          F1B18090
       CAL E(                SET ARERAS ' E(                            F1B18100
       SLW ARERAS            X                                          F1B18110
       TSX C0190X,4          SET FWA ' -F AND CHCTR ' 0                 F1B18120
       CAL TXHOP             SET SWITCHES FOR LEFT SCAN.                F1B18130
       STP MS093             X                                          F1B18140
       STP MS310             X                                          F1B18150
       STP MS321             X                                          F1B18160
MS010  CAL ADPLUS            SET OP TO ADDITION                         F1B18170
MS030  SLW E+1               X                                          F1B18180
       STZ FNBITS            CLEAR FUNCTION NAME INDICATOR              F1B18190
       STZ G                 CLEAR RECEIVING CELL.                      F1B18200
       CLS L(0)              SET E = -0                                 F1B18210
       STO E                 X                                          F1B18220
       LXA L(6),2            SET IR2 FOR SIX CHARS.                     F1B18230
MS040  CAL CHSAVE            CHAR IN CHSAVE, IF ANY, TO AC.             F1B18240
       TNZ MS041             X                                          F1B18250
       TSX C0190,4           CHSAVE EMPTY, GET NEXT CHAR.               F1B18260
MS041  CAS L(9)              IS CHAR. NUMERIC.                          F1B18270
       TRA MS050             N/, TAKE TRA                               F1B18280
MS4007 TXH CM4100,0,0                                                   F1B18290
       LXA MODECL,4          GET SPECIAL MODE INDICATION.               F1B18300
       TXH MS0415,4,18       TEST FOR HIGHER THAN B.                    F1B18310
       TXL MS0415,4,17       TEST FOR LOWER THAN B.                     F1B18320
NXTOCT CAS L(8)              BOOLEAN MODE, CONSTANT MUST BE OCTAL.      F1B18330
       TRA ER1005            9 IS ERROR                                 F1B18340
       TRA ER1005            8 IS ERROR                                 F1B18350
       STO CHSAVE                                                       F1B18360
       CAL G                 GET PREVIOUS OCTAL SUM.                    F1B18370
       CAS MAXIMA            TEST FOR MORE THAN 12 DIGITS.              F1B18380
OCTERR TSX DIAG,4            YES, GO TO DIAGNOSTIC                      F1B18390
       NOP                                                              F1B18400
       ALS 3                 MULTIPLY BY 8 AND                          F1B18410
       ADD CHSAVE            ADD CURRENT DIGIT.                         F1B18420
       SLW G                 SAVE RESULT.                               F1B18430
       TSX C0190,4           GET NEXT NON-BLANK CHARACTER.              F1B18440
       CAS L(9)              TEST FOR NUMERIC                           F1B18450
       TRA NOTOCT            NO, PREPARE TO ENTER IN TABLE.             F1B18460
       TRA ER1005            9 IS ERROR.                                F1B18470
       TRA NXTOCT            OCTAL, CONTINUE.                           F1B18480
NOTOCT STO CHSAVE            SAVE FOR RESUMPTION OF SCAN.               F1B18490
       TSX FLCNIX,4          ENTER CONSTANT IN FLOCON TABLE.            F1B18500
       ORA FLOVAR            PREFACE POSITION WITH FLOCON LABEL.        F1B18510
       SLW E+2                                                          F1B18520
       TRA LATXH             NOW GO TO LEVEL ANALYSIS WITH INTERNAL NAMEF1B18530
MS0415 TSX ROYCNV,4          X                                          F1B18540
       TRA HOLL              RETURN 1, THIS WAS HOLLERITH.              F1B18550
       TRA LATXH             THIS WAS FIXED OR FLOATING CONSTANT.       F1B18560
       REM                   DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B18570
MS050  CAS OPEN                   IS 1ST CHAR. (                        F1B18580
       TRA MS0501            NO                                         F1B18590
       TRA ICNV2             YES                                        F1B18600
       TRA MS0501            NO                                         F1B18610
 ICNV2 CAL MODECL            TEST FOR I IN CC ONE WHICH MEANS COMPLEX   F1B18620
       SUB L(I)              ARITHMETIC MODE. POSSIBILITY THAT WHAT     F1B18630
       TZE ICNV3             FOLLOWS IS A COMPLEX CONSTANT.             F1B18640
 ICNV6 CAL OPEN              NOT A COMPLEX CONSTANT, RESTORE  (  AND    F1B18650
MS0501 LXA TEN,4             PREPARE TO TEST FOR PUNCTUATION.           F1B18660
       REM                                                              F1B18670
MS051  CAS CTEST,4                                                      F1B18680
       TRA MS052             X                                          F1B18690
       TRA MS090             CHAR IS SOME PUNCTUATION.                  F1B18700
MS052  TIX MS051,4,1         X                                          F1B18710
MS060  ALS 36,2              POSITION CHAR FOR BUILDING SYMBOL.         F1B18720
       ORS G                 ADD CHAR TO THOSE IN G.                    F1B18730
       TXI MS061,2,6         UPDATE POSITIONING TAG.                    F1B18740
MS061  TSX C0190,4           GET NEXT CHAR.                             F1B18750
MS070  LXA TEN,4             PREPARE TO TEST FOR PUNCTUATION.           F1B18760
MS071  CAS CTEST,4           X                                          F1B18770
       TRA MS072             X                                          F1B18780
       TRA MS091             CHAR IS SOME PUNCTUATION.                  F1B18790
MS072  TIX MS071,4,1         X                                          F1B18800
       TXL MS060,2,18        IF THIS IS CHAR 1, 2 /R 3 GO BUILD G.      F1B18810
       CAS L(F)              IS THIS AN F ENDING FUNCTION NAME.         F1B18820
       TRA MS073             X                                          F1B18830
       TRA MS080             MAYBE, GO LOOK AT NEXT CHAR.               F1B18840
MS073  TXL MS060,2,36        TEST FOR UNDER 7 CHARS.                    F1B18850
MS074  TSX DIAG,4            BUILD G, 7TH CHAR IS ERROR.                F1B18860
ER0056 SYN MS074                                                        F1B18870
MS080  TSX C0190,4           GET NEXT CHAR.                             F1B18880
       CAS OPEN              TEST FOR (.                                F1B18890
       TRA MS081             X                                          F1B18900
       TRA MS092             YES, THIS IS A FUNCTION NAME.              F1B18910
MS081  STO FIRSTC            NO, SAVE CURRENT CHAR.                     F1B18920
       CAL L(F)              ADD F TO CONTENTS OF G.                    F1B18930
       ALS 36,2              X                                          F1B18940
       ORS G                 X                                          F1B18950
       TXH MS074,2,36        TEST FOR 7TH CHAR, YES IS ERROR.           F1B18960
       CLA FIRSTC            RESTORE CURRENT CHAR.                      F1B18970
       TXI MS070,2,6         UPDATE POSITIONING TAG.                    F1B18980
MS090  STZ CHSAVE            CLEAR                                      F1B18990
       TRA TRBLKA,4                                                     F1B19000
MS091  SLW CHSAVE            OP IS IN NEXT ELEMENT, SAVE.               F1B19010
       PXD ,0                                                           F1B19020
       LDQ BLANKS            COMPLETE VARIABLE NAMES LESS THAN SIX CHAR-F1B19030
       LGL 42,2              ACTERS WITH BCD BLANKS.                    F1B19040
       ORS G                 X                                          F1B19050
       LDQ G                 MOVE G TO E+2 AND TO G+1.                  F1B19060
       STQ E+2               X                                          F1B19070
       STQ G+1               X                                          F1B19080
       TRA TRBLKB,4          NOW BRANCH TO INDIVIDUAL ROUTINE           F1B19090
MS092  PXD ,0                CLEAR                                      F1B19100
       LDQ BLANKS            ADD BLANKS TO SUBROUTINE NAME IN G.        F1B19110
       LGL 42,2              X                                          F1B19120
       ORA G                 X                                          F1B19130
       SLW G                 X                                          F1B19140
       SLW E+2               MOVE FUNCTION NAME TO E+2.                 F1B19150
       STZ CHSAVE            CLEAR OUT FIRST CHAR OF FUNCTION NAME.     F1B19160
MS093  PZE     MS335,,0       TXH FOR LEFT SIDE, TXL FOR RIGHT SIDE.    F1B19170
       LXD BK,4              THIS IS ARITH FUNCTION STATEMENT.          F1B19180
       TXL *+8,4,0           TEST FOR FIRST ENTRY AND IF SO SKIP SEARCH.F1B19190
       SXD *+6,4             SET EXIT TEST FROM SEARCH LOOP.            F1B19200
       LXA L(0),2            SET FOR FORWARD SEARCH.                    F1B19210
       LAS FORSUB,2          COMPARE NAME OF CURRENT FORTRAN FUNCTION   F1B19220
       TXI *+3,2,-2          TO ALL NAMES PREVIOUSLY ENTERED IN FORSUB  F1B19230
ER0057 TSX DIAG,4            TABLE. IF FOUND THIS IS AN ERROR, GO TO    F1B19240
       TXI *+1,2,-2          DIAGNOSTIC.                                F1B19250
       TXH *-4,2,**                                                     F1B19260
       SLW FORSUB,4          ENTER FUNCTION NAME IN FORSUB TABLE.       F1B19270
       CAL EIFNO             ENTER INTERNAL FORMULA NO IN FORSUB.       F1B19280
       ANA MASK1             X                                          F1B19290
       STO FORSUB+1,4        X                                          F1B19300
       TXI FS010,4,-2        UPDATE COUNT OF ENTRIES IN FORSUB.         F1B19310
FS010  SXD BK,4              X                                          F1B19320
       TXH     FS020,4,-2*FRSBSZ   TEST FOR FORSUB OVERFLOW.            F1B19330
ER0058 TSX DIAG,4            TABLE EXCEEDED, GO TO DIAGNOSTIC ROUTINE.  F1B19340
FS020  TSX C0190,4           GET FIRST CHAR OF ARGUMENT.                F1B19350
       CAS EQUAL             TEST FOR EQUAL.                            F1B19360
       TRA FS030             X                                          F1B19370
       TRA MS322             GO MOVE FROM E, E+1, E+2 TO LEFT, LEFT+1,+2F1B19380
FS030  CAS L(9)              TEST FOR ILLEGAL ARGUMENT.                 F1B19390
       TRA FS040             LEGAL, CONTINUE                            F1B19400
MS9002 TXH CM4200,0,0                                                   F1B19410
ER0059 TSX DIAG,4            BEGINS NUMERIC, ERROR.                     F1B19420
FS040  TSX C0160,2           COLLECT ARGUMENT NAME IN 1G.               F1B19430
       TSX TESTB0,4          TEST CHAR FOLLOWING ARG FOR , OR)          F1B19440
       LXD ARGCTR,2          GET COUNT OF ARGUMENTS                     F1B19450
       LDQ 1G                ENTER ARGUMENT NAME IN ARGREG TABLE.       F1B19460
       STQ ARGREG,2          X                                          F1B19470
       TXI FS050,2,-1        UPDATE COUNT OF ARGUMENTS.                 F1B19480
FS050  SXD ARGCTR,2                                                     F1B19490
       TXH FS020,2,-RGRGSZ   TEST FOR ARGREG TABLE OVERFLOW.            F1B19500
ER0060 TSX DIAG,4            YES, ERROR.                                F1B19510
MS200  LXA MODECL,4          GET SPECIAL MODE INDICATION.               F1B19520
       TXH MS2001,4,18       TEST FOR GREATER THAN B.                   F1B19530
       TXL MS2001,4,17       TEST FOR LESS THAN B                       F1B19540
       TRA ER1005            BOOLEAN MEANS ERROR, GO TO DIAGNOSTIC.     F1B19550
MS2001 TSX DECPNT,4          CONVERT BCD NUMBER TO BINARY               F1B19560
ER0061 TSX DIAG,4            HOLLERITH RETURN, ERROR.                   F1B19570
       TRA LATXH             FLOATING POINT CONSTANT RETURN.            F1B19580
MS210  SLN 1                 TURN , LITE ON.                            F1B19590
       LXD 3LBAR,1           PREFORM LEVEL ANALYSIS FOR ,               F1B19600
       LXD ABAR,4                                                       F1B19610
       CLS ALPHA-4,4                                                    F1B19620
       STO LAMBDA,1                                                     F1B19630
       TRA     CMPCH                                                   $F1B19640
       SLW LAMBDA+1,1                                                   F1B19650
       CLA NBAR                                                         F1B19660
       ARS 18                                                           F1B19670
       STO LAMBDA+2,1                                                   F1B19680
       TXI MS211,1,-3                                                   F1B19690
MS211  SXD 3LBAR,1                                                      F1B19700
       LXD NBAR,1                                                       F1B19710
       SXD CBAR,1                                                       F1B19720
       TXI MS212,1,-1                                                   F1B19730
MS212  SXD NBAR,1                                                       F1B19740
       TXI MS213,4,3                                                    F1B19750
MS213  SXD ABAR,4                                                       F1B19760
       TRA MS010                                                        F1B19770
MS220  LXD ABAR,4            PREFORM LEVEL ANALYSIS FOR )               F1B19780
       CLA ALPHA-4,4                                                    F1B19790
       PAX ,1                                                           F1B19800
       SXD CBAR,1                                                       F1B19810
       TXI MS221,4,4                                                    F1B19820
MS221  SXD ABAR,4                                                       F1B19830
       TRA MS020                                                        F1B19840
MS230  LXD ABAR,4            PREFORM LEVEL ANALYSIS FOE ENDMK.          F1B19850
       TXI MS231,4,3                                                    F1B19860
MS231  TXL MS232,4,0         FINISHED, HAS LEVEL BEEN REDUCED TO ZERO,  F1B19870
ER0062 BSS 0                                                            F1B19880
       TSX DIAG,4            NO, ERROR.                                 F1B19890
MS232  LXD ARGCTR,4          WAS THIS AN ARITH FUNCTION STATEMENT       F1B19900
       TXL R00000,4,0                                                   F1B19910
       CAL FSTYPE            YES, UPDATE FUNCTION TYPE AND              F1B19920
       ADD L(1)              COMPLETE FORSUB ENTRY BY ASSIGNING         F1B19930
       LXD BK,1              TYPE NUMBER.                               F1B19940
       STA FORSUB-1,1        X                                          F1B19950
       ORS ARERAS            ALSO SAVE FOR LATER REFERENCE.             F1B19960
       TRA R00000                                                       F1B19970
       TRA MS230             ENDMK                                      F1B19980
       TRA MS260             (                                          F1B19990
       TRA MS210             ,                                          F1B20000
       TRA MS220             )                                          F1B20010
ER0063 BSS 0                                                            F1B20020
MSERR  TSX     DIAG,4         =                                         F1B20030
       TRA MS250             -                                          F1B20040
       TRA MS250             /                                          F1B20050
       TRA MS200             .                                          F1B20060
       TRA MS250             +                                          F1B20070
MS240  ALS 30                *   SAVE *                                 F1B20080
TRBLKA BSS 0                                                            F1B20090
       SLW E+1               X                                          F1B20100
       TRA     MS239         CHECK FOR RIGHT SIDE OF = SIGN         (29)F1B20110
       CAS STAR              IS IT *                                    F1B20120
       TRA MS041             X                                          F1B20130
       TRA MS241             YES, THIS WAS **                           F1B20140
       TRA MS041             NO, GO COMPARE TO OTHER PUNCTUATION.       F1B20150
MS241  CAL STRSTR            REPLACE * WITH **                          F1B20160
       TRA MS251             X                                          F1B20170
MS250  ALS 30                POSITION CHAR WHICH IS + OR - OR /         F1B20180
MS251  SLW E+1               PUT CURRENT OP IN E+1.                     F1B20190
       TRA     MS238         CHECK FOR RIGHT SIDE OF = SIGN         (29)F1B20200
MS260  ALS 30                ( TO SYMBOL WORD                           F1B20210
       SLW E+2               X                                          F1B20220
       TRA LATXL             GO PREFORM LEVEL ANALYSIS FOR (            F1B20230
       TRA MS300             ENDMK                                      F1B20240
       TRA MS320             (                                          F1B20250
       TRA MS300             ,                                          F1B20260
       TRA MS300             )                                          F1B20270
       TRA MS310             =                                          F1B20280
       TRA MS300             -                                          F1B20290
       TRA MS300             /                                          F1B20300
ER0064 TSX DIAG,4            .                                          F1B20310
       TRA MS300             +                                          F1B20320
MS300  PXD ,0                *   CLEAR                                  F1B20330
TRBLKB BSS 0                 BASE ADDRESS FOR TAGGED TRANSFER.          F1B20340
       LGL 6                 GET FIRST CHAR OF SYMBOL.                  F1B20350
       TSX TESTFX+1,1        TEST FOR FIXED OR FLOATING POINT.          F1B20360
       REM                   DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B20370
       TRA DP002                                                        F1B20380
       REM                                                              F1B20390
       CAL EIFNO             FIXED, PREPARE FORVAR ENTRY.               F1B20400
       ANA MASK1             X                                          F1B20410
       SLW G                 X                                          F1B20420
       TSX TET00,1           MAKE FORVAR ENTRY.                         F1B20430
           5                 X                                          F1B20440
       TRA LATXL             GO PREFORM LEVEL ANALYSIS.                 F1B20450
       REM                   DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B20460
       REM ENTER NON-SUBSCRIPTED VARIABLES ON RIGHT OF = IN DPLIST.     F1B20470
DP002  CLA MODECL                                                       F1B20480
       SUB L(D)                                                         F1B20490
       TZE MDLST2                                                       F1B20500
ITEST1 SUB L(5)                                                         F1B20510
       TNZ LATXL                                                        F1B20520
MDLST2 TSX DLIST2,4        ENTER NAME IN LIST OF DP OR I NON SUBSCRIPTE F1B20530
       TRA LATXL             VARIABLES.                                 F1B20540
       REM                                                              F1B20550
MS320  STZ CHSAVE            CLEAR CELL FOR OP.                         F1B20560
MS321  PZE     MS330,,0       TXH ON LEFT, TXL ON RIGHT OF = SIGN.      F1B20570
       TSX DIM1SR,4          THIS NAME FOLLOWED BY A  (  CANNOT BE A    F1B20580
       TRA *+2               FUNCTION REFERENCE ON THE LEFT OF  =  SIGN.F1B20590
       TRA MS321A            THEREFORE IT MUST BE A SUBSCRIPTED VARIABLEF1B20600
       TSX DIM2SR,4          AND ITS NAME MUST BE IN ONE OF THE DIMEN-  F1B20610
       TRA *+2               SION TABLES. SEARCH THESE TABLES AND IF THEF1B20620
       TRA MS321A            NAME IS NOT IN ANY ONE OF THEM CALL THE    F1B20630
       TSX DIM3SR,4          DIAGNOSTIC ROUTINE TO PRINT AN ERROR MES-  F1B20640
ER0072 TSX DIAG,4            SAGE.                                      F1B20650
MS321A TSX SS000X,4          GO PROCESS SUBSCRIPT COMBINATION.          F1B20660
       TSX C0190,4           GET NEXT CHAR.                             F1B20670
       SUB EQUAL             TEST FOR EQUAL SIGN.                       F1B20680
       TNZ     MSERR          NO, ERROR.                                F1B20690
MS322  LXA L(3),4            MOVE CONTENTS OF E WORDS TO LEFT WORDS.    F1B20700
MS323  LDQ E+3,4             X                                          F1B20710
       STQ LEFT+3,4          X                                          F1B20720
       TIX MS323,4,1         X                                          F1B20730
MS311  CAL TXLOP             SET SWITCHES FOR RIGHT SIDE SCAN.          F1B20740
       STP MS093             X                                          F1B20750
       STP MS310             X                                          F1B20760
       STP MS321             X                                          F1B20770
       SLN 1                 TURN = OR ) LITE ON.                       F1B20780
       TRA MS010             GO SCAN NEXT ELEMENT.                      F1B20790
MS310  PZE     MSERR,,0       TXH ON LEFT, TXL ON RIGHT OF = SIGN.      F1B20800
       STZ CHSAVE            CLEAR                                      F1B20810
MS325  PXD ,0                CLEAR AC.                                  F1B20820
       LGL 6                 GET FIRST CHAR OF SYMBOL.                  F1B20830
       TSX TESTFX+1,1        TEST FOR FIXED OR FLOATING POINT           F1B20840
       REM                   DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B20850
       TRA DP003                                                        F1B20860
       REM                                                              F1B20870
       CAL EIFNO             FIXED, PREPARE FORVAL ENTRY.               F1B20880
       ANA MASK1             X                                          F1B20890
       SLW G                 X                                          F1B20900
       TSX TET00,1           MAKE FORVAL ENTRY.                         F1B20910
           6                 X                                          F1B20920
       TRA MS322                                                        F1B20930
       REM                                                              F1B20940
       REM ENTER NON-SUBSCRIPTED VARIABLES ON LEFT OF = IN DPLIST.      F1B20950
DP003  CLA MODECL                                                       F1B20960
       SUB L(D)                                                         F1B20970
       TZE     *+3                                                      F1B20980
       SUB L(5)                                                         F1B20990
       TNZ MS322                                                        F1B21000
       REM                                                              F1B21010
       REM PREVENT ENTRY OF QUASI-ARITHMETIC SYMBOLS FOR IF AND CALL    F1B21020
       CLA     E+2                                                      F1B21030
       CAS     IFSYM2                                                   F1B21040
       TRA     *+2                                                      F1B21050
       TRA     MS322         IF (...) STATEMENT, DO NOT ENTER           F1B21060
       SUB     CALLSM                                                   F1B21070
       TZE     MS322         CALL NAME( ARG,...) STATEMENT, DO NOT ENTERF1B21080
MDLST3 TSX     DLIST2,4      NEITHER, ENTER VARIABLE IN DLST2           F1B21090
       TRA     MS322                                                    F1B21100
       REM                                                              F1B21110
       REM                                                              F1B21120
MS330  TSX DIM1SR,4          SEARCH FOR THIS NAME IN THE DIM1, DIM2,    F1B21130
       TRA MS331             AND DIM3 TABLES. IF IT IS FOUND IN ONE OF  F1B21140
       TRA MS333             THESE TABLES IT IS A SUBSCRIPTED VARIABLE  F1B21150
MS331  TSX DIM2SR,4          OF THAT NUMBER OF DIMENSIONS. IF IT IS NOT F1B21160
       TRA MS332             FOUND IN ANY DIMENSION TABLE THEN IT IS    F1B21170
       TRA MS333             ASSUMED TO BE THE NAME OF A FORTRAN II     F1B21180
MS332  TSX DIM3SR,4          SUBROUTINE OR FUNCTION COMPILED SEPARATELY.F1B21190
       TRA MS334             X                                          F1B21200
MS333  TSX SS000X,4          GO PROCESS SUBSCRIPT COMBINATION.          F1B21210
       TRA LATXH             GO PREFORM LEVEL ANALYSIS.                 F1B21220
MS334  CAL FNIND             NOT FOUND, TREAT AS FUNCTION NAME.         F1B21230
       SLW FNBITS            X                                          F1B21240
       TSX TET00,1           ENTER NAME IN CLOSUB TABLE.                F1B21250
           9                 X                                          F1B21260
MS335  SLN 2                 TURN FUNCTION LITE ON.                     F1B21270
       TRA LATXL             GO PREFORM LEVEL ANALYSIS.                 F1B21280
HOLL   STZ CHSAVE                    CLEAR CHSAVE                       F1B21290
       CAL HOLCNT                    GET CURRENT H(+I WORD              F1B21300
       SLW E+2                                                          F1B21310
       LXA N,2                    GET NUMBER OF CHARACTERS IN THIS ARG  F1B21320
       LXA     XCHCTR,4       GET CURRENT RESIDU CHARACTER COUNT.       F1B21330
       LDQ RESIDU                 GET CURRENT RESIDU WORD               F1B21340
C3351  LXA L(6),1                 SET TO COLLECT SIX CHARS              F1B21350
       PXD 0,0                    CLEAR AC                              F1B21360
C3352  TNX C3354,4,1              TEST FOR NO MORE CHARS IN RESIDU      F1B21370
C33525 LGL 6                      GET NEXT CHAR                         F1B21380
       SLW 1G                     STORE WORD                            F1B21390
       ANA ENDMK                  BLANK ALL EXCEPT CURRENT CHAR         F1B21400
       SUB ENDMK                  TEST FOR INTERNAL ENDMK               F1B21410
       TNZ C3353                                                        F1B21420
ER0065 TSX DIAG,4                    YES, ERROR, GO TO DIAGNOSTIC.      F1B21430
C3353  CAL 1G                     RETREIVE WORD                         F1B21440
       TNX C3358,2,1              TEST FOR ALL CHARS COLLECTED          F1B21450
       TNX C3356,1,1              TEST FOR SIX CHARS COLLECTED          F1B21460
       TRA C3352                  NOT SIX CHARS YET, CONTINUE COLLECTINGF1B21470
C3354  LXD FWA,4                  LOAD MQ WITH NEXT F REGION WORD       F1B21480
       LDQ 0,4                                                          F1B21490
       TXI C3355,4,-1             UPDATE FWA                            F1B21500
C3355  SXD FWA,4                                                        F1B21510
       LXA L(6),4                 RESET MQ CHAR COUNT TO SIX            F1B21520
       TRA C33525                 CONTINUE COLLECTING                   F1B21530
C3356  TSX C3390,1                GO TO ENTER WORD IN HOLARG TABLE      F1B21540
C3357  TXI C3351,0,**             RETURN TO CONTINUE COLLECTING         F1B21550
C3358  STQ RESIDU                 UPDATE RESIDU                         F1B21560
       SXA     XCHCTR,4              UPDATE CHARACTER COUNT.            F1B21570
       TNX C3360,1,1              TEST FOR SIX CHARS IN AC, DEC IR1     F1B21580
       LDQ BLANKS                 NOT SIX CHARS, PREPARE TO ADD BLANKS  F1B21590
C3359  LGL 6                      ADD BLANKS                            F1B21600
       TIX C3359,1,1                                                    F1B21610
C3360  TSX C3390,1                GO TO ENTER WORD IN HOLARG TABLE      F1B21620
       CAL ALL1                   GET WORD OF ONES                      F1B21630
       TSX C3390,1                GO TO ENTER WORD IN HOLARG TABLE      F1B21640
       REM     LEVEL ANALYSIS                                           F1B21650
LATXL  CAL TXLOP                                                        F1B21660
       TRA LATXL+3                                                      F1B21670
LATXH  CAL TXHOP                                                        F1B21680
       STP CM4105                                                       F1B21690
       CLA MS093             GET LEFT-RIGHT SWITCH FROM SCAN AND        F1B21700
       TMI *+2               TEST FOR LEFT SIDE OF EQUAL SIGN.          F1B21710
ER0073 TSX DIAG,4            YES IS ERROR, GO TO DIAGNOSTIC.            F1B21720
LA0000 LXA L(0),1                                                       F1B21730
       CLA E+2                                                          F1B21740
       SLT 2                 IS THIS A FUNCTION NAME                    F1B21750
       TRA LA0000+36         NO                                         F1B21760
       SLN 2                 YES - TURN F LITE BACK ON                  F1B21770
       LXD BK,4              IS FORSUB EMPTY                            F1B21780
       TXL LA0000+13,4,0     YES. GO SET FS BITS TO 0                   F1B21790
       SXD LA0000+12,4                                                  F1B21800
       CAS FORSUB,1          SEARCH FN NAME IN FORSUB                   F1B21810
       TXI LA0000+12,1,-2                                               F1B21820
       TRA LA0000+15                                                    F1B21830
       TXI LA0000+12,1,-2                                               F1B21840
       TXH LA0000+8,1,0                                                 F1B21850
       STZ FSBITS            SET FSBITS TO 0                            F1B21860
       TRA LA0000+25                                                    F1B21870
       CAL FORSUB+1,1        FN NAME IN FORSUB                          F1B21880
       ANA MASK2             EXTRACT TYPE NUMBER                        F1B21890
       LXD ARGCTR,4          IS THIS A FUNCTION STATEMENT               F1B21900
       TXL LA0000+22,4,0     NO                                         F1B21910
       CAS FSTYPE            YES - UPDATE FS TYPE                       F1B21920
       STA FSTYPE                                                       F1B21930
       TXH 0,0,0                                                        F1B21940
       ALS 7                                                            F1B21950
       ORA FSIND                                                        F1B21960
       SLW FSBITS                                                       F1B21970
       LXD 3LBAR,1           LOAD LA COUNTERS                           F1B21980
       LXD NBAR,2                                                       F1B21990
       LXD ABAR,4                                                       F1B22000
       TXL LA0003,1,0                                                   F1B22010
       TXH LA0001,1,-LAMBSZ                                             F1B22020
ER0066 TSX DIAG,4                    ERROR..LAMBDA TABLE EXCEEDED.      F1B22030
LA0001 TXH LA0002,2,-BETASZ-1                                           F1B22040
ER0067 TSX DIAG,4                    ERROR..BETA TABLE EXCEEDED         F1B22050
LA0002 TXL LA0003,4,0                                                   F1B22060
       TXH LA0003,4,-ALPHSZ                                             F1B22070
ER0068 TSX DIAG,4                    ERROR..ALPHA TABLE EXCEEDED        F1B22080
       LXD ARGCTR,4          VARIABLE OR (                              F1B22090
       TXL LA0000+13,4,0     NOT AN FS - GO SET FS BITS TO 0            F1B22100
       SXD LA0000+43,4       FUNCTION STATEMENT                         F1B22110
       CAS     ARGREG,1      SEARCH ARGUMENT (DUMMY VARIABLE) TABLE     F1B22120
       TXI LA0000+43,1,-1                                               F1B22130
       TRA MS1018                                                       F1B22140
       TXI LA0000+43,1,-1                                               F1B22150
       TXH LA0000+39,1,0                                                F1B22160
       TRA LA0000+13         NOT PRESENT - GO SET FSBITS TO 0           F1B22170
MS1018 PXD 0,1               PRESENT - STORE TYPE IN FSBITS             F1B22180
       ARS 11                                                           F1B22190
       TRA LA0000+23                                                    F1B22200
LA0003 CLA     MS9002        =CM4200 ENTRY TO COUNTER ROUTINE           F1B22210
       STA LA4320                                                       F1B22220
       PXD 0,0                                                          F1B22230
       LDQ     E+2           INITIALIZE ALL POSSIBLE OPERAND APPEARANCESF1B22240
       STQ LAMBDA+11,1                                                  F1B22250
       STQ LAMBDA+8,1                                                   F1B22260
       STQ LAMBDA+5,1                                                   F1B22270
       LGL 6                                                            F1B22280
       STO FIRSTC                                                       F1B22290
       SUB OPEN                                                         F1B22300
       TZE LA003                                                        F1B22310
       CLA MS4007                                                       F1B22320
       SLT     2             FUNCTION LITE                              F1B22330
       TRA LA002                                                        F1B22340
       SLN 2                                                            F1B22350
       CLA FINI03                                                       F1B22360
LA002  STA LA4320                                                       F1B22370
LA003  CLA E                                                            F1B22380
       STO LAMBDA+9,1                                                   F1B22390
       STO LAMBDA+6,1                                                   F1B22400
       STO LAMBDA+3,1                                                   F1B22410
       CAL ADSPOP                                                       F1B22420
       SLW LAMBDA+13,1                                                  F1B22430
       SLW LAMBDA+10,1                                                  F1B22440
       SLW LAMBDA+7,1                                                   F1B22450
       PXD ,0                                                           F1B22460
       LDQ     E+1           OP CODE                                    F1B22470
       STQ LAMBDA+1,1                                                   F1B22480
       LGL     6             BRANCH ON OP CODE                          F1B22490
       CAS STAR                                                         F1B22500
       TRA LA0015            / SIGN                                     F1B22510
       TRA LA0010            * OR ** SIGN                               F1B22520
       SLT 2                 + OR - SIGN                                F1B22530
       TRA LA0044                                                       F1B22540
       TXI MS1033,2,-3       -N TO -(N+3)                               F1B22550
MS1033 PXD     ,2            OP IS FUNCTION                             F1B22560
       ARS 18                                                           F1B22570
       STO LAMBDA+14,1       STO  (N+3) IN LAMBDA+3 (L+4)+2             F1B22580
       TXI FINI03,2,1        -(N+3) TO - (N+2)                          F1B22590
FINI03 PXA CM4300,2                                                     F1B22600
       SSM                                                              F1B22610
       STO LAMBDA+12,1       STO -(N+2) IN LAMBDA+3 (L+4)               F1B22620
LA0041 SLT 1                                                            F1B22630
       TXI     L43130,2,1    BINARY -(N+2) TO -(N+1)                    F1B22640
       TXI     L13130,2,1    UNARY                                      F1B22650
LA0044 CLA     FIRSTC        +OR-DATA OR OPEN PAREN                     F1B22660
       CAS OPEN              EXAMINE SYMBOL                             F1B22670
       TRA LA0050                                                       F1B22680
       TXI LA0058,2,-3       -N TO -(N+3)                               F1B22690
LA0050 SLT     1              DATA                                      F1B22700
       TXI     LA4000,2,-1   BINARY -(N) TO-(N+1)                       F1B22710
       TXI     LA1000,2,-1   UNARY -(N) TO -(N+1)                       F1B22720
LA0058 PXA     ,2            +OR-OPEN PAREN                             F1B22730
       STO LAMBDA+11,1       STO S(N+3) IN LAMBDA +3(L+3)+2             F1B22740
       ADD L(1)              FORM -(N+2) IN ADD (ACC)                   F1B22750
       TXI LA0041,2,1                                                   F1B22760
LA0010 TQP LA0015            GO TO * ROUTINE                            F1B22770
       SLT 2                 **                                         F1B22780
       TRA LA0072                                                       F1B22790
       TXI L23000,2,-1       -N TO -(N+1)                               F1B22800
LA0072 CLA FIRSTC                                                       F1B22810
       SUB OPEN                                                         F1B22820
       TNZ LA2000                                                       F1B22830
       TXI L22000,2,-1       -N TO -(N+1)                               F1B22840
LA0015 SLT 2                 * OR /                                     F1B22850
       TRA LA0021                                                       F1B22860
       TXI L33000,2,-2       -N TO -(N+2)                               F1B22870
LA0021 CLA FIRSTC                                                       F1B22880
       CAS OPEN                                                         F1B22890
       TXI LA3000,2,-1                                                  F1B22900
       TXI L32000,2,-2       -N TO -N(+2)                               F1B22910
       TXI LA3000,2,-1                                                  F1B22920
L13130 SLW ALPHA+3,4         STO -(N+2) IN ALPHA+A+3                    F1B22930
       CLS L(0)                                                         F1B22940
       STO LAMBDA+9,1        STO -0 IN LAMBDA +3(L+3)                   F1B22950
       SLN 1                                                            F1B22960
LA1000 CLS     CBAR          UNARY + OR - DATA                          F1B22970
       ARS 18                                                           F1B22980
       SLW ALPHA,4           STO -C IN ALPHA+A                          F1B22990
       TXI LA1040,4,-3       -A TO - (A+3)                              F1B23000
LA1040 SXD ABAR,4                                                       F1B23010
       TRA LA4010                                                       F1B23020
L22000 PXA     ,2            ** OPEN PAREN                              F1B23030
       STO LAMBDA+5,1        STO S(N+1) IN LAMBDA+3(L+1)+2              F1B23040
       ADD L(1)                                                         F1B23050
       TXI L23130,2,1        -(N+1) TO -N                               F1B23060
L23000 PXA     ,2            ** FUNCTION                                F1B23070
       STO LAMBDA+8,1        STO S(N+1) IN LAMBDA+3(L+2)+2              F1B23080
       ADD L(1)                                                         F1B23090
       SSM                                                              F1B23100
       TXI L23090,2,1        -(N+1) TO -N                               F1B23110
L23090 STO LAMBDA+6,1        STO -N IN LAMBDA+3(L+2)                    F1B23120
L23130 SLW ALPHA,4           STO -N IN ALPHA +A                         F1B23130
       CLS L(0)                                                         F1B23140
       STO LAMBDA+3,1        STO -0 IN LAMBDA+3(L+1)                    F1B23150
       SLN 1                                                            F1B23160
LA2000 CLS     ALPHA-1,4     ** DATA                                    F1B23170
       STO LAMBDA,1                                                     F1B23180
       CLA NBAR                                                         F1B23190
       TXI LA4180,1,6                                                   F1B23200
L43130 SLW ALPHA,4           STO -(N+2) IN ALPHA+A                      F1B23210
       CLS L(0)                                                         F1B23220
       STO LAMBDA+9,1        STO -0 IN LAMBDA+3(L+3)                    F1B23230
       SLN 1                                                            F1B23240
LA4000 CLS ALPHA-3,4                                                    F1B23250
LA4010 STO LAMBDA,1          STO C(ALPHA+A-3) IN LAMBDA+3L              F1B23260
       CLS NBAR                                                         F1B23270
       ARS 18                                                           F1B23280
       SLW ALPHA-2,4         STO-N IN ALPHA+A-2                         F1B23290
       SLW LAMBDA+2,1        STO S(N) IN LAMBDA+3L+2                    F1B23300
       STO LAMBDA+3,1        STO -N IN LAMBDA+3(L+1)                    F1B23310
       PXA ,2                                                           F1B23320
       STO LAMBDA+5,1        STO S(N+1) IN LAMBDA+3(L+1)+2              F1B23330
       STO ALPHA-1,4         STO-(N+1) IN ALPHA+A-1                     F1B23340
       SSM                                                              F1B23350
       STO LAMBDA+6,1        STO -(N+1) IN LAMBDA+3(L+2)                F1B23360
       TXI LA4150,2,-1       -(N+1) TO -(N+2)                           F1B23370
LA4150 CAL ADSTAR                                                       F1B23380
       SLW LAMBDA+4,1        STO * IN LAMBDA+3(L+1)+1                   F1B23390
LA4170 PXD ,2                                                           F1B23400
LA4180 ARS 18                                                           F1B23410
       STO LAMBDA+8,1        STOS(N+2) IN LAMBDA+3(L+2)+2               F1B23420
       ORS LAMBDA+9,1        STO -(N+2) IN LAMBDA+3(L+3)                F1B23430
       CAL STRSTR                                                       F1B23440
       SLW LAMBDA+7,1        STO SPOP IN LAMBDA+3(L+2)+1                F1B23450
       CAL ADSPOP                                                       F1B23460
       ORA FSBITS                                                       F1B23470
       ORA FNBITS                                                       F1B23480
       SLW LAMBDA+10,1       STO SPOP IN LAMBDA+3(L+3)+1                F1B23490
LA4320 TXI **,1,-9                                                      F1B23500
L32000 PXA     ,2            */ OPEN PAREN                              F1B23510
       STO LAMBDA+8,1        STO 5(N+2) IN LAMBDA+3(L+2)+2              F1B23520
       ADD L(1)                                                         F1B23530
       TXI L33130,2,1        -(N+2) TO -(N+1)                           F1B23540
L33000 PXA     ,2            */ FUNCTION                                F1B23550
       STO LAMBDA+11,1       STO S(N+2) IN LAMBDA+3(L+3)+2              F1B23560
       ADD L(1)                                                         F1B23570
       SSM                                                              F1B23580
       TXI L33090,2,1        -(N+2) TO -(N+1)                           F1B23590
L33090 STO LAMBDA+9,1        STO -(N+1) IN LAMBDA+3(L+3)                F1B23600
L33130 SLW ALPHA,4           STO -(N+1) IN ALPHA+A                      F1B23610
       CLS L(0)                                                         F1B23620
       STO LAMBDA+6,1                                                   F1B23630
       SLN 1                                                            F1B23640
LA3000 CLS     ALPHA-2,4     */ DATA                                    F1B23650
       STO LAMBDA,1          STO C(ALPHA+A-2) IN LAMBDA+3L              F1B23660
       CLS NBAR                                                         F1B23670
       ARS 18                                                           F1B23680
       SLW ALPHA-1,4         STO -N IN ALPHA+A-1                        F1B23690
       SLW LAMBDA+2,1        STO S(N) IN LAMBDA+3L+2                    F1B23700
       STO LAMBDA+3,1        STO -N IN LAMBDA+3(L+1)                    F1B23710
       TXI LA4170,1,3                                                   F1B23720
CM4100 TXI CM4101,1,-3       LA COUNTER MODIFICATION ROUTINES           F1B23730
CM4101 SXD 3LBAR,1                                                      F1B23740
CM4102 SXD CBAR,2                                                       F1B23750
       TXI CM4104,2,-1                                                  F1B23760
CM4104 SXD NBAR,2                                                       F1B23770
CM4105 PZE     MS010,,0                                                 F1B23780
MS020  CAL ADSTAR                                                       F1B23790
       TRA MS030                                                        F1B23800
CM4200 TXI CM4201,1,-3                                                  F1B23810
CM4201 SXD 3LBAR,1                                                      F1B23820
       TXI CM4303,4,-1                                                  F1B23830
CM4300 TXI CM4301,1,-6                                                  F1B23840
CM4301 SXD 3LBAR,1                                                      F1B23850
       TXI CM4303,4,-1                                                  F1B23860
CM4303 SXD ABAR,4                                                       F1B23870
       TXI CM4102,2,-1                                                  F1B23880
       REM CLOSED SUBROUTINE TO MAKE ENTRIES IN HOLARG TABLE            F1B23890
C3390  SXD C3357,1                SAVE CALLING IR                       F1B23900
       SLW 1G                     MOVE WORD TO BE ENTERED TO 1G         F1B23910
       TSX TET00,1                GO TO ENTER WORD IN HOLARG TABLE      F1B23920
           13                                                           F1B23930
       CLA HOLCNT                                                       F1B23940
       ADD L(1)                   UPDATE HOLCNT                         F1B23950
       STO HOLCNT                                                       F1B23960
       LXD C3357,1                RELOAD CALLING IR                     F1B23970
       TRA 1,1                    RETURN TO CALLER+1                    F1B23980
       REM PROGRAM TO SIMPLIFY THE TREATMENT OF RELATIVE ADDRESSES IN   F1B23990
       REM SECTION ONE THRU THE USE OF THE RA000 SUBROUTINE BY STATE B. F1B24000
SS000X SXD SSIR4,4           SAVE CALLING TAG.                          F1B24010
       TSX SS000,4           GO TO SUBSCRIPT SCAN AND ANALYSIS ROUTINE. F1B24020
       TSX RA000,4           GO TO RELATIVE ADDRESS COMPUTATION ROUTINE.F1B24030
       CAL GTAG                                                         F1B24040
       ANA MASK1                                                        F1B24050
       SLW E+11                                                         F1B24060
       TSX SIG1IX,4          GO ENTER THIS RELATIVE ADDRESS IN SIGMA1.  F1B24070
       ALS 15                POSITION SIGMA TAG.                        F1B24080
       ORS E                 ADD SIGMA TAG TO I-TAU TAGS IN E.          F1B24090
       LXD SSIR4,4           RELOAD CALLING TAG.                        F1B24100
       TRA 1,4               RETURN TO CALLER +1.                       F1B24110
       REM                                                              F1B24120
       REM ROYCNV DOES FIXED AND FLOATING POINT CONVERSION FOR SECTION  F1B24130
       REM ARITHMETIC.                                                  F1B24140
       REM ROYCNV= ENTRY POINT FOR FIXED OR FLOATING POINT INTEGERS.    F1B24150
ROYCNV STO N                         SAVE DECIMAL DIGIT IN N.           F1B24160
       STZ DOE                       CLEAR DOE (IMPLICIT EXPONENT).     F1B24170
       CLA MODECL            TEST WHETHER THIS STATEMENT IS LABELED     F1B24180
       SUB L(D)              AS DOUBLE PRECISION.                       F1B24190
       TZE DPCNV1            YES, GO TO DOUBLE PRECISION CONVERSION.    F1B24200
       SXD EXIT,4                    SAVE C(XR4) FOR RETURN.            F1B24210
       CLA CM1                       PICK UP SWITCH CONTROL,            F1B24220
EXIT   TXI IN2,0,**                  AND GO SET SWITCH.                 F1B24230
       REM DECPNT= ENTRY POINT FOR FLOATING POINT FRACTIONS.            F1B24240
DECPNT STZ N                         CLEAR N (NO INTEGER).              F1B24250
       STZ DOE                       CLEAR DOE (IMPLICIT EXPONENT).     F1B24260
       CLA MODECL            TEST WHETHER THIS STATEMENT IS LABELED     F1B24270
       SUB L(D)              AS DOUBLE PRECISION.                       F1B24280
       TZE DPCNV2            YES, GO TO DOUBLE PRECISION.               F1B24290
       SXD EXIT,4                    SAVE C(XR4) FOR RETURN.            F1B24300
NC7    CAL CM1                       PICK UP SWITCH CONTROL.            F1B24310
IN2    STP CM2                       SET SWITCHES CM2, AND              F1B24320
       STP CM3                       CM3.                               F1B24330
       TOV NC5                       TURN OFF OV TRIGGER.               F1B24340
NC5    TSX C0190,4                 * GO GET NEXT NB CHARACTER IN THE AC.F1B24350
       SLW CHSAVE                    SAVE IT FOR STATE B, AND THEN      F1B24360
       CAS L(H)                      COMPARE IT WITH H.                 F1B24370
       TXI NC1,0,0                   IF H, GO TO HEXIT.                 F1B24380
SSIR4  TXI HEXIT,0,**                IF NOT H, CONTINUE                 F1B24390
NC1    CAS TEN                       AND COMPARE WITH TEN.              F1B24400
CM1    TXL NC2,0,0                   CHAR EXCEEDS 10, SO IS NON-NUMERIC.F1B24410
       PXD ,0                        CLEAR THE AC (MACHINE ERROR).      F1B24420
       STO H                         CHARACTER IS NUMERIC, SO HOLD IT.  F1B24430
       CLA N                         MULTIPLY THE PREVIOUS              F1B24440
       ALS 2                         PARTIAL RESULT (OR ZERO)           F1B24450
       ADD N                         BY 10,                             F1B24460
       ALS 1                         AND ADD IN                         F1B24470
       ADD H                         THE CURRENT DIGIT.                 F1B24480
CM2    TXH NC3,0,0                   SWITCH (NO TRANSFER IF INTEGER).   F1B24490
       TOV NC4                       TEST OVERFLOW, AND                 F1B24500
       STO N                         IF NONE, SAVE NEW PARTIAL RESULT.  F1B24510
       TXI NC5,0,0                   THEN GO PICK UP NEXT CHARACTER.    F1B24520
NC2    CAS POINT                     COMPARE NON-NUMERIC WITH A POINT.  F1B24530
       TXI CM3,0,0                   IF GREATER THAN 27, GO OUT.        F1B24540
       TXI NC7,0,0                   IF POINT, GO BACK AND SET SWITCH.  F1B24550
       CAS L(E)                      IF LESS THAN 27, COMPARE WITH E.   F1B24560
       TXI CM3,0,0                   IF GREATER THAN 21, GO OUT.        F1B24570
       TXI EC1,0,0                   IF E, GO TO EXPONENT ROUTINE.      F1B24580
CM3    TXH FN4,0,0                   SWITCH (NO TRANSFER IF INTEGER).   F1B24590
       CLA N                         PICK UP CONVERTED CONSTANT, AND    F1B24600
MS9506 ALS 18                        STORE IN THE                       F1B24610
       STO G                         DECREMENT OF G, AND                F1B24620
       TSX FXCNIX,4                * GO MAKE FIXCON ENTRY.              F1B24630
       ORA FIXVAR                    CREATE INTERNAL FXD-PT VARIABLE,ANDF1B24640
       TXI EXITR,0,0                 GO TAKE EXITR.                     F1B24650
NC3    TOV NC8                       IF THERE WAS NO OVERFLOW,          F1B24660
       STO N                         SAVE PARTIAL RESULT, AND           F1B24670
       CLS L(1)                      SUBTRACT 1 FROM DOE                F1B24680
NC9    ADD DOE                       TO ADJUST EXPONENT                 F1B24690
       STO DOE                       IN FINAL RESULT.                   F1B24700
NC8    TXI NC5,0,0                   THEN GO PICK UP NEXT CHARACTER.    F1B24710
NC4    CLA L(1)                      ADD 1 TO DOE ,                     F1B24720
       TXI NC9,0,0                   IF THERE WAS INTEGER OVERFLOW.     F1B24730
EC1    TSX C0190,4                 * GO GET NEXT NB CHARACTER IN THE AC.F1B24740
       SLW CHSAVE                    SAVE IT FOR STATE B, AND           F1B24750
       STZ EKE                       CLEAR EKE (EXPLICIT EXPONENT).     F1B24760
       CAS 11Z                       COMPARE CHARACTER WITH A DASH.     F1B24770
       TXI FN5,0,0                   IF GREATER THAN 32, GO OUT.        F1B24780
       TXI EC3,0,0                   IF A DASH, SET EKE MINUS.          F1B24790
       CAS 12Z                       IF LESS THAN 32, COMPARE WITH PLUS.F1B24800
       TXI FN5,0,0                   IF GREATER THAN 16, GO OUT.        F1B24810
       TXI EC6,0,0                   IF PLUS, GO EXAMINE NEXT CHAR.     F1B24820
       CAS MINUS                     IF LESS THAN 16,COMPARE WITH MINUS.F1B24830
       TXI FN5,0,0                   IF GREATER THAN 12, GO OUT.        F1B24840
EC3    CLS EKE                       IF MINUS, SET EKE TO -0.           F1B24850
       CAS TEN                       COMPARE WITH TEN.                  F1B24860
       TXI FN5,0,0                   IF NON-NUMERIC, GO EXAMINE NEXT CH.F1B24870
EC4    PXD ,0                        CLEAR ACC,                         F1B24880
EC5    STO EKE                       SAVE PARTIAL RESULT(OR 0) IN EKE.  F1B24890
EC6    TSX C0190,4                 * GO GET NEXT NB CHARACTER IN THE AC.F1B24900
       SLW CHSAVE                    SAVE IT FOR STATE B,               F1B24910
       CAS TEN                       AND COMPARE WITH TEN.              F1B24920
       TXI FN5,0,0                   CHAR EXCEEDS 10, SO IS NON-NUMERIC.F1B24930
       PXD ,0                        CLEAR THE AC (MACHINE ERROR).      F1B24940
       STO H                         CHARACTER IS NUMERIC, SO HOLD IT.  F1B24950
       CLA EKE                       MULTIPLY THE PREVIOUS              F1B24960
       ALS 2                         PARTIAL RESULT (OR ZERO)           F1B24970
       ADD EKE                       BY 10,                             F1B24980
       ALS 1                         AND ADD IN                         F1B24990
       ACL H                         THE CURRENT DIGIT.                 F1B25000
       TXI EC5,0,0                   CONTINUE UNTIL NON-NUMERIC IS MET. F1B25010
FN5    CLA EKE                       COMBINE EXPLICIT EXPONENT          F1B25020
       ADD DOE                       WITH IMPLICIT EXPONENT,            F1B25030
       STO DOE                       AND SAVE IN DOE.                   F1B25040
FN4    CLA N                         IF N CONTAINS ZERO, TAKE           F1B25050
       TZE MS9500                    FLO PT CONSTANT RETURN.            F1B25060
       STA K1                        PUT INTEGER INTO FLO PT WORD,      F1B25070
       ARS 15                        ADJUST, AND                        F1B25080
       TZE FN1                       IF MORE THAN 15 BITS IN LENGTH     F1B25090
       ORA K2                        AFFIX CORRECT EXPONENT.            F1B25100
FN1    FAD K1                        THEN FLOATING ADD THE RESULT       F1B25110
       RQL 8                         OF INTEGER CONVERSION, AND         F1B25120
       RND                           ROUND --TO OBTAIN                  F1B25130
       ORA K3                        NORMALIZED RESULT.                 F1B25140
       LXA DOE,1                     EXAMINE THE C(DOE), AND            F1B25150
       TXL MS9500,1,0                IF ZERO, TAKE FLO PT RETURN.       F1B25160
       TXL FN2,1,50                  IF GREATER THAN 50, THEN           F1B25170
       TXI CER,0,0                   ERROR. --GO TO DIAGNOSTIC.         F1B25180
FN2    LDQ DOE                       DETERMINE WHETHER INTEGER WAS      F1B25190
       TQP FN3                       TO THE RIGHT OR TO THE LEFT OF DP. F1B25200
       FDP TAB,1                     IF TO THE RIGHT, DIVIDE BY A       F1B25210
       STQ N                         SUITABLE CONSTANT                  F1B25220
       CLA N                         TO ADJUST RESULT                   F1B25230
       ACL K4                        AND TEST FOR OUT OF RANGE.         F1B25240
       PBT                           IF P=1, SKIP TO ARITH RETURN.      F1B25250
       TXI CER,0,0                   ERROR. --GO TO DIAGNOSTIC.         F1B25260
MS9500 STO G                         STORE IN G, AND                    F1B25270
       TSX FLCNIX,4                * GO MAKE FLOCON ENTRY.              F1B25280
       ORA FLOVAR                    CREATE INTERNAL FLO-PT VARIABLE,   F1B25290
EXITR  SLW E+2                       SAVE VARIABLE IN E+2,              F1B25300
       LXD EXIT,4                    RESTORE THE C(XR4), AND            F1B25310
       TRA 2,4                     * RETURN TO MAIN ROUTINE.            F1B25320
FN3    STO N                         IF INTEGER WAS SITUATED            F1B25330
       LDQ N                         TO THE LEFT OF THE DECIMAL POINT,  F1B25340
       FMP TAB,1                     MULTIPLY BY A SUITABLE             F1B25350
       ACL K5                        CONSTANT TO ADJUST AND TEST RANGE. F1B25360
       PBT                           IF P=1, SKIP TO ERROR.             F1B25370
       TXI MS9500,0,0                RETURN TO ARITHMETIC ROUTINE.      F1B25380
ER0069 BSS 0                                                            F1B25390
 CER   TSX DIAG,4                  * CONVERSION ERROR, GO TO DIAGNOSTIC.F1B25400
HEXIT  LXD EXIT,4                    RESTORE THE C(XR4), AND            F1B25410
       TRA 1,4                     * RETURN TO MAIN ROUTINE.            F1B25420
K1     OCT 233000000000              CONSTANT USED BY ROYCNV.           F1B25430
K2     OCT 252000000000              CONSTANT USED BY ROYCNV.           F1B25440
K3     OCT 400000000                 CONSTANT USED BY ROYCNV.           F1B25450
K4     OCT 335000000000              CONSTANT USED BY ROYCNV.           F1B25460
K5     OCT 43000000000               CONSTANT USED BY ROYCNV.           F1B25470
L(E)   BCD 100000E                   CONSTANT USED BY ROYCNV.           F1B25480
       OCT 375536246150              48-TABLE USED BY ROYCNV.           F1B25490
       OCT 372430204755              47-TABLE USED BY ROYCNV.           F1B25500
       OCT 366700324573              46-TABLE USED BY ROYCNV.           F1B25510
       OCT 363546566774              45-TABLE USED BY ROYCNV.           F1B25520
       OCT 360436770626              44-TABLE USED BY ROYCNV.           F1B25530
       OCT 354713132676              43-TABLE USED BY ROYCNV.           F1B25540
       OCT 351557257061              42-TABLE USED BY ROYCNV.           F1B25550
       OCT 346445677216              41-TABLE USED BY ROYCNV.           F1B25560
       OCT 342726145174              40-TABLE USED BY ROYCNV.           F1B25570
       OCT 337570120775              39-TABLE USED BY ROYCNV.           F1B25580
       OCT 334454732313              38-TABLE USED BY ROYCNV.           F1B25590
       OCT 330741367021              37-TABLE USED BY ROYCNV.           F1B25600
       OCT 325601137164              36-TABLE USED BY ROYCNV.           F1B25610
       OCT 322464114135              35-TABLE USED BY ROYCNV.           F1B25620
       OCT 316755023373              34-TABLE USED BY ROYCNV.           F1B25630
       OCT 313612334311              33-TABLE USED BY ROYCNV.           F1B25640
       OCT 310473426555              32-TABLE USED BY ROYCNV.           F1B25650
       OCT 304770675742              31-TABLE USED BY ROYCNV.           F1B25660
       OCT 301623713116              30-TABLE USED BY ROYCNV.           F1B25670
       OCT 276503074077              29-TABLE USED BY ROYCNV.           F1B25680
       OCT 273402374714              28-TABLE USED BY ROYCNV.           F1B25690
       OCT 267635456171              27-TABLE USED BY ROYCNV.           F1B25700
       OCT 264512676456              26-TABLE USED BY ROYCNV.           F1B25710
       OCT 261410545213              25-TABLE USED BY ROYCNV.           F1B25720
       OCT 255647410336              24-TABLE USED BY ROYCNV.           F1B25730
       OCT 252522640262              23-TABLE USED BY ROYCNV.           F1B25740
       OCT 247417031702              22-TABLE USED BY ROYCNV.           F1B25750
       OCT 243661534466              21-TABLE USED BY ROYCNV.           F1B25760
       OCT 240532743536              20-TABLE USED BY ROYCNV.           F1B25770
       OCT 235425434430              19-TABLE USED BY ROYCNV.           F1B25780
       OCT 231674055532              18-TABLE USED BY ROYCNV.           F1B25790
       OCT 226543212741              17-TABLE USED BY ROYCNV.           F1B25800
       OCT 223434157116              16-TABLE USED BY ROYCNV.           F1B25810
       OCT 217706576512              15-TABLE USED BY ROYCNV.           F1B25820
       OCT 214553630410              14-TABLE USED BY ROYCNV.           F1B25830
       OCT 211443023471              13-TABLE USED BY ROYCNV.           F1B25840
       OCT 205721522451              12-TABLE USED BY ROYCNV.           F1B25850
       OCT 202564416672              11-TABLE USED BY ROYCNV.           F1B25860
       OCT 177452013710              10-TABLE USED BY ROYCNV.           F1B25870
       OCT 173734654500              09-TABLE USED BY ROYCNV.           F1B25880
       OCT 170575360400              08-TABLE USED BY ROYCNV.           F1B25890
       OCT 165461132000              07-TABLE USED BY ROYCNV.           F1B25900
       OCT 161750220000              06-TABLE USED BY ROYCNV.           F1B25910
       OCT 156606500000              05-TABLE USED BY ROYCNV.           F1B25920
       OCT 153470400000              04-TABLE USED BY ROYCNV.           F1B25930
       OCT 147764000000              03-TABLE USED BY ROYCNV.           F1B25940
       OCT 144620000000              02-TABLE USED BY ROYCNV.           F1B25950
       OCT 141500000000              01-TABLE USED BY ROYCNV.           F1B25960
TAB    OCT 136400000000              00-TABLE USED BY ROYCNV.           F1B25970
       REM                                                              F1B25980
       REM  DOUBLE PRECISION CONSTANT CONVERSION ROUTINE                F1B25990
       REM                                                              F1B26000
DPCNV1 STZ N1                                                           F1B26010
       STZ DPWC                                                         F1B26020
       SXD DEXIT,4                SAVE C(XR4) FOR RETURN.               F1B26030
       CLA DCM1                                                         F1B26040
 DEXIT TXI DIN2,0,**              AND GO SET SWITCH.                    F1B26050
DPCNV2 STZ N1                                                           F1B26060
       STZ DPWC                                                         F1B26070
       SXD DEXIT,4                SAVE C(XR4) FOR RETURN.               F1B26080
 DNC7  CAL DCM1                   PICK UP SWITCH CONTROL.               F1B26090
 DIN2  STP DCM2                   SET SWITCHES CM2, AND                 F1B26100
       STP DCM3                   CM3.                                  F1B26110
       STP DNC11                                                        F1B26120
       TOV DNC5                   TURN OFF OV TRIGGER.                  F1B26130
DNC5   TSX C0190,4                GO GET NEXT NB CHARACTER IN THE AC.   F1B26140
       SLW CHSAVE                 SAVE IT FOR STATE B, AND THEN         F1B26150
       CAS L(H)                   COMPARE IT WITH H.                    F1B26160
       TXI DNC1,0,0               IF H, GO TO HEXIT.                    F1B26170
DSSIR4 TXI DHEXIT,0,..            IF NOT H, CONTINUE                    F1B26180
 DNC1  CAS TEN                    AND COMPARE WITH TEN.                 F1B26190
 DCM1  TXL DNC2,0,0               CHAR EXCEEDS 10,SO IS NON-NUMERIC.    F1B26200
       PXD ,0                     CLEAR THE AC (MACHINE ERROR).         F1B26210
       STO H                      CHARACTER IS NUMERIC, SO HOLD IT.     F1B26220
       CLA N                      MULTIPLY THE PREVIOUS                 F1B26230
       ALS 2                      PARTIAL RESULT (OR ZERO)              F1B26240
       ADD N                      BY 10,                                F1B26250
       ALS 1                      AND ADD IN                            F1B26260
       ADD H                      THE CURRENT DIGIT.                    F1B26270
 DCM2  TXH DNC3,0,0               SWITCH (NO TRANSFER IF INTEGER).      F1B26280
       TOV DNC4                   TEST OVERFLOW, AND                    F1B26290
       STO N                      IF NONE, SAVE NEW PARTIAL RESULT.     F1B26300
       TXI DNC5,0,0               THEN GO PICK UP NEXT CHARACTER.       F1B26310
 DNC2  CAS POINT                  COMPARE NON-NUMERIC WITH A POINT.     F1B26320
       TXI DCM3,0,0               IF GREATER THAN 27, GO OUT.           F1B26330
       TXI DNC7,0,0               IF POINT, GO BACK AND SET SWITCH.     F1B26340
       CAS L(E)                   IF LESS THAN 27,COMPARE WITH E.       F1B26350
       TXI DCM3,0,0               IF GREATER THAN 21, GO OUT.           F1B26360
       TXI DEC1,0,0               IF E, GO TO EXPONENT ROUTINE.         F1B26370
 DCM3  TXH DFN4,0,0               SWITCH (NO TRANSFER IF INTEGER).      F1B26380
       CLA N                      PICK UP CONVERTED CONSTANT, AND       F1B26390
DS9506 ALS 18                     STORE IN THE                          F1B26400
       STO G                      DECREMENT OF G, AND                   F1B26410
       TSX FXCNIX,4               *GO MAKE FIXCON ENTRY.                F1B26420
       ORA FIXVAR                 CREATE INTERNAL FXD-PT VARIABLE,AND   F1B26430
       TXI DEXITR,0,0             GO TAKE EXITR.                        F1B26440
 DNC3  TOV DNC4                   IF NO OVERFLOW                        F1B26450
       STO N                      SAVE PARTIAL RESULT, AND              F1B26460
       CLS L(1)                   SUBTRACT 1 FROM DOE                   F1B26470
 DNC9  ADD DOE                    TO ADJUST EXPONENT                    F1B26480
       STO DOE                    IN FINAL RESULT.                      F1B26490
 DNC8  TXI DNC5,0,0               THEN GO PICK UP NEXT CHARACTER.       F1B26500
 NC5D  TSX C0190,4                GET NEXT NB CHAR FOR WORD TWO         F1B26510
       SLW CHSAVE                 SAVE FOR STATE B                      F1B26520
 DNC4  CAL CHSAVE                                                       F1B26530
       CAS TEN                    COMPARE IT TO TEN                     F1B26540
       TXL NC2D,0,0               CHAR. EXCEEDS 10,NON-NUMERIC          F1B26550
       PXD 0,0                    CLEAR AC(MACHINE ERROR)               F1B26560
       STO H                      CHARACTER NUMERIC, SO HOLD IT         F1B26570
       CLA N1                     MULTIPLY PREVIOUS WORD 2              F1B26580
       ALS 2                      PARTIAL RESULT                        F1B26590
       ADD N1                     BY 10                                 F1B26600
       ALS 1                      AND ADD IN                            F1B26610
       ADD H                      THE CURRENT DIGIT                     F1B26620
 DNC11 TXH NC3D,0,0                                                     F1B26630
       TOV NC4D                   TEST OVERFLOW WORD 2,AND              F1B26640
       STO N1                     IF NONE SQVE NEW PARTIAL RESULT       F1B26650
 NC9D  CLA L(1)                   AND ADD 1 TO 2ND WORD                 F1B26660
       ADD DPWC                                                         F1B26670
       STO DPWC                                                         F1B26680
       TXI NC5D,0,0               CHARACTER.                            F1B26690
 NC2D  CAS POINT                  COMPARE NON-NUMERIC WITH POINT.       F1B26700
       TXI DCM3,0,0               IF GREATER THAN 27, GO OUT            F1B26710
       TXI NC7D,0,0               IF POINT,GO BACK AND SET SWITCH.      F1B26720
       TXI DCM3-3,0,0             IF LESS THAN 27,COMPARE WITH E.       F1B26730
 NC3D  TOV NC5D,0                 IF THERE WAS NO OVERFLOW              F1B26740
       STO N1                     SAVE PARTIAL RESULT,AND               F1B26750
       CLS L(1)                   SUBTRACT 1 FORM DOE                   F1B26760
       ADD DOE                    TO ADJUST EXPONENT                    F1B26770
       STO DOE                    IN FINAL RESULT                       F1B26780
       TXI NC9D,0,0               ADD 1 TO WC AND PICK UP NEXT CHAR     F1B26790
 NC4D  CLA L(1)                   ADD 1 TO DOE                          F1B26800
       ADD DOE                    AND                                   F1B26810
       STO DOE                    GET NEXT                              F1B26820
       TXI NC5D,0,0               CHARACTER.                            F1B26830
 NC7D  CAL DCM1                   PICK UP SWITCH CONTROL                F1B26840
       STP DCM3                   SET SWITCHES CM3,                     F1B26850
       STP DNC11                  AND NC11                              F1B26860
       TXI NC5D,0,0               GET NEXT CHAR.                        F1B26870
 DEC1  TSX C0190,4                *GO GET NEXT NB CHARACTER IN THE AC.  F1B26880
       SLW CHSAVE                 SAVE IT FOR STATE B, AND              F1B26890
       STZ EKE                    CLEAR EKE (EXPLICIT EXPONENT).        F1B26900
       CAS 11Z                    COMPARE CHARACTER WITH A DASH.        F1B26910
       TXI DFN5,0,0               IF GREATER THAN 32, GO OUT.           F1B26920
       TXI DPEC3,0,0                                                    F1B26930
       CAS 12Z                    IF LESS THAN 32, COMPARE WITH PLUS.   F1B26940
       TXI DFN5,0,0               IF GREATER THAN 16, GO OUT.           F1B26950
       TXI DEC6,0,0               IF PLUS, GO EXAMINE NEXT CHAR.        F1B26960
       CAS MINUS                  IF LESS THAN 16,COMPARE WITH MINUS.   F1B26970
       TXI DFN5,0,0               IF GREATER THAN 12, GO OUT.           F1B26980
 DPEC3 CLS EKE                                                          F1B26990
       CAS TEN                    COMPARE WITH TEN.                     F1B27000
       TXI DFN5,0,0               IF NON-NUMERIC, GO EXAMINE NEXT CH.   F1B27010
 DEC4  PXD ,0                     CLEAR ACC,                            F1B27020
 DPEC5 STO EKE                                                          F1B27030
 DEC6  TSX C0190,4                *GO GET NEXT NB CHARACTER IN THE AC.  F1B27040
       SLW CHSAVE                 SAVE IT FOR STATE B,                  F1B27050
       CAS TEN                    AND COMPARE WITH TEN.                 F1B27060
       TXI DFN5,0,0               CHAR EXCEEDS 10, SO IS NON-NUMERIC.   F1B27070
       PXD ,0                     CLEAR THE AC (MACHINE ERROR).         F1B27080
       STO H                      CHARACTER IS NUMERIC, SO HOLD IT.     F1B27090
       CLA EKE                    MULTIPLY THE PREVIOUS                 F1B27100
       ALS 2                      PARTIAL RESULT (OR ZERO)              F1B27110
       ADD EKE                    BY 10,                                F1B27120
       ALS 1                      AND ADD IN                            F1B27130
       ACL H                      THE CURRENT DIGIT.                    F1B27140
       TXI DPEC5,0,0                                                    F1B27150
 DFN5  CLA EKE                    COMBINE EXPLICIT EXPONENT             F1B27160
       ADD DOE                    WITH IMPLICIT EXPONENT,               F1B27170
       STO DOE                    AND SAVE IN DOE.                      F1B27180
 DFN4  CLA N                      IF N CONTAINS ZERO, TAKE              F1B27190
       TZE DS9500                 FLO PT CONSTANT RETURN.               F1B27200
       LXA DPWC,1                                                       F1B27210
       TXL FN90,1,10              IS WC GREATER THAN 10                 F1B27220
       PXD 0,0                    IF YES,                               F1B27230
       LDQ N1                     THEN DIVIDE N1 BY 10                  F1B27240
       DVH TAB1-1                 AND STORE                             F1B27250
       STQ N1                     BACK IN N1                            F1B27260
       CLA DOE                                                          F1B27270
       ADD L(1)                                                         F1B27280
       STO DOE                                                          F1B27290
       TXI FN90,1,-1              AND DECREASE WC BY 1 TO COMPENSATE    F1B27300
 FN90  LDQ N                                                            F1B27310
       MPY TAB1,1                                                       F1B27320
       STO TEMP1                  AND STORE MOST SIGNIFICANT PART AND   F1B27330
       STQ TEMP2                  LEAST SIGNIFICANT PART                F1B27340
       CLA TEMP2                  ADD LEAST SIG. PART WORD1             F1B27350
       ADD N1                     TO WORD 2                             F1B27360
       STO TEMP2                  AND STORE                             F1B27370
       PBT                        IF P=1,SKIP TO MODIFY MOST SIG. PART  F1B27380
       TXI FN6,0,0      OTHERWISE START CONVERSION TO FLOATING PT       F1B27390
       CLA TEMP1                  ADD 1                                 F1B27400
       ADD L(1)                   TO MOST SIG. PART                     F1B27410
       STO TEMP1                  AND STORE                             F1B27420
 FN6   CLA TEMP2                  PUT LEAST SIG. INTEGER INTO           F1B27430
       STA DK1                    FLOATING POINT WORD                   F1B27440
       ARS 15                     ADJUST,AND                            F1B27450
       TZE FN7                    IF MORE THAN 15 BITS IN LENGTH        F1B27460
       ORA DK2                    AFFIX CORRECT EXPONENT                F1B27470
 FN7   FAD DK1               THEN FLOATING ADD THE RESULT OF INT CONV.  F1B27480
       STO G+1                    AND STORE MOST SIGNIFICANT AND        F1B27490
       STQ G                      LEAST SIGNIFICANT HALVES              F1B27500
       CLA TEMP1                  PUT MOST ISG.INTEGER INTO             F1B27510
       TZE FN8                    FLOATING PT WORD(IF NON-ZERO)         F1B27520
       STA DK3                    AND                                   F1B27530
       ARS 15                     IF MORE THAN 15 BITS IN LENGTH        F1B27540
       TZE FN9                    ADJUST                                F1B27550
       ORA DK4                    AFFIX CORRECT EXPONENT                F1B27560
 FN9   FAD DK3                    THEN FLOATING ADD THE RESULT          F1B27570
       STQ TEMP2                  STORE LSH  (A2)                       F1B27580
       FAD G+1                    A1PB1 AND                             F1B27590
       STO TEMP1                  STORE MSH                             F1B27600
       STQ G+1                    AND LSH                               F1B27610
       CLA G+1                    (A1+B1)2                              F1B27620
       UFA TEMP2                  +A2                                   F1B27630
       UFA G                      +B2                                   F1B27640
       FAD TEMP1                  +(A1+B1)1                             F1B27650
       STQ G                      STORE LSH                             F1B27660
       STO G+1                    AND MSH                               F1B27670
 FN8   LXA DOE,1                  EXAMINE C(DOE)                        F1B27680
       TXL FN99,1,0               IF ZERO, MAKE FLOCON ENTRY            F1B27690
       TXL DFN2,1,55              IF GREATER THAN 55,THEN               F1B27700
       TXI DCER,0,0               ERR.--GO TO DIAGNOSTIC                F1B27710
 DFN2  LDQ DOE                    DETERMINE WHETHER INTEGER WAS         F1B27720
       TRA     PDFN2              TO PATCH                          (20)F1B27730
       CLA G+1                    IF TO THE RIGHT,DIVIDE BY             F1B27740
       FDP DTAB,1                 A SUITABLE DOUBLE PRECISION CONSTANT  F1B27750
       TOV FN54                   TEST FOR UNDERFLOW                    F1B27760
       STQ TEMP1                                                        F1B27770
       UFA G                      LSH+REMAINDER                         F1B27780
       TQO FN14                   TURN OFF UNDERFLOW                    F1B27790
 FN14  FDP DTAB,1                 /B1                                   F1B27800
       TQO FN53                   TEST FOR UNDERFLOW                    F1B27810
       STQ G+1                    STORE                                 F1B27820
       CLS DTAB+54,1              -B2                                   F1B27830
       FDP DTAB,1                 /B1                                   F1B27840
       TOV FN15                   TURN OFF UNDERFLOW                    F1B27850
 FN15  FMP TEMP1                                                        F1B27860
       TOV FN53                   TEST FOR UNDERFLOW                    F1B27870
       UFA G+1                                                          F1B27880
       TQO FN16                   TURN OFF UNDEFLOW                     F1B27890
 FN16  FAD TEMP1                  ALLIGN CHARACTERISTIC                 F1B27900
       TQO FN53                   TEST FOR UNDERFLOW                    F1B27910
 FN44  STO G+1                    STORE MSH AND                         F1B27920
       STQ G                      LSH                                   F1B27930
       TXI FN60,0,0                                                     F1B27940
 FN53  LDQ TEMP1                  UNDERFLOW                             F1B27950
 FN54  LLS 35                     CORRECTION                            F1B27960
       TOV FN55                                                         F1B27970
 FN55  TRA FN44                                                         F1B27980
 FN60  CLA G+1                    ADJUST CHARACTERISTIC                 F1B27990
       ACL DK4                    BY ADDITION OF A SUITABLE CONSTANT    F1B28000
       PBT                        IF P=1 THEN ADJUST LSH                F1B28010
       TXI DCER,0,0               ERROR                                 F1B28020
       STO G+1                    STORE MSH OF CONVERTED CONSTANT       F1B28030
       CLA G                      ADJUST LSH BY                         F1B28040
       ACL DK4                    ADDITION OF CONSTANT                  F1B28050
       PBT                        IF P=1 THEN STORE                     F1B28060
       PXD 0,0                    CLEAR AC IF LSH OUT OF RANGE          F1B28070
       STO G                      AND STORE LSH OF CONVERTED CONSTANT   F1B28080
FN99   TSX DFLCON,4                                                     F1B28090
       ORA FLOVAR                 CREATE INTERNAL FLO-PT VARIABLE.      F1B28100
DEXITR SLW E+2                    SAVE VARIABLE IN E+2                  F1B28110
       LXD DEXIT,4                RESTORE 1RY,AND                       F1B28120
       TRA 2,4                    RETURN TO MAIN ROUTINE                F1B28130
 DFN3  LDQ G+1                    A1                                    F1B28140
       FMP DTAB,1                 A1*B1                                 F1B28150
       TOV DCER,0                 IF OVERFLOW,OUT OF RANGE              F1B28160
       STO TEMP1                  STORE MSH                             F1B28170
       STQ TEMP2                  AND LSH                               F1B28180
       LDQ G+1                    A1                                    F1B28190
       FMP DTAB+54,1              A1*B2                                 F1B28200
       UFA TEMP2                  ADD (A1*B1)2                          F1B28210
       STO TEMP2                  AND STORE                             F1B28220
       LDQ DTAB,1                 B1                                    F1B28230
       FMP G                      A2*B1                                 F1B28240
       UFA TEMP2                  +PREVIOUS SUM                         F1B28250
       FAD TEMP1                                                        F1B28260
       TOV DCER,0                 ERROR IF OVERFLOW                     F1B28270
       ACL DK5                    ADD CONSTANT TO ADJUST AND TEST RANGE F1B28280
       PBT                        IF P=1,SKIP TO ERROR                  F1B28290
       TXI DS9501,0,0                                                   F1B28300
 DCER  TSX DIAG,4                 CONVERSION ERROR,GO TO DIAGNOSTIC     F1B28310
DHEXIT LXD DEXIT,4                RESTORE IR4 AND                       F1B28320
       TRA 1,4                    RETURN TO MAIN ROUTINE                F1B28330
DS9501 STO G+1                    STORE MSH OF CONVERTED CONSTANT       F1B28340
       LLS 35                     AND ADJUST LSH BY                     F1B28350
       ACL DK5                    ADDING A SUITABLE CONSTANT            F1B28360
       STO G                      STORE LSH OF CONVERTED CONSTANT       F1B28370
       TXI FN99,0,0               GO MAKE FLOCON ENTRY                  F1B28380
DS9500 STZ G+1                    CONSTANT=0                            F1B28390
       STZ G                      STORE AND                             F1B28400
       TXI FN99,0,0               ENTER INTO TABLE                      F1B28410
 N1    BSS 1                                                            F1B28420
 DPWC  BSS 1                                                            F1B28430
 TEMP1 BSS 1                                                            F1B28440
 TEMP2 BSS 1                                                            F1B28450
 DK1   OCT 233000000000                                                 F1B28460
 DK2   OCT 252000000000                                                 F1B28470
 DK3   OCT 276000000000                                                 F1B28480
 DK4   OCT 315000000000                                                 F1B28490
 DK5   OCT 63000000000                                                  F1B28500
       OCT 376413215433                                                 F1B28510
       OCT 372653510705                                                 F1B28520
       OCT 367526072235                                                 F1B28530
       OCT 364421541661                                                 F1B28540
       OCT 360665717602                                                 F1B28550
       OCT 355536246150                                                 F1B28560
       OCT 352430204754                                                 F1B28570
       OCT 346700324573                                                 F1B28580
       OCT 343546566774                                                 F1B28590
       OCT 340436770626                                                 F1B28600
       OCT 334713132675                                                 F1B28610
       OCT 331557257061                                                 F1B28620
       OCT 326445677215                                                 F1B28630
       OCT 322726145174                                                 F1B28640
       OCT 317570120775                                                 F1B28650
       OCT 314454732312                                                 F1B28660
       OCT 310741367020                                                 F1B28670
       OCT 305601137163                                                 F1B28680
       OCT 302464114134                                                 F1B28690
       OCT 276755023372                                                 F1B28700
       OCT 273612334310                                                 F1B28710
       OCT 270473426555                                                 F1B28720
       OCT 264770675742                                                 F1B28730
       OCT 261623713116                                                 F1B28740
       OCT 256503074076                                                 F1B28750
       OCT 253402374713                                                 F1B28760
       OCT 247635456171                                                 F1B28770
       OCT 244512676455                                                 F1B28780
       OCT 241410545213                                                 F1B28790
       OCT 235647410336                                                 F1B28800
       OCT 232522640261                                                 F1B28810
       OCT 227417031701                                                 F1B28820
       OCT 223661534465                                                 F1B28830
       OCT 220532743536                                                 F1B28840
       OCT 215425434430                                                 F1B28850
       OCT 211674055531                                                 F1B28860
       OCT 206543212741                                                 F1B28870
       OCT 203434157115                                                 F1B28880
       OCT 177706576511                                                 F1B28890
       OCT 174553630407                                                 F1B28900
       OCT 171443023471                                                 F1B28910
       OCT 165721522450                                                 F1B28920
       OCT 162564416672                                                 F1B28930
       OCT 157452013710                                                 F1B28940
       OCT 153734654500                                                 F1B28950
       OCT 150575360400                                                 F1B28960
       OCT 145461132000                                                 F1B28970
       OCT 141750220000                                                 F1B28980
       OCT 136606500000                                                 F1B28990
       OCT 133470400000                                                 F1B29000
       OCT 127764000000                                                 F1B29010
       OCT 124620000000                                                 F1B29020
       OCT 121500000000                                                 F1B29030
DTAB   OCT 116400000000                                                 F1B29040
       OCT 343156556174                                                 F1B29050
       OCT 337112575140                                                 F1B29060
       OCT 334556775600                                                 F1B29070
       OCT 331277144463                                                 F1B29080
       OCT 325145072436                                                 F1B29090
       OCT 322120710345                                                 F1B29100
       OCT 317732240267                                                 F1B29110
       OCT 313052063614                                                 F1B29120
       OCT 310041534474                                                 F1B29130
       OCT 305347575227                                                 F1B29140
       OCT 301414310361                                                 F1B29150
       OCT 276160240301                                                 F1B29160
       OCT 273615031715                                                 F1B29170
       OCT 267341534511                                                 F1B29180
       OCT 264116112072                                                 F1B29190
       OCT 261413241542                                                 F1B29200
       OCT 255653551066                                                 F1B29210
       OCT 252674440705                                                 F1B29220
       OCT 247543515404                                                 F1B29230
       OCT 243554174006                                                 F1B29240
       OCT 240443311470                                                 F1B29250
       OCT 235202556055                                                 F1B29260
       OCT 231004260110                                                 F1B29270
       OCT 226320214723                                                 F1B29280
       OCT 223563327102                                                 F1B29290
       OCT 220617422402                                                 F1B29300
       OCT 214177204003                                                 F1B29310
       OCT 211631003151                                                 F1B29320
       OCT 206024002441                                                 F1B29330
       OCT 202354635550                                                 F1B29340
       OCT 177760512755                                                 F1B29350
       OCT 174446725444                                                 F1B29360
       OCT 170561357240                                                 F1B29370
       OCT 165132614200                                                 F1B29380
       OCT 162110475000                                                 F1B29390
       OCT 156647310000                                                 F1B29400
       OCT 153354240000                                                 F1B29410
       OCT 150760200000                                                 F1B29420
       OCT 144432000000                                                 F1B29430
       OCT 141510000000                                                 F1B29440
       OCT 136240000000                                                 F1B29450
       OCT 132400000000                                                 F1B29460
       OCT 000000000000                                                 F1B29470
       OCT 000000000000                                                 F1B29480
       OCT 000000000000                                                 F1B29490
       OCT 000000000000                                                 F1B29500
       OCT 000000000000                                                 F1B29510
       OCT 000000000000                                                 F1B29520
       OCT 000000000000                                                 F1B29530
       OCT 000000000000                                                 F1B29540
       OCT 000000000000                                                 F1B29550
       OCT 000000000000                                                 F1B29560
       OCT 000000000000                                                 F1B29570
       OCT 000000000000                                                 F1B29580
       OCT 112402762000                                                 F1B29590
       OCT 007346545000                                                 F1B29600
       OCT 000575360400                                                 F1B29610
       OCT 000046113200                                                 F1B29620
       OCT 000003641100                                                 F1B29630
       OCT 000000303240                                                 F1B29640
       OCT 000000023420                                                 F1B29650
       OCT 000000001750                                                 F1B29660
       OCT 000000000144                                                 F1B29670
       OCT 000000000012                                                 F1B29680
 TAB1  OCT 000000000001                                                 F1B29690
       REM                                                              F1B29700
       REM  COMPLEX CONSTANT CONVERSION ROUTINE                         F1B29710
       REM                                                              F1B29720
 ICNV3 CAL FWA                    SAVE FWA                              F1B29730
       SLW IFWA                   AND                                   F1B29740
       CAL RESIDU                 RESIDU                                F1B29750
       SLW IRESDU                 AND                                   F1B29760
       CAL     XCHCTR         CHARACTER COUNT                           F1B29770
       SLW ICHCTR                                                       F1B29780
       CLA ICM1                   SET SIGN SWITCH TO ON (PLUS)          F1B29790
       STP ICM3                                                         F1B29800
       STP ICNV32                                                       F1B29810
ICNV34 STP ICNV22                                                       F1B29820
       STZ EKE                                                          F1B29830
       TSX C0190,4                                                      F1B29840
       CAS L(9)                   NB CHAR. IS CHAR. NUMERIC             F1B29850
       TXI ICNV4,0,0              N0                                    F1B29860
       TXI ICNV5,0,0              YES START CONVERSION                  F1B29870
       TXI ICNV5,0,0                                                    F1B29880
ICNV20 CAL IRESDU                                                       F1B29890
       SLW RESIDU                                                       F1B29900
       CAL ICHCTR                 AND                                   F1B29910
       SLW     XCHCTR         CHARACTER COUNT                           F1B29920
       CAL IFWA                   AND                                   F1B29930
       SLW FWA                    FWA                                   F1B29940
       TXI ICNV6,0,0                                                    F1B29950
 ICNV4 CAS POINT                  IS CHAR.FOLLOWING ( A DECIMAL POINT   F1B29960
       TXI ICNV21,0,0             NO                                    F1B29970
       TXI ICNV7,0,0              YES,EXIT TO CONVERSION ROUTINE        F1B29980
       CAS 12Z                    NO, CHECK IF CHAR. +                  F1B29990
       TXI ICNV20,0,0             NO SO RETURN TO SCAN                  F1B30000
       TXI ICNV24,0,0             YES, CHAR,IS +                        F1B30010
       TXI ICNV20,0,0             NO SO RETURN TO SCAN                  F1B30020
ICNV21 CAS 11Z                    IS CHAR. -                            F1B30030
       TXI ICNV20,0,0             NO,RET. TO SCAN                       F1B30040
       TXI ICNV23,0,0             YES, CHAR. IS -                       F1B30050
       TXI ICNV20,0,0             NO,RET. TO SCAN                       F1B30060
ICNV23 CAL ICM1                   SET SIGN SWITCH                       F1B30070
       STP ICNV22                 TO OFF (MINUS)                        F1B30080
ICNV24 TSX C0190,4                GET NEXT CHAR.                        F1B30090
       CAS L(9)                   IS CHAR. NUMERIC                      F1B30100
       TXI ICNV25,0,0             NO                                    F1B30110
       TXI ICNV5,0,0              CHAR. IS NUMERIC, START CONVERSION    F1B30120
       TXI ICNV5,0,0              DITTO                                 F1B30130
ICNV25 CAS POINT                  IS CHAR. A DEC. PT.                   F1B30140
       TXI ICNV20,0,0             NO,RETURN TO SCAN                     F1B30150
       TXI ICNV7,0,0              CHAR. IS DEC. PT.,START CONVERSION    F1B30160
       TXI ICNV20,0,0             NO, RETURN TO SCAN                    F1B30170
 ICNV5 STO N                                                            F1B30180
       STZ DOE                                                          F1B30190
       CLA ICM1                                                         F1B30200
 IEXIT TXI IIN2,0,**                                                    F1B30210
 ICNV7 STZ N                                                            F1B30220
       STZ DOE                                                          F1B30230
 INC7  CAL ICM1                                                         F1B30240
 IIN2  STP ICM2                   SET SWITCH 1                          F1B30250
       STP ICNV26                                                       F1B30260
       STP ICNV31                                                       F1B30270
       TOV INC5                                                         F1B30280
 INC5  TSX C0190,4                PICK UP NEXT CHAR.                    F1B30290
       CAS TEN                                                          F1B30300
 ICM1  TXL INC2,0,0                                                     F1B30310
       PXD 0,0                                                          F1B30320
       STO H                                                            F1B30330
       CLA N                                                            F1B30340
       ALS 2                                                            F1B30350
       ADD N                                                            F1B30360
       ALS 1                                                            F1B30370
       ADD H                                                            F1B30380
 ICM2  TXH INC3,0,0                                                     F1B30390
       TOV INC4                                                         F1B30400
       STO N                                                            F1B30410
       TXI INC5,0,0                                                     F1B30420
ICNV26 TXH ICM3,0,0               NO TRANSFER IF FIXED POINT            F1B30430
       TXI ICNV20,0,0             RETURN TO SCAN                        F1B30440
 INC2  CAS POINT                  COMPARE NON NUMERIC WITH DP           F1B30450
       TXI ICNV26,0,0                                                   F1B30460
       TXI INC7,0,0               IF POINT,GO BACK AND SET SWITCH       F1B30470
ICNV31 TXH ICNV30,0,0                                                   F1B30480
       TXI ICNV20,0,0                                                   F1B30490
ICNV30 CAS L(E)                                                         F1B30500
       TXI ICM6,0,0               IF GREATER THAN 21,ERROR              F1B30510
       TXI IEC1,0,0               IF E, GO TO EXPONENT ROUTINE          F1B30520
 ICM3  TXH ICM5,0,0               SWITCH, NO TRANSFER IF 1ST PART       F1B30530
       CAS COMMA                  IS CHAR. COMMA                        F1B30540
       TXI ICM6,0,0               IF NO, ERROR                          F1B30550
       TXI IFN5,0,0               YES, SO START CONVERSION OF REAL PART F1B30560
 ICM6  TSX DIAG,4                 TRANSFER TO DIAGNOSTIC                F1B30570
 ICM5  CAS CLOS                   IS CHAR )                             F1B30580
       TXI ICM6,0,0               NO,ERROR                              F1B30590
       TXI IFN5,0,0               YES,SO START CONVERSION OF 2ND HALF   F1B30600
       TXI ICM6,0,0               NO,ERROR                              F1B30610
 INC3  TOV INC8                                                         F1B30620
       STO N                                                            F1B30630
       CLS L(1)                                                         F1B30640
 INC9  ADD DOE                                                          F1B30650
       STO DOE                                                          F1B30660
 INC8  TXI INC5,0,0                                                     F1B30670
 INC4  CLA L(1)                                                         F1B30680
       TXI INC9,0,0                                                     F1B30690
 IEC1  TSX C0190,4                                                      F1B30700
       CAS 12Z                                                          F1B30710
       TXI ICNV36,0,0             GTR THAN PLUS(16) - MUST BE MINUS SIG F1B30720
       TXI IEC6,0,0               NUMBER READS  E+                      F1B30730
       TXI ICNV35,0,0             LESS THAN PLUS(16)-MUST BE A DIGIT.   F1B30740
ICNV36 CAS     11Z            COMPARE WITH MINUS                       $F1B30750
       TXI ICM6,0,0               ERROR                                 F1B30760
       TXI IEC3,0,0               NUMBER READS   E-                     F1B30770
       TXI ICM6,0,0               ERROR                                 F1B30780
 IEC3  CLS EKE                    SET EKE TO -0                         F1B30790
       CAS TEN                    COMPARE WITH TEN                      F1B30800
       TXI ICM6,0,0               ERROR                                 F1B30810
 IEC4  PXD 0,0                                                          F1B30820
 IEC5  STO EKE                                                          F1B30830
 IEC6  TSX C0190,4                                                      F1B30840
ICNV35 CAS TEN                    COMPARE WITH TEN                      F1B30850
       TXI ICM3,0,0               NON NUMERIC,)OR,                      F1B30860
       PXD 0,0                    CLEAR AC                              F1B30870
       STO H                      NUMERIC SO HOLD IT                    F1B30880
       CLA EKE                                                          F1B30890
       ALS 2                                                            F1B30900
       ADD EKE                                                          F1B30910
       ALS 1                                                            F1B30920
       ACL H                                                            F1B30930
       TXI IEC5,0,0                                                     F1B30940
 IFN5  CLA EKE                    COMBINE EXPLICIT EXPONENT             F1B30950
       ADD DOE                    WITH IMPLICIT EXPONENT,               F1B30960
       STO DOE                    AND SAVE IN DOE.                      F1B30970
 IFN4  CLA N                      IF N CONTAINS ZERO, TAKE              F1B30980
       TZE IMS950                 FLO PT CONSTANT RETURN.               F1B30990
       STA K1                     PUT INTEGER INTO FLO PT WORD,         F1B31000
       ARS 15                     ADJUST, AND                           F1B31010
       TZE IFN1                   IF MORE THAN 15 BITS IN LENGTH        F1B31020
       ORA K2                     AFFIX CORRECT EXPONENT.               F1B31030
 IFN1  FAD K1                     THEN FLOATING ADD THE RESULT          F1B31040
       RQL 8                      OF INTEGER CONVERSION, AND            F1B31050
       RND                        ROUND --TO OBTAIN                     F1B31060
       ORA K3                     NORMALIZED RESULT.                    F1B31070
       LXA DOE,1                  EXAMINE THE C(DOE), AND               F1B31080
       TXL IMS950,1,0             IF ZERO, TAKE FLO PT RETURN.          F1B31090
       TXL IFN2,1,50              IF GREATER THAN 50, THEN              F1B31100
       TXI ICER,0,0               ERROR. --GO TO DIAGNOSTIC.            F1B31110
 IFN2  LDQ DOE                    DETERMINE WHETHER INTEGER WAS         F1B31120
       TQP IFN3                   TO THE RIGHT OR TO THE LEFT OF DP.    F1B31130
       FDP TAB,1                  IF TO THE RIGHT, DIVIDE BY A          F1B31140
       STQ N                      SUITABLE CONSTANT                     F1B31150
       CLA N                      TO ADJUST RESULT                      F1B31160
       ACL K4                     AND TEST FOR OUT OF RANGE.            F1B31170
       PBT                        IF P=1, SKIP TO ARITH RETURN.         F1B31180
       TXI ICER,0,0               ERROR. --GO TO DIAGNOSTIC.            F1B31190
IMS950 SSM                        SET NUMBER MINUS                      F1B31200
ICNV22 TXH IMS951,0,0             SWITCH, NO TRANSFER IF PLUS           F1B31210
       SSP                        SET NUMBER PLUS                       F1B31220
IMS951 STO G                      STORE IMAGINARY PART                  F1B31230
ICNV32 TXH ICNV33,0,0             NO TRANSFER IF REAL PART              F1B31240
       STO G+1                    STORE REAL PART                       F1B31250
       CAL CM1                    SET SWITCH                            F1B31260
       STP ICM3                   ICM3AND                               F1B31270
       STP ICNV32                                                       F1B31280
       CLA ICM1                   TURN REAL-IMAG SWITCH ON (IMAG)       F1B31290
       TXI ICNV34,0,0                                                   F1B31300
ICNV33 TSX DFLCON,4               ENTER COMPLEX CONSTANT INTO TABLE     F1B31310
       ORA FLOVAR                 CREATE INTERNAL FLO-PT VARIABLE,      F1B31320
       SLW E+2                    SAVE VARIABLE IN E+2,                 F1B31330
       TSX C0190,4                SET CHSAVE TO CHARACTER               F1B31340
       SLW CHSAVE                 FOLLOWING THE CLOSING PAREN.          F1B31350
       TXI LATXH,0,0              CONVERSION COMPLETED,RETURN TO  PROG  F1B31360
 IFN3  STO N                      IF INTEGER WAS SITUATED               F1B31370
       LDQ N                      TO THE LEFT OF THE DECIMAL POINT,     F1B31380
       FMP TAB,1                  MULTIPLY BY A SUITABLE                F1B31390
       ACL K5                     CONSTANT TO ADJUST AND TEST RANGE.    F1B31400
       PBT                        IF P=1, SKIP TO ERROR.                F1B31410
       TXI IMS950,0,0             RETURN TO ARITHMETIC ROUTINE.         F1B31420
 ICER  TSX DIAG,4                 *CONVERSION ERROR, GO TO DIAGNOSTIC.  F1B31430
       TXI LATXH,0,0              CONVERSION COMPLETED,RETURN TO  PROG  F1B31440
IRESDU                                                                  F1B31450
ICHCTR                                                                  F1B31460
IFWA                                                                    F1B31470
SIG1ST PZE SIGMA1+2,,1                                                  F1B31480
       REM                                                              F1B31490
       REM STATE C  PERFORMS OPTIMIZATION ON LAMBDA TABLE.              F1B31500
R00000 LDQ L(0)              CLEAR MQ                                   F1B31510
       LXD NBAR,A            LDXA WITH -N                               F1B31520
       SXD R00700,A                                                     F1B31530
       SXD R05200,A                                                     F1B31540
       SXD AS0800,A                                                     F1B31550
       SXD AS2900,A                                                     F1B31560
       LXA L(0),7            CLEAR XA,XB,XC,                            F1B31570
R00500 STQ     BETA,B        CLEAR BETA TABLE                           F1B31580
       TXI R00700,B,-1                                                  F1B31590
R00700 TXH R00500,B,0                                                   F1B31600
       CLA     3LBAR         LENGTH OF LAMBDA                           F1B31610
       STD R01700                                                       F1B31620
       STD R06200                                                       F1B31630
R01000 CLA LAMBDA,A          ADD INTO GAMMA COUNTERS                    F1B31640
       PAX 0,B                                                          F1B31650
       CLA BETA,B                                                       F1B31660
       ADD     BETAD1        077775077775,-3 TO ADD+DEC                 F1B31670
       STD BETA,B                                                       F1B31680
       STA BETA,B                                                       F1B31690
       TXI R01700,A,-3                                                  F1B31700
R01700 TXH R01000,A,0        -3L IN XA AT END                           F1B31710
R01800 TXH R04200,A,-6       EXIT FROM SINGLE ELEMENT REDUCTION         F1B31720
       CLA LAMBDA-3,A                                                   F1B31730
       PAX 0,B                                                          F1B31740
       CLA BETA,B                                                       F1B31750
       SUB BETAD1                                                       F1B31760
       TZE R02600                                                       F1B31770
       TXI R01800,A,3                                                   F1B31780
R02600 LDQ LAMBDA-2,A        SINGLE ELEMENT                             F1B31790
       LGL 6                 EXAMINE OPERATION                          F1B31800
       SUB 11Z                                                          F1B31810
       TNZ R03200                                                       F1B31820
       TXI R01800,A,3                                                   F1B31830
R03200 CAL MASK1             SINGLE ELEMENT, NON-UNARY OP               F1B31840
       ANS LAMBDA-3,A        EXTRACT TAGS AND STORE BACK                F1B31850
       CLA LAMBDA-6,A                                                   F1B31860
       ORA LAMBDA-3,A                                                   F1B31870
       SLW LAMBDA-6,A                                                   F1B31880
       CAL LAMBDA-2,A        EXTRACT FS BITS AND STORE BACK             F1B31890
       ANA MASK5                                                        F1B31900
       ORS LAMBDA-5,A                                                   F1B31910
       CAL LAMBDA-1,A        STORE BACK SYMBOL                          F1B31920
       SLW LAMBDA-4,A                                                   F1B31930
       STZ BETA,B            REDUCE GAMMA COUNT TO 0                    F1B31940
       STZ LAMBDA-3,A        CLEAR TAG WORD                             F1B31950
       TXI R01800,A,3        RESUME SCAN-BACK                           F1B31960
R04200 STZ G                                                            F1B31970
       LXA L(0),7            CLEAR XA,XB,XC                             F1B31980
R04500 CLA BETA,B            SET ORIGINS OF SCRIPL TABLE                F1B31990
       TZE R05100                                                       F1B32000
       LDQ G                                                            F1B32010
       SLQ BETA,B                                                       F1B32020
       ADD G                                                            F1B32030
       STD G                                                            F1B32040
R05100 TXI R05200,B,-1                                                  F1B32050
R05200 TXH R04500,B,0        DEC(K)=DEC(ACC)=-3P AT END                 F1B32060
R05300 CAL LAMBDA,A          STRING BEADS... COMPRESS LAMBDA TABLE      F1B32070
       TZE R06100                                                       F1B32080
       SLW LAMBDA,C                                                     F1B32090
       CLA LAMBDA+1,A                                                   F1B32100
       STO LAMBDA+1,C                                                   F1B32110
       CLA LAMBDA+2,A                                                   F1B32120
       STO LAMBDA+2,C                                                   F1B32130
       TXI R06100,C,-3                                                  F1B32140
R06100 TXI R06200,A,-3                                                  F1B32150
R06200 TXH R05300,A,0                                                   F1B32160
       SXD R07800,C          -3P IN XC AT END                           F1B32170
       SXD CS0760,C                                                     F1B32180
       LXA L(0),A                                                       F1B32190
R06400 CLA LAMBDA,A          STORE ORDERED, REDUCED LAMBDA TABLE        F1B32200
       PAX 0,B               IN SCRIPL TABLE                            F1B32210
       CLA BETA,B                                                       F1B32220
       PDX 0,C                                                          F1B32230
       CLA LAMBDA,A                                                     F1B32240
       STO SCRIPL,C                                                     F1B32250
       CLA LAMBDA+1,A                                                   F1B32260
       STO SCRIPL+1,C                                                   F1B32270
       CLA LAMBDA+2,A                                                   F1B32280
       STO SCRIPL+2,C                                                   F1B32290
       TXI R07500,C,-3                                                  F1B32300
R07500 PXD 0,C                                                          F1B32310
       STD BETA,B                                                       F1B32320
       TXI R07800,A,-3                                                  F1B32330
R07800 TXH R06400,A,0        -3P IN XA AT END                           F1B32340
CS0000 LDQ L(0)              ELIMINATE COMMON SEGMENTS                  F1B32350
CS0010 CAL SCRIPL-3,A                                                   F1B32360
       TZE CS0080            ERASED SEGMENT - CONTINUE BACK-SCAN        F1B32370
CS0030 PAX 0,B                                                          F1B32380
       TXL CS0660,B,0        EXIT FROM CS ROUTINE                       F1B32390
       STA CS0030                                                       F1B32400
       CLA BETA,B                                                       F1B32410
CS0060 PAX 0,C                                                          F1B32420
       TXL CS0090,C,-6       AT LEAST TWO ELEMENTS                      F1B32430
CS0080 TXI CS0010,A,3        ONE ELEMENT OR ERASED SEGMENT              F1B32440
CS0090 SXD CS0470,A          SAVE XA                                    F1B32450
       SXD LENGTH,C          SAVE XC, CONTAINING LENGTH OF SEGMENT      F1B32460
CS0100 TXL CS0130,C,0        SEARCH UP FOR MATCHING SEGMENT             F1B32470
       TXI CS0120,A,3                                                   F1B32480
CS0120 TXI CS0100,C,3                                                   F1B32490
CS0130 CAL SCRIPL-3,A                                                   F1B32500
       TNZ CS0151                                                       F1B32510
       TXI CS0130,A,3        ERASED SEGMENT                             F1B32520
CS0151 PAX 0,B                                                          F1B32530
       TXL CS0610,B,0        GO ON TO NEXT SEGMENT                      F1B32540
       STA CS0060                                                       F1B32550
       CLA BETA,B                                                       F1B32560
       PAX 0,C                                                          F1B32570
       PXD 0,C                                                          F1B32580
       SUB LENGTH                                                       F1B32590
       TNZ CS0100            NOT SAME LENGTH SEGMENT-CONTINUE SEARCH    F1B32600
       LXD CS0470,B          SAME LENGTH SEGMENT                        F1B32610
       SXD CS0600,A                                                     F1B32620
CS0250 TXL CS0430,C,0        MATCHING SEGMENTS                          F1B32630
       CLA SCRIPL-1,B                                                   F1B32640
       SUB SCRIPL-1,A                                                   F1B32650
       TNZ CS0100                                                       F1B32660
       CAL SCRIPL-3,B        SYMBOLS MATCH                              F1B32670
       ANA MASK1                                                        F1B32680
       SLW G                                                            F1B32690
       CAL SCRIPL-3,A                                                   F1B32700
       ANA MASK1                                                        F1B32710
       COM                                                              F1B32720
       ACL G                                                            F1B32730
       COM                                                              F1B32740
       TNZ CS0100                                                       F1B32750
       CLA SCRIPL-2,B        TAGS MATCH                                 F1B32760
       ARS 6                                                            F1B32770
       ALS 6                                                            F1B32780
       SUB SCRIPL-2,A                                                   F1B32790
       TNZ CS0100                                                       F1B32800
       TXI CS0360,A,3        OPS MATCH                                  F1B32810
CS0360 TXI CS0370,B,3                                                   F1B32820
CS0370 TXI CS0250,C,3                                                   F1B32830
CS0430 CAL SCRIPL,A          MATCHING SEGMENTS                          F1B32840
       ANA MASK2             SEARCH FOR REFERENCES                      F1B32850
CS0450 CAS SCRIPL-1,A                                                   F1B32860
       TXI CS0450,A,3                                                   F1B32870
CS0470 TXI CS0490,0,0                                                   F1B32880
       TXI CS0450,A,3                                                   F1B32890
CS0490 CLA CS0030            CHANGE REFERENCE                           F1B32900
       STA SCRIPL-1,A                                                   F1B32910
       LXD LENGTH,C                                                     F1B32920
       LXD CS0600,A                                                     F1B32930
CS0530 TXL CS0570,C,0        ERASE DUPLICATE SEGMENT                    F1B32940
       STQ SCRIPL-3,A                                                   F1B32950
       TXI CS0560,A,3                                                   F1B32960
CS0560 TXI CS0530,C,3                                                   F1B32970
CS0570 LXA CS0060,C                                                     F1B32980
       STQ BETA,C                                                       F1B32990
       CAL 11Z               STORE CS BIT                               F1B33000
       ORS SCRIPL+1,B                                                   F1B33010
CS0600 TXI CS0130,0,0                                                   F1B33020
CS0610 LXD CS0470,A                                                     F1B33030
       LXD LENGTH,C                                                     F1B33040
CS0630 TXL CS0010,C,0                                                   F1B33050
       TXI CS0650,A,3                                                   F1B33060
CS0650 TXI CS0630,C,3                                                   F1B33070
CS0660 LXA L(0),5            STRING BEADS... COMPRESS SCRIPL TABLE      F1B33080
CS0670 CAL SCRIPL,A                                                     F1B33090
       TZE CS0750                                                       F1B33100
       SLW SCRIPL,C                                                     F1B33110
       CLA SCRIPL+1,A                                                   F1B33120
       STO SCRIPL+1,C                                                   F1B33130
       CLA SCRIPL+2,A                                                   F1B33140
       STO SCRIPL+2,C                                                   F1B33150
       TXI CS0750,C,-3                                                  F1B33160
CS0750 TXI CS0760,A,-3                                                  F1B33170
CS0760 TXH CS0670,A,0                                                   F1B33180
       SXD PM0080,C          -3Q IN XC AT END                           F1B33190
       SXD AS1800,C                                                     F1B33200
       SXD AS3600,C                                                     F1B33210
PM0000 SLF                   TURN OFF ALL SENSE LITES                   F1B33220
       CLA MODECL            TEST FOR BOOLEAN EXPRESSION AND IF SO      F1B33230
       SUB L(B)              SKIP PERMUTATION ROUTINE.                  F1B33240
       TZE AS0000                                                       F1B33250
       LXA L(0),A            PERMUTE * AND /                            F1B33260
PM0010 CLA SCRIPL,A                                                     F1B33270
       PAX 0,B                                                          F1B33280
       CLA BETA,B                                                       F1B33290
       PAX 0,C               LDXC WITH SEGMENT LENGTH                   F1B33300
       SXD PM0070,C                                                     F1B33310
       TXL PM0100,C,-9                                                  F1B33320
PM0070 TXI PM0080,A,0        LENGTH LESS THAN 3 OR OD NOT = TO *        F1B33330
PM0080 TXL AS0000,A,0        EXIT FROM PERMUTATION ROUTINE              F1B33340
       TRA PM0010                                                       F1B33350
PM0100 CAL SCRIPL+1,A        SEGMENT LENGTH AT LEAST = TO 3             F1B33360
       LGR 30                                                           F1B33370
       SUB STAR                                                         F1B33380
       TNZ PM0070                                                       F1B33390
       TQP PM0170                                                       F1B33400
       TRA PM0070                                                       F1B33410
PM0170 SXD PM0260,C                                                     F1B33420
       SXD PM0400,C                                                     F1B33430
       SXD PM0680,C                                                     F1B33440
       LXA L(0),C            LDXC WITH 0                                F1B33450
       TXI PM0240,A,-3                                                  F1B33460
PM0240 SLN 3                 TURN * LITE ON                             F1B33470
PM0250 TXI PM0260,C,-3                                                  F1B33480
PM0260 TXL PM0790,C,0        EXIT                                       F1B33490
       SXD PM0340,C                                                     F1B33500
       LXD PM0290,B                                                     F1B33510
PM0290 TXI PM0300,3,0        XA TO XA AND XB                            F1B33520
PM0300 CAL SCRIPL+1,A                                                   F1B33530
       LGR 30                                                           F1B33540
       CAS SLASH                                                        F1B33550
FEXUB  PZE     ,,7            TEST NUMBER FOR IN-LINE EXPONENTS.        F1B33560
PM0340 TXL PM0640,0,0        / SIGN                                     F1B33570
       SLT 3                 * SIGN... IS * LITE ON                     F1B33580
       TXI PM0240,A,-3       NO                                         F1B33590
       TXI PM0390,B,-3       YES - SEARCH FOR / SIGN                    F1B33600
PM0390 TXI PM0400,C,-3                                                  F1B33610
PM0400 TXL PM0770,C,0        EXIT                                       F1B33620
       CAL SCRIPL+1,B                                                   F1B33630
       LGR 30                                                           F1B33640
       SUB SLASH                                                        F1B33650
       TZE PM0480                                                       F1B33660
       TXI PM0390,B,-3                                                  F1B33670
PM0480 CLA SCRIPL,A          PERMUTE TAG WORDS                          F1B33680
       LDQ SCRIPL,B                                                     F1B33690
       STQ SCRIPL,A                                                     F1B33700
       STO SCRIPL,B                                                     F1B33710
       CLA SCRIPL+1,A        PERMUTE OP WORDS                           F1B33720
       LDQ SCRIPL+1,B                                                   F1B33730
       STQ SCRIPL+1,A                                                   F1B33740
       STO SCRIPL+1,B                                                   F1B33750
       CLA SCRIPL+2,A        PERMUTE SYMBOL WORDS                       F1B33760
       LDQ SCRIPL+2,B                                                   F1B33770
       STQ SCRIPL+2,A                                                   F1B33780
       STO SCRIPL+2,B                                                   F1B33790
       LXD PM0340,C                                                     F1B33800
       TXI PM0250,A,-3       RESUME SEGMENT SCAN                        F1B33810
PM0640 SLT 3                 / SIGN... IS * LITE ON                     F1B33820
PM0650 TXI PM0670,B,-3       NO                                         F1B33830
       TXI PM0250,A,-3                                                  F1B33840
PM0670 TXI PM0680,C,-3                                                  F1B33850
PM0680 TXL PM0770,C,0                                                   F1B33860
       CAL SCRIPL+1,B                                                   F1B33870
       LGR 30                                                           F1B33880
       SUB SLASH                                                        F1B33890
       TZE PM0650                                                       F1B33900
       SLN 3                 TORN * LITE ON                             F1B33910
       TRA PM0480                                                       F1B33920
PM0770 LXD PM0780,A                                                     F1B33930
PM0780 TXI PM0790,3,0        XB TO XA,XB                                F1B33940
PM0790 CAL SCRIPL-2,A                                                   F1B33950
       LGR 30                                                           F1B33960
       SUB SLASH                                                        F1B33970
       TZE PM0080            ... / - EXIT FROM SEGMENT SCAN             F1B33980
       CAL SCRIPL-5,A                                                   F1B33990
       LGR 30                                                           F1B34000
       SUB SLASH                                                        F1B34010
       TZE PM0080            ... / * - EXIT FROM SEGMENT SCAN           F1B34020
       CLA SCRIPL-3,A        ... **                                     F1B34030
       STO E                                                            F1B34040
       CLA SCRIPL-2,A                                                   F1B34050
       STO E+1                                                          F1B34060
       CLA SCRIPL-1,A                                                   F1B34070
       STO E+2                                                          F1B34080
       TXI PM0980,A,3                                                   F1B34090
PM0980 TXI PM0990,C,3                                                   F1B34100
PM0990 TXL PM1070,C,0        FINIS                                      F1B34110
       CLA SCRIPL-3,A                                                   F1B34120
       STO SCRIPL,A                                                     F1B34130
       CLA SCRIPL-2,A                                                   F1B34140
       STO SCRIPL+1,A                                                   F1B34150
       CLA SCRIPL-1,A                                                   F1B34160
       STO SCRIPL+2,A                                                   F1B34170
       TXI PM0980,A,3                                                   F1B34180
PM1070 CLA E                                                            F1B34190
       STO SCRIPL,A                                                     F1B34200
       CLA E+1                                                          F1B34210
       STO SCRIPL+1,A                                                   F1B34220
       CLA E+2                                                          F1B34230
       STO SCRIPL+2,A                                                   F1B34240
       CAL SCRIPL+4,A        PRESERVE CS BIT                            F1B34250
       ANA 11Z                                                          F1B34260
       ORS SCRIPL+1,A                                                   F1B34270
       TRA PM0070                                                       F1B34280
AS0000 LXA L(0),7            RENUMBER SEGMENT OF SCRIPL                 F1B34290
AS0100 CLA BETA,B                                                       F1B34300
       TZE AS0700                                                       F1B34310
       PXA 0,C                                                          F1B34320
       STA BETA,B                                                       F1B34330
       TXI AS0700,C,-1                                                  F1B34340
AS0700 TXI AS0800,B,-1                                                  F1B34350
AS0800 TXH AS0100,B,0                                                   F1B34360
AS0900 CLA SCRIPL,A                                                     F1B34370
       PAX 0,B                                                          F1B34380
       CLA BETA,B                                                       F1B34390
       STA SCRIPL,A                                                     F1B34400
       LDQ SCRIPL+2,A                                                   F1B34410
       LGL 1                                                            F1B34420
       LBT                                                              F1B34430
       TQP AS2000                                                       F1B34440
       TXI AS1800,A,-3                                                  F1B34450
AS1800 TXH AS0900,A,0                                                   F1B34460
       TRA AS2500                                                       F1B34470
AS2000 LGL 35                                                           F1B34480
       PAX 0,B                                                          F1B34490
       CLA BETA,B                                                       F1B34500
       STA SCRIPL+2,A                                                   F1B34510
       TXI AS1800,A,-3                                                  F1B34520
AS2500 LXA L(0),3            LDXA,XB WITH 0                             F1B34530
       LDQ L(0)              CLEAR MQ                                   F1B34540
AS2700 STQ BETA,B            RECLEAR BETA TABLE                         F1B34550
       TXI AS2900,B,-1                                                  F1B34560
AS2900 TXH AS2700,B,0                                                   F1B34570
AS3000 CLA SCRIPL,A          ADD INTO GAMMA COUNTERS                    F1B34580
       PAX 0,B                                                          F1B34590
       CLA BETA,B                                                       F1B34600
       ADD BETAD2            3*2**18+(-3)                               F1B34610
       STD BETA,B                                                       F1B34620
       STA BETA,B                                                       F1B34630
       TXI AS3600,A,-3                                                  F1B34640
AS3600 TXH AS3000,A,0        -3Q IN XA AT END                           F1B34650
       SXD 3LBAR,A           -3Q TO 3QBAR = 3LBAR                       F1B34660
CCS000 CAL SCRIPL-3,A        ELIMINATE COMMON SUBEXPRESSIONS            F1B34670
       PAX 0,B               LOAD XB WITH S(I)                          F1B34680
       TXL CCS240,B,0        EXIT AT S(0)                               F1B34690
       CAL BETA,B            OBTAIN LENGTH OF S(I)                      F1B34700
       STD CCS060            AND BACK UP TO                             F1B34710
CCS060 TXI CCS070,A,0        BEGINNING OF CURRENT SEGMENT               F1B34720
CCS070 CAL SCRIPL+1,A        OBTAIN OP1 (S(I))                          F1B34730
       ANA 11Z               EXTRACT CS-BIT                             F1B34740
       TZE CCS000            CONTINUE TO S(I-1)                         F1B34750
       PXA 0,B                                                          F1B34760
       LXA L(0),C            TO S(I)                                    F1B34770
       LXD CCS140,B          AND KEEP COUNT OF SAME                     F1B34780
CCS140 TXI CCS150,3,0        XA TO XA,XB                                F1B34790
CCS150 TXL CCS200,B,0        SEARCH-UP FINISHED. EXAMINE COUNT          F1B34800
       CAS SCRIPL-1,B                                                   F1B34810
       TXI CCS150,B,3        CONTINUE SEARCH                            F1B34820
       TXI CCS190,C,1        RAISE REF COUNTER AND                      F1B34830
CCS190 TXI CCS150,B,3        CONTINUE SEARCH                            F1B34840
CCS200 TXH CCS000,C,1        MULTIPLE REFERENCE                         F1B34850
       CAL MASK4             SINGLE REFERENCE - SO SET                  F1B34860
       ANS SCRIPL+1,A        OP1(S(I))30 TO 0, AND                      F1B34870
       TRA CCS000            CONTINUE FOR S(I-1)                        F1B34880
CCS240 LXD AS3600,A          -3Q TO XA                                  F1B34890
PL0000 TXL LK0000,A,0        GO TO LINKAGE                              F1B34900
       CLA SCRIPL-3,A                                                   F1B34910
       PAX 0,B                                                          F1B34920
       CAL BETA,B                                                       F1B34930
       PAX 0,C                                                          F1B34940
       STD PL0060                                                       F1B34950
PL0060 TXI PL0070,A,0        SET XA TO BEGINNING OF S(I)                F1B34960
PL0070 CAL SCRIPL+1,A        OBTAIN                                     F1B34970
       LGR 30                AND                                        F1B34980
       CAS SPECOP            EXAMINE OP1 (S(I))                         F1B34990
       TRA PL0680                                                       F1B35000
       TRA PL0460                                                       F1B35010
PL0130 CAL SCRIPL+2,A        OP1 (S(I)) IS +, - OR *                    F1B35020
       LGR 35                OBTAIN AND                                 F1B35030
       LBT                   EXAMINE SYM1 (S(I))                        F1B35040
       TQP PL0300                                                       F1B35050
       LGL 5                 EX (IN)TERNAL VARIAVLE                     F1B35060
PL0135 CAS L(H)              IS SYM1 (S(I)) FIX OR FLO PT               F1B35070
       CAS L(O)                                                         F1B35080
       TRA PL0240            FLO PT... SET OP1 (S(I)) 32 = 1            F1B35090
       TRA PL0240            FLO PT... DITTO                            F1B35100
       TRA PL0000            FIX PT... OP1 (S(I)) 32 = 0                F1B35110
PL0240 CAL L(8)              SET OP1 (S(I)) 32 = 1                      F1B35120
PL0250 ORS SCRIPL+1,A                                                   F1B35130
PL0260 TXI PL0000,0,0        CONTINUE SCAN                              F1B35140
PL0300 LXD PL0310,B          SYM1 (S(I)) = SOME S(J)                    F1B35150
PL0310 TXI PL0320,3,0        XA TO XA,XB                                F1B35160
PL0320 SXD PL0330,C                                                     F1B35170
PL0330 TXI PL0340,B,0                                                   F1B35180
PL0340 CAL SCRIPL,B                                                     F1B35190
       PAX 0,C                                                          F1B35200
       ANA MASK2                                                        F1B35210
       SUB SCRIPL+2,A                                                   F1B35220
       TZE PL0420                                                       F1B35230
       CLA BETA,C                                                       F1B35240
       PAX 0,C                                                          F1B35250
       TRA PL0320                                                       F1B35260
PL0420 CAL SCRIPL+1,B        SYM1(S(I)) = S(J)                          F1B35270
       ANA L(8)              EXTRACT OP1 (S(J)) 32 AND GO               F1B35280
       TRA PL0250            SET OP1 (S(I)) 32 = OP1 (S(J)) 32          F1B35290
PL0460 LGL 7                 OP1 (S(I)) IS SPOP                         F1B35300
       TQP PL0465                                                       F1B35310
PL0461 CAL SCRIPL+2,A        FS NAME -                                  F1B35320
       LGR 30                EXAMINE SUM1 (S(I)) S,1-5                  F1B35330
       SUB L(X)                                                         F1B35340
       TNZ PL0240            FLO PT... GO SET OP1 (S(I)) 32 = 1         F1B35350
       TRA PL0000            FIX PT ... OP1 (S(I)) 32 = 0               F1B35360
PL0465 LBT                                                              F1B35370
       TRA PL0470                                                       F1B35380
       CAL SCRIPL+2,A                                                   F1B35390
       LGR 30                                                           F1B35400
       TRA PL0135                                                       F1B35410
PL0470 CLA SCRIPL+2,A        NOT AN FS NAME                             F1B35420
       LXA L(0),B                                                       F1B35430
PL0480 CAS OPSUB,B                                                      F1B35440
       TXI PL0520,B,-1                                                  F1B35450
       REM                   DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B35460
       TRA DP004                                                        F1B35470
       REM                                                              F1B35480
       TXI PL0520,B,-1                                                  F1B35490
PL0520 TXH PL0480,B,-20                                                 F1B35500
       STO G                                                            F1B35510
       REM                   DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B35520
       CLA MODECL                                                       F1B35530
       SUB L(D)                                                         F1B35540
       TZE     DP0042                                                   F1B35550
ITEST4 SUB     L(5)                                                     F1B35560
       TZE     DP0042                                                   F1B35570
       REM                                                              F1B35580
PL0521 SXD PL0260,A                                                     F1B35590
       TSX TET00,A                                                      F1B35600
       HTR 9                                                            F1B35610
       LXD PL0260,A                                                     F1B35620
       TRA PL0461                                                       F1B35630
PL0650 CAL L(4)              SET OP1 (S(I)) 33 =1                       F1B35640
       ORS SCRIPL+1,A                                                   F1B35650
       TRA PL0461                                                       F1B35660
PL0680 TQP PL0130                                                       F1B35670
       TRA     EXPCH          OP1 (S(I)) IS **, CHECK FOR ERROR        $F1B35680
       LGR 35                OBTAIN AND EXAMINE                         F1B35690
       LBT                   SYM1 (S(I))                                F1B35700
       TQP PL1000                                                       F1B35710
       LGL 5                 EX (IN)TERNAL VARIABLE                     F1B35720
       CAS L(H)              IS OT FIX OR FLO PT                        F1B35730
       CAS L(O)                                                         F1B35740
       TRA PL0800                                                       F1B35750
       TRA PL0800                                                       F1B35760
       TRA PL0830            FIX PT                                     F1B35770
PL0800 CAL L(8)              FLO PT... SET OP1 (S(I)) 32 = 1            F1B35780
PL0820 ORS SCRIPL+1,A                                                   F1B35790
PL0830 CAL SCRIPL+5,A        OBTAIN                                     F1B35800
       LGR 35                AND                                        F1B35810
       LBT                   EXAMINE                                    F1B35820
       TQP PL1200            SYM2 (S(I))                                F1B35830
       LGL 5                                                            F1B35840
       CAS L(H)                                                         F1B35850
       CAS L(O)                                                         F1B35860
       TRA PL0940            SYM2 (S(I)) IS FLO PT, SO GO               F1B35870
       TRA PL0940            SET OP2 (S(I)) 32 = 1                      F1B35880
PL0850 PXD 0,0               SYM2(S(I)) IS FIX PT                       F1B35890
       LGL 6                                                            F1B35900
       SUB OPEN                                                         F1B35910
       TNZ PL0000            SYM2 (S(I)) IS EXTERNAL                    F1B35920
       REM                   DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B35930
       REM     AVOID USE OF OPEN SUBROUTINE FOR DP                      F1B35940
       REM     FLOATING PT BASE TO FIXED PT. POWER LESS                 F1B35950
       REM     THAN OR EQUAL TO 7.                                      F1B35951
DP006  CLA MODECL                                                       F1B35960
       SUB L(D)                                                         F1B35970
       TZE PL0000                                                       F1B35980
       SUB L(5)                                                         F1B35990
       TZE PL0000                                                       F1B36000
       PXD ,0                                                           F1B36010
       REM                                                              F1B36020
       LGL 24                                                           F1B36030
       ADD FXCNIX-1                                                     F1B36040
       STA *+1                                                          F1B36050
       CLA **                                                           F1B36060
PL1570 TZE PL0000            EXP IS 0, SO OP1 (S(I)) 33 = 0             F1B36070
       CAS FEXUB                                                        F1B36080
       TXH     0,,0          EXP NOT LESS THAN 7, SO                    F1B36090
       TRA PL0000            OP1 (S(I)) 33 = 0                          F1B36100
       STO SCRIPL+5,A        EXP LESS THAN 7, SO STORE EXP              F1B36110
       CAL L(4)              AS SYM2 (S(I)) AND SET                     F1B36120
       ORS SCRIPL+1,A        OP1 (S(I)) 33 = 1                          F1B36130
       TRA PL0000                                                       F1B36140
PL0940 CAL L(8)              SYM2 (S(I)) IS FLO PT                      F1B36150
       ORS SCRIPL+4,A        SET OP2 (S(I)) 32 = 1                      F1B36160
       TRA PL0000                                                       F1B36170
PL1000 LXD PL1010,B          SYM1 (S(I)) IS SOME S(J)                   F1B36180
PL1010 TXI PL1020,3,0        XA TO XA,XB                                F1B36190
PL1020 SXD PL1030,C                                                     F1B36200
PL1030 TXI PL1040,B,0                                                   F1B36210
PL1040 CAL SCRIPL,B                                                     F1B36220
       PAX 0,C                                                          F1B36230
       ANA MASK2                                                        F1B36240
       SUB SCRIPL+2,A                                                   F1B36250
       TZE PL1130                                                       F1B36260
       CLA BETA,C                                                       F1B36270
       PAX 0,C                                                          F1B36280
       TRA PL1020                                                       F1B36290
PL1130 CAL SCRIPL+1,B                                                   F1B36300
       ANA L(8)                                                         F1B36310
       TRA PL0820                                                       F1B36320
PL1200 LXD PL1210,B          SYM2 (S(I)) = SOME S(K)                    F1B36330
PL1210 TXI PL1220,3,0        XA TO XA,XB                                F1B36340
PL1220 LXD PL1330,C          LKXC WITH -6                               F1B36350
PL1230 SXD PL1240,C                                                     F1B36360
PL1240 TXI PL1250,B,0                                                   F1B36370
PL1250 CAL SCRIPL,B                                                     F1B36380
       PAX 0,C                                                          F1B36390
       ANA MASK2                                                        F1B36400
       SUB SCRIPL+5,A                                                   F1B36410
       TZE PL1340            SYM2(S(I)) = S(K)                          F1B36420
       CLA BETA,C                                                       F1B36430
       PAX 0,C                                                          F1B36440
PL1330 TXI PL1230,0,-6                                                  F1B36450
PL1340 CAL SCRIPL+1,B        SET OP2(S(I)) 32 = OP1 (S(K)) 32           F1B36460
       ANA L(8)                                                         F1B36470
       ORS SCRIPL+4,A                                                   F1B36480
       TRA PL0000            RESUME SCAN                                F1B36490
       REM                   DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B36500
       REM PREFACE NAME OF LIBRARY SUBROUTINES FOR FLOATING POINT (DP)  F1B36510
       REM OPERATIONS BY D (EXAMPLE SIN BECOMES DSIN)                   F1B36520
       REM OR PREFACE NAME OF SUBROUTINES WITH I IF COMPLEX ARITH       F1B36530
       REM MODE, FOR EXAMPLE SIN BECOMES ISIN.                          F1B36540
DP004  CLA MODECL                                                       F1B36550
       SUB L(D)                                                         F1B36560
       TZE DP0042                                                       F1B36570
ITEST3 SUB L(5)                   TEST IF CPLX ARITH MODE.              F1B36580
       TNZ PL0650                                                       F1B36590
DP0042 LDQ SCRIPL+2,1                                                   F1B36600
       PXD ,0                                                           F1B36610
       LGL 6                                                            F1B36620
       SUB L(X)                                                         F1B36630
       REM     FIXED POINT ERROR DETECTION                              F1B36640
       TZE     ERDP02                                                   F1B36650
DP0045 CLA MODECL                                                       F1B36660
       LDQ SCRIPL+2,1        GET NAME OF FUNCTION                       F1B36670
       LGL     30             MOVE FIRST 5 CHARACTERS INTO AC.          F1B36680
       RQL     6             MOVE CHARACTER (IF ANY) TO LOW ORDER BITS  F1B36690
       XCL                    MOVE LAST CHARACTER INTO AC.              F1B36700
       SUB     BLANK         IF IT IS A BLANK, OK                       F1B36710
       TZE     DP0046                                                   F1B36720
ERDP03 TSX     DIAG,4        INCORRECTLY NAMED                          F1B36730
DP0046 XCL                    RETURN NAME TO AC.                        F1B36740
       SLW SCRIPL+2,1                                                   F1B36750
       SLW G                                                            F1B36760
CORR05 AXT     0,2                                                      F1B36770
       LXA     DOPSUB,4      INITIALIZE FOR TABLE SEARCH                F1B36780
DP0047 LAS     DOPSUB+1,2    BEGIN TABLE SEARCH                         F1B36790
       TXI     *+3,2,-1      CONTINUE                                   F1B36800
       TRA     PL0240                                                   F1B36810
       TXI     *+1,2,-1      CONTINUE                                   F1B36820
       TIX     DP0047,4,1                                               F1B36830
       TRA PL0521                                                       F1B36840
       REM                                                              F1B36850
LK0000 LXD AS3600,A          -3Q TO XA                                  F1B36860
LK0030 CAL SCRIPL-3,A                                                   F1B36870
       PAX 0,B               S(I) TO XB                                 F1B36880
       TXL LK1610,B,0        EXIT UPON ENCOUNTERING S(0)                F1B36890
       LDQ SCRIPL-2,A        PLACE LAST OP OP S(I) IN MQ                F1B36900
       CLA BETA,B                                                       F1B36910
       STD LK0110                                                       F1B36920
LK0110 TXI LK0120,A,0        MOVE XA TO BEGINNING OF S(I)               F1B36930
LK0120 LXD LK0130,C                                                     F1B36940
LK0130 TXI LK0140,5,0        XA TO XA,XC                                F1B36950
LK0140 SXD AS3600,A                                                     F1B36960
       CLA BETA-1,B                                                     F1B36970
       PDX 0,B               LENGTH OF S(I-1) TO XB                     F1B36980
       SXD LK0180,B                                                     F1B36990
LK0180 TXI LK0190,C,0        MOVE XC TO BEGINNING OF S(I-1)             F1B37000
LK0190 TQP LK1200            S(I) TYPE AC                               F1B37010
       RQL 1                                                            F1B37020
       TQP LK1200            S(I) TYPE AC                               F1B37030
       CAL 12Z               S(I) RESULTS IN MQ (TYPE MQ)               F1B37040
       ORS SCRIPL+1,A        SET OP1 (S(I)) 31 = 1                      F1B37050
       CAL SCRIPL+1,C        PLACE OP1 (S(I-1)) IN MQ                   F1B37060
       LGR 30                                                           F1B37070
       CAS SPECOP                                                       F1B37080
       TRA LK0320                                                       F1B37090
       TRA LK0950                                                       F1B37100
       TRA LK0030            S(I)TYPTMQ, S(I-1)TYPEAC . OP1(S(I))29=0   F1B37110
LK0320 TQP LK0570                                                       F1B37120
       LGL 27                S(I)TYPE MQ, OP1(S(I-1) = **               F1B37130
       CAL SCRIPL,A                                                     F1B37140
       ANA MASK2             EXTRACT S(I) IN ACC                        F1B37150
       TQP LK0480            OP1 (S(I-1)) 33 = 0                        F1B37160
       SUB SCRIPL+2,C        OP1 (S(I-1)) 33 = 1. OPEN ** SUBROUTINE.   F1B37170
       TNZ LK0030            SET OP1 (S(I)) 29 = OP1 (S(I-1)) 35 = 0    F1B37180
       CAL L(3)              S(I) = SYM1 (S(I-1)), SO                   F1B37190
LK0430 ORS SCRIPL+1,C                                                   F1B37200
LK0440 CAL BIT29                                                        F1B37210
       ORS SCRIPL+1,A                                                   F1B37220
       TRA LK0030            OP1 (S(I-1)) = 0. CLOSED ** SUBROUTINE.    F1B37230
LK0480 SUB SCRIPL+5,C                                                   F1B37240
       TNZ LK0030            SET OP1(S(I))29=OP1(S(I-1))35=0            F1B37250
       CAL L(1)              S(I) = SYM2 (S(I-1)), SO                   F1B37260
       ORS SCRIPL+4,C        SET OP2 (S(I-1)) 35 = 1                    F1B37270
       TRA LK0440                                                       F1B37280
LK0570 CAL SCRIPL+4,C        S(I) TYPE MQ, OP1 (S(I-1)) = *             F1B37290
       LGR 30                PLACE PO2 (S(I-1)) IN MQ                   F1B37300
       REM                   IS OP2 (S(I-1)) = *                        F1B37310
       SUB STAR                                                         F1B37320
       TNZ LK0030            NO - SET OP1 (S(I)) 29 = OP1 (S(I-1)) 35 =0F1B37330
       CAL L(2)              YES                                        F1B37340
       ORS SCRIPL+1,C        SET OP1(S(I-1))34=1                        F1B37350
LK0630 CAL SCRIPL,A                                                     F1B37360
       ANA MASK2             SEARCH FOR S(I) IN S(I-1)                  F1B37370
LK0650 TXL LK0000,B,0        NOT FOUND AT ALL                           F1B37380
       CAS SCRIPL-1,A                                                   F1B37390
       TXI LK0700,A,3                                                   F1B37400
       TRA LK0710                                                       F1B37410
       TXI LK0700,A,3        NOT FOUND - CONTINUE SEARCH                F1B37420
LK0700 TXI LK0650,B,-3                                                  F1B37430
LK0710 LDQ SCRIPL-2,A        S(I) IS SYMJ (S(I-1))                      F1B37440
       RQL 1                 IS OPJ (S(I-1)) = *                        F1B37450
       TQP LK0750                                                       F1B37460
       TXI LK0700,A,3        NO... CONTINUE SEARCH                      F1B37470
LK0750 CLA SCRIPL,C          YES...PERMUTE EL1(S(I-1)) WITH ELJ(S(I-1)) F1B37480
       LDQ SCRIPL-3,A        EXCHANGE                                   F1B37490
       STO SCRIPL-3,A        TAG                                        F1B37500
       STQ SCRIPL,C          WORDS                                      F1B37510
       CAL SCRIPL+1,C        PLACE OP1 (S(I-1)) IN ACC                  F1B37520
       LDQ SCRIPL-2,A        PLACE OPJ (S(I-1)) IN MQ                   F1B37530
       SLW SCRIPL-2,A        EXCHANGE                                   F1B37540
       STQ SCRIPL+1,C        OP                                         F1B37550
       ANA MASK2             WORDS AND                                  F1B37560
       ORS SCRIPL+1,C        SET OP1(S(I-1))30'33= OPJ(S(I-1))30'33     F1B37570
       CLA SCRIPL+2,C        THEN                                       F1B37580
       LDQ SCRIPL-1,A        EXCHANGE                                   F1B37590
       STO SCRIPL-1,A        SYMBOL                                     F1B37600
       STQ SCRIPL+2,C        WORDS                                      F1B37610
       LXD AS3600,A          RESTORE XA                                 F1B37620
LK0900 CAL L(1)              AND                                        F1B37630
       TRA LK0430                                                       F1B37640
LK0950 RQL 27                S(I) TYPE MQ, OP1 (S(I-1)) = SPOP          F1B37650
       CAL SCRIPL,A                                                     F1B37660
       ANA MASK2             EXTRACT S(I) IN ACC                        F1B37670
       TQP LK1050            OP1 (S(I-1)) 33 = 0 (CLOSED SUBROUTINE)    F1B37680
       TXH LK0030,B,6        OPEN MULTIV... SET OP1 (S(I)) 29 = 0       F1B37690
       SUB SCRIPL+5,C        OPEN UNIV... IS S(I) = SUM2 (S(I-1))       F1B37700
       TNZ LK0030            NO... SET OP1 (S(I))29 = OP2 (S(I-1))35 = 0F1B37710
       CAL L(3)              AND                                        F1B37720
       ORS SCRIPL+4,C        SET OP2 (S(I-1))34 = OP2 (S(I-1))35 = 1    F1B37730
       TRA LK0440                                                       F1B37740
LK1050 RQL 15                                                           F1B37750
       TQP LK1100            TEST OP1(S(I-1))12                         F1B37760
       TRA LK0030            FN-NAME                                    F1B37770
LK1100 TXL LK0030,B,6        CLOSED UNIV. SBRTN                         F1B37780
       SUB SCRIPL+8,C        CLOSED MULTIV. SBRTN                       F1B37790
       TNZ LK0030            S(I) NOT = SYM3 (S (I-1))                  F1B37800
       CAL L(1)              S(I) = SYM3 (S(I-1)), SO                   F1B37810
       ORS SCRIPL+7,C        SET OP3 (S(I-1))35 = 1                     F1B37820
       TRA LK0440                                                       F1B37830
LK1200 PXD 0,0               S(I) TYPE AC                               F1B37840
       LDQ SCRIPL+1,C        PLACE OP1 (S(I-1)) IN MQ                   F1B37850
       LGL 6                                                            F1B37860
       CAS SPECOP                                                       F1B37870
       TRA LK1340                                                       F1B37880
       TRA LK1470                                                       F1B37890
       CAL SCRIPL,A          S(I) TYPE AC, OP1 (S(I-1)) = + OR -        F1B37900
       ANA MASK2             SEARCH FOR S(I) IN S(I-1)                  F1B37910
LK1280 TXL LK0000,B,0        NOT FOUND AT ALL                           F1B37920
       CAS SCRIPL-1,A                                                   F1B37930
       TXI LK1330,A,3                                                   F1B37940
       TRA LK0750            S(I) = SOME SYMJ (S(I-1))... GO PERMUTE    F1B37950
       TXI LK1330,A,3        NOT FOUND... CONTINUE SEARCH               F1B37960
LK1330 TXI LK1280,B,-3                                                  F1B37970
LK1340 TQP LK1410                                                       F1B37980
       CAL SCRIPL,A          S(I) TYPE AC, OP1 (S(I-1)) = **            F1B37990
       ANA MASK2                                                        F1B38000
       SUB SCRIPL+2,C        IS S(I) = SYM1 (S(I-1))                    F1B38010
       TNZ LK0030            NO                                         F1B38020
       TRA LK0900            YES                                        F1B38030
LK1410 PXD 0,0               S(I) TYPE AC, OP1 (S(I-1)) = *             F1B38040
       LDQ SCRIPL+4,C                                                   F1B38050
       LGL 6                 IS OP2 (S(I-1)) = 1                        F1B38060
       SUB SLASH                                                        F1B38070
       TZE LK0630            YES                                        F1B38080
       CLA MODECL            FOR BOOLEAN MARK * AS TYPE AC.             F1B38090
       SUB L(B)                                                         F1B38100
       TZE LK0630                                                       F1B38110
       CAL L(2)              NO                                         F1B38120
       ORS SCRIPL+1,C        SET OP1 (S(I-1)) 34 = 1                    F1B38130
       TRA LK0000                                                       F1B38140
LK1470 RQL 27                S(I) TYPE AC, OP1 (S(I-1)) = SPOP          F1B38150
       CAL SCRIPL,A                                                     F1B38160
       ANA MASK2             EXTRACT S(I) IN ACC                        F1B38170
       TQP LK1530                                                       F1B38180
       TXH LK0030,B,6        OPEN MULTIV.                               F1B38190
LK1520 TRA LK0480                                                       F1B38200
LK1530 RQL 15                                                           F1B38210
       TQP LK0480                                                       F1B38220
       TRA LK0030            FN-NAME                                    F1B38230
LK1610 LXD BETA,B            IS S(0) A SINGLE ELEMENT                   F1B38240
       PXD 0,0                                                          F1B38250
       LDQ SCRIPL-2,A                                                   F1B38260
       TXH LK1780,B,3        NO                                         F1B38270
       LGL 6                 YES                                        F1B38280
       SUB 11Z               IS OP (S(0)) = + OR -                      F1B38290
       TZE LKK000            OP (S(0)) = -                              F1B38300
       CAL SCRIPL+2          OP (S(0)) = +                              F1B38310
       ANA MASK1             DOES SYM (S(0)) = S(1)                     F1B38320
       TNZ LKK000            NO                                         F1B38330
       CAL SCRIPL+4          YES - PLACE OP1 (S(1)) IN ACC              F1B38340
       ANA 12Z                                                          F1B38350
       TZE LKK000            OP1 (S(1)) 31 = 0                          F1B38360
       ORS SCRIPL+1          SET OP (S(0)) 31 = 1                       F1B38370
       ALS 2                                                            F1B38380
       ORS SCRIPL+4          SET OP1 (S(1)) 29 = 1                      F1B38390
       ARS 6                                                            F1B38400
       TRA LK1820                                                       F1B38410
LK1780 TQP LKK000            S(0) TYPT AC                               F1B38420
       RQL 1                                                            F1B38430
       TQP LKK000            S(0) TYPE AC                               F1B38440
       CAL 12Z               S(0) TYPE MQ, SO                           F1B38450
LK1820 ORS SCRIPL+1                                                     F1B38460
LKK000 LXD 3LBAR,5           -3Q TO XA,XC                               F1B38470
       CAL SCRIPL-3,C                                                   F1B38480
       PAX 0,B                                                          F1B38490
       CLA BETA,B                                                       F1B38500
       STD LKK050                                                       F1B38510
LKK050 TXI LKK060,C,0        BACK UP XA TO 1ST ELEMENT OF LAST SEGMENT  F1B38520
LKK060 PXD 0,0                                                          F1B38530
       LDQ SCRIPL+1,C        PLACE OP1 OF LAST SEGMENT IN MQ            F1B38540
       LGL 6                                                            F1B38550
       SUB STAR                                                         F1B38560
       TNZ PC0000                                                       F1B38570
       TQP LKK130                                                       F1B38580
       TRA PC0000                                                       F1B38590
LKK130 LDQ SCRIPL+4,C        OP1 OF LAST SEGMENT IS *                   F1B38600
       LGL 2                                                            F1B38610
       LBT                                                              F1B38620
       ORS SCRIPL+1,C        OP2 IS *, SO SET OP1 (S(L)) 34 = 1         F1B38630
PC0000 LXD ARGCTR,C          IS THIS AN FS                              F1B38640
       TXH PC0030,C,0                                                   F1B38650
       TXI PC0040,C,1        NO                                         F1B38660
PC0030 LXA L(0),C            YES                                        F1B38670
PC0040 CAL SCRIPL-3,A                                                   F1B38680
       PAX 0,B                                                          F1B38690
       TXL MC0000,B,0                                                   F1B38700
       CLA BETA,B                                                       F1B38710
       STD PC0100                                                       F1B38720
PC0100 TXI PC0110,A,0                                                   F1B38730
PC0110 LDQ SCRIPL+1,A        PLACE OP1 (S(I)) IN MQ                     F1B38740
       LGL 30                                                           F1B38750
       LBT                                                              F1B38760
PC0140 TXI PC0160,0,300                                                 F1B38770
       TQP PC0040            OP1 (S(I)) 29= 1 AND OP1 (S(I)) 30 = 0     F1B38780
PC0160 PXD 0,C               OP1 (S(I)) 29 = 0 OR OP1 (S(I)) 30 = 1     F1B38790
       STD BETA,B            STORE ERAS. REL. ADD. COUNT IN BETA,       F1B38800
       TXI PC0040,C,1        AND UPDATE FOR NEXT SEGMENT                F1B38810
       REM DICTIONARY OF OPEN SUBROUTINES FOLLOWS                       F1B38820
OPSUB  OCT 672122626060      XABS                                       F1B38830
       OCT 212262606060      ABS                                        F1B38840
       OCT 673145636060      XINT                                       F1B38850
       OCT 314563606060      INT                                        F1B38860
       OCT 674446246060      XMOD                                       F1B38870
       OCT 444624606060      MOD                                        F1B38880
       OCT 674421670060      XMAX0                                      F1B38890
       OCT 442167016060      MAX1                                       F1B38900
       OCT 674421670160      XMAX1                                      F1B38910
       OCT 442167006060      MAX0                                       F1B38920
       OCT 674431450060      XMIN0                                      F1B38930
       OCT 443145016060      MIN1                                       F1B38940
       OCT 674431450160      XMIN1                                      F1B38950
       OCT 443145006060      MIN0                                       F1B38960
       OCT 264346216360      FLOAT                                      F1B38970
       OCT 672631676060      XFIX                                       F1B38980
       OCT 623127456060      SIGN                                       F1B38990
       OCT 676231274560      XSIGN                                      F1B39000
       OCT 672431446060      XDIM                                       F1B39010
       OCT 243144606060      DIM                                        F1B39020
       BSS 10                EXPANSION SPACE FOR OPEN SUBROUTINE DICT.  F1B39030
       REM                                                              F1B39040
       REM                                                              F1B39050
MC0000 LXD 3LBAR,A           MODE CHECKING ROUTINE                      F1B39060
       SXD MC0420,A                                                     F1B39070
       LXA L(0),A                                                       F1B39080
MC0030 SXD XASAVE,A                                                     F1B39090
       CAL SCRIPL,A                                                     F1B39100
       PAX ,B                S(I) TO XB                                 F1B39110
       CLA CPBETA,B                                                     F1B39120
       PAX ,B                                                           F1B39130
       SXD MC0410,B                                                     F1B39140
       SXD MC0460,B                                                     F1B39150
       TXH MC0410,B,-6       SINGLE ELEMENT - GO ONTO S(I+1)            F1B39160
       SLF                   TURN OFF ALL SENSE LITES                   F1B39170
       PXD 0,0               CLEAR ACC                                  F1B39180
       LDQ SCRIPL+1,A        PLACE OP1 (S(I)) IN MQ                     F1B39190
       LGL 6                                                            F1B39200
       CAS SPECOP                                                       F1B39210
       TQP MC0180                                                       F1B39220
XASAVE TXI MC0410,0,0                                                   F1B39230
MC0180 LGL 26                OP1 (S(I)) = +, - OR *                     F1B39240
       TQP MC0210            FIX PT                                     F1B39250
       SLN 1                 FLO PT                                     F1B39260
MC0210 PXD 0,0                                                          F1B39270
       LDQ SCRIPL+2,A        PLACE SYMJ (S(I)) IN MQ - J = 1,...        F1B39280
       LGL 1                                                            F1B39290
       LBT                                                              F1B39300
       TQP MC0440                                                       F1B39310
       LGL 5                 SYMJ (S(I)) IS A VARIABLE                  F1B39320
       CAS L(H)                                                         F1B39330
       CAS L(O)                                                         F1B39340
XBSAVE TXI MC0340,0,0        FLO PT                                     F1B39350
       TRA MC0340            FLO PT                                     F1B39360
MC0310 SLT 1                 SYMJ (S(I)) IS A FIX PT VARIABLE           F1B39370
       TXI MC0380,B,3        OK                                         F1B39380
       TRA *+2                                                          F1B39390
MC0340 SLT 1                 SYMJ(S(I)) IS A FLO PT VARIABLE            F1B39400
ER0070 TSX DIAG,4                    MIXED                              F1B39410
       SLN 1                 RESTORE FLO PT LITE                        F1B39420
       TXI MC0380,B,3                                                   F1B39430
MC0380 TXL MC0400,B,0        FINISHED WITH S(I)                         F1B39440
       TXI MC0210,A,-3       CONTINUE SCANNING S(I). J TO J+1           F1B39450
MC0400 LXD XASAVE,A          GO TO S(I+1)                               F1B39460
MC0410 TXI MC0420,A,0                                                   F1B39470
MC0420 TXH MC0030,A,0                                                   F1B39480
       TRA CP0000            EXIT TO COMPILER                           F1B39490
MC0440 SXD XBSAVE,B          SYMJ (S(ITT = SAME S(K)                    F1B39500
       LXD XASAVE,C                                                     F1B39510
MC0460 TXI MC0470,C,0        MOVE XC TO 1ST ELEMENT OF S(I+1)           F1B39520
MC0470 CAL SCRIPL,C                                                     F1B39530
       ANA MASK2             EXTRACT S(K) IN ACC                        F1B39540
       CAS SCRIPL+2,A        AND COMPARE WITH SYMJ (S(I))               F1B39550
       TRA MC0520                                                       F1B39560
       TRA MC0570                                                       F1B39570
MC0520 PAX ,B                S(K) TO XB                                 F1B39580
       CLA CPBETA,B                                                     F1B39590
       PAX ,B                                                           F1B39600
       SXD MC0560,B                                                     F1B39610
MC0560 TXI MC0470,C,0                                                   F1B39620
MC0570 LXD XBSAVE,B          SYMJ (S(I)) = S(K) FOR SOME K              F1B39630
       CAL SCRIPL+1,C        PLACE OP1 (S(K)) IN ACC                    F1B39640
       ARS 3                                                            F1B39650
       LBT                                                              F1B39660
       TRA MC0310            S(K) IS FIX PT                             F1B39670
       TRA MC0340            S(K) IS FLO PT                             F1B39680
       REM                                                              F1B39690
       REM COMPILER ROUTINE.                                            F1B39700
       REM HAVING DEVELOPED ALL NECESSARY LINKAGE AND OPTIMAZATION      F1B39710
       REM INFORMATION AND SET BITS IN EACH SCRIPL TABLE ENTRY ACCORD-  F1B39720
       REM INGLY, NOW MAKE ENTRIES IN THE COMPILED INSTRUCTION TABLE ON F1B39730
       REM THE BASIS OF THESE SCRIPL TABLE ENTRIES.                     F1B39740
       REM                                                              F1B39750
CP0000 SLF                   INITIALLY TURN OFF ALL LIGHTS AND CLEAR    F1B39760
       STZ FNSW              CELL FOR FUNCTION SUBPROGRAM USAGE AND     F1B39770
       TRA     CPPCH                                                   $F1B39780
       LXD ARGCTR,4          TEST WHETHER THIS STATEMENT IS AN ARITH-   F1B39790
       TXL CP0090,4,0        METIC STATEMENT FUNCTION.                  F1B39800
       TSX CIT00,4           YES, SO COMPILE CIT ENTRY OF 4 WORDS OF    F1B39810
       PZE ALL1,,ALL1        ONES AS LABEL FOR SECTION THREE.           F1B39820
       PZE ALL1,,ALL1                                                   F1B39830
CP0090 LXD EIFNO,4           GET THE CURRENT INTERNAL FORMULA NUMBER    F1B39840
       STZ CW                WHICH WILL BE COMPILED IN THE LOCATION WORDF1B39850
       SXD CW,4              OF THE FIRST INSTRUCTION. ALSO SAVE FOR    F1B39860
       SXA CALLNM,4          POSSIBLE ENTRY IN FIRST AND LAST IFN TABLE.F1B39870
       STZ BOOLIN            TURN BOOLEAN INDICATOR OFF.                F1B39880
       CLA MODECL            GET SPECIAL INDICATOR SYMBOL AND           F1B39890
       REM                   DOUBLE PRECISION-COMPLEX ARITHMETIC PATCH. F1B39900
       CAS L(D)                                                         F1B39910
       TRA *+2                                                          F1B39920
       TRA CP000D            DOUBLE PRECISION                           F1B39930
       CAS L(I)                                                         F1B39940
       TRA *+2                                                          F1B39950
       TRA     CP000D                                                   F1B39960
       CAS L(B)              TEST FOR OTHER THAN NORMAL MODE.           F1B39970
       TRA *+2                                                          F1B39980
       STO BOOLIN            YES, TURN BOOLEAN INDICATOR ON.            F1B39990
       REM                                                              F1B40000
       LXD 3LBAR,1           LENGTH OF SCRIPL TABLE TO IR 1.            F1B40010
       REM INITIAL COMPILATION OF EACH LEVEL.                           F1B40020
CP0130 CLA SCRIPL-3,1        EXTRACT FROM TAG WORD OF LAST ENTRY OF NEXTF1B40030
       PAX ,2                LEVEL THE LEVEL NUMBER. USING THIS GET THE F1B40040
       CLA CPBETA,2          CORRESPONDING BETA TABLE ENTRY. SAVE THE   F1B40050
       STD PHI(I)            DECREMENT AS ADDEND FOR 1( ERASABLE.       F1B40060
       ANA MASK2             SAVE THE ADDRESS WHICH IS LENGTH OF CURRENTF1B40070
       PAX ,2                LEVEL.                                     F1B40080
       SXD CP0400,2                                                     F1B40090
       PAC 0,4               FORM TRUE LENGTH FROM COMPLEMENT AND MOVE  F1B40100
       SXD CP0240,4          IR 1 SO THAT IT WILL BE POSITIONED AT THE  F1B40110
CP0240 TXI CP0250,1,**       FIRST ENTRY IN CURRENT LEVEL.              F1B40120
CP0250 SXD 3LBAR,1           SAVE IR 1 AS POSITION IN SCRIPL TABLE.     F1B40130
       CLA XCAIND            ADD XCA LINKAGE INFORMATION,IF ANY, TO TAG F1B40140
       ORS SCRIPL+1,1        WORD OF FIRST ENTRY OF CURRENT LEVEL.      F1B40150
       STZ XCAIND            RESET XCA INDICATOR TO NO LINKAGE.         F1B40160
       LDQ SCRIPL+1,1        GET AND EXAMINE LINKAGE BITS IN OP WORD OF F1B40170
       LGL 30                FIRST ENTRY OF CURRENT LEVEL.              F1B40180
       TQP *+2               IS THIS SEGMENT A COMMON SUBEXPRESSION.    F1B40190
       TRA CP0310            YES,MUST BE STORED.                        F1B40200
       LBT                   IS IT LINKED BY EITHER AC OR MQ.           F1B40210
       TRA *+2               NO                                         F1B40220
       TRA CP0370            YES, SHOULD NOT BE STORED.                 F1B40230
       CLA L(1)              NEITHER A COMMON SUBEXPRESSION NOR LINKED. F1B40240
       STO XCAIND            POSSIBLITY OF USING XCA, SET INDICATOR SO. F1B40250
CP0310 SLN 1                 TURN LIGHT 1 ON TO INDICATE NEED TO STORE  F1B40260
       RQL 1                 RESULT OF THIS LEVEL COMPUTATION.          F1B40270
       TQP CP0350            TURN LIGHT 2 ON TO CALL FOR STQ INSTEAD OF F1B40280
       SLN 2                 STO. (BASED ON BIT 31 = 1)                 F1B40290
CP0350 RQL 1                 GET AND EXAMINE                            F1B40300
       TRA CP0380            BIT 32 OF                                  F1B40310
CP0370 RQL 2                 OP WORD OF                                 F1B40320
CP0380 TQP CP0420            FIRST ENTRY OF CURRENT LEVEL.              F1B40330
       SLT 4                 TURN LIGHT 4 ON TO INDICATE                F1B40340
CP0400 TXH 0,0,**            THAT CURRENT LEVEL IS FIXED POINT.         F1B40350
       TRA CP0430                                                       F1B40360
CP0420 SLN 4                 (BASED ON BIT 32 = 0)                      F1B40370
       ZET BOOLIN            TEST WHETHER THIS IS BOOLEAN...            F1B40380
       TRA BER001            YES, ERROR GO TO DIAGNOSTIC ROUTINE.       F1B40390
CP0430 PXD 0,0               GET AND EXAMINE OP WORD OF FIRST ENTRY OF  F1B40400
       LDQ SCRIPL+1,1        CURRENT LEVEL FOR TYPE OF LEVEL.           F1B40410
       LGL 6                                                            F1B40420
       CAS SPECOP                                                       F1B40430
       TXI CP0960,0,0        LEVEL IS * / OR **.                        F1B40440
       TXI CP2040,1,-3       LEVEL IS FUNCTION.                         F1B40450
       SUB 11Z               LEVEL IS + -, WHICH OPERATION IS FIRST.    F1B40460
       TZE CP0760            OPERATION IS -.                            F1B40470
       LGL 29                OPERATION IS +. IS INPUT IN AC.            F1B40480
       TQP CP1130            IF NOT IN AC GO COMPILE CLA. (BIT 35=0)    F1B40490
CP0540 LXD CP0400,2          GET LENGTH OF THIS LEVEL AND TEST FOR ANY  F1B40500
       TXI CP0560,2,3        ENTRIES REMAINING TO BE COMPILED. IF NONE  F1B40510
CP0560 TXL ES0000,2,0        GO TO THE END-OF-SEGMENT ROUTINE.          F1B40520
       SXD CP0400,2          IF SOME ENTRIES REMAIN, SAVE NEW REMAINING F1B40530
       TXI CP0590,1,-3       LENGTH AND GO COMPILE NEXT ENTRY.          F1B40540
CP0590 PXD 0,0               GET AND EXAMINE OP WORD OF THIS ENTRY.     F1B40550
       LDQ SCRIPL+1,1        OPERATION MAY BE + OR - OR * OR /.         F1B40560
       LGL 6                                                            F1B40570
       CAS STAR                                                         F1B40580
       TRA CP1200            OPERATION IS /                             F1B40590
       TRA CP1720            OPERATION IS *                             F1B40600
       SUB 11Z                                                          F1B40610
       TZE CP0880            OPERATION IS -.                            F1B40620
       CAL L(FAD)            OPERATION IS +.                            F1B40630
       SLT 4                 TEST LIGHT 4 FOR FIXED OR FLOATING POINT.  F1B40640
       TRA CP1680            FLOATING POINT, COMPILE  FAD               F1B40650
       SLN 4                 FIXED POINT, COMPILE  ADD                  F1B40660
       CAL L(ADD)            AND LEAVE LIGHT 4 ON FOR LATER TEST.       F1B40670
       TRA CP1680                                                       F1B40680
CP0760 LGL 29                FIRST OPERATION OF LEVEL IS -. IS INPUT IN F1B40690
       TQP     CP0850        AC, IF NOT GO COMPILE CLS.                 F1B40700
       TSX CIT00,4           INPUT IN AC, COMPILE CHS.                  F1B40710
       PZE L(0),,L(CHS)                                                 F1B40720
       PZE L(0),,L(0)                                                   F1B40730
       TRA CP0540            AND GO TO NEXT ENTRY IN LEVEL, IF ANY.     F1B40740
CP0850 CAL L(CLS)            FIRST OPERATION IN LEVEL IS - AND INPUT NOTF1B40750
CPBCOM TSX COMPM4,2          COMPILE CLS (CAL).                         F1B40760
       NZT BOOLIN            TEST WHETHER THIS IS BOOLEAN...            F1B40770
       TRA CP0540            NO.                                        F1B40780
       TSX CIT00,4           YES, COMPILE  COM.                         F1B40790
       PZE L(0),,L(COM)                                                 F1B40800
       PZE L(0),,L(0)                                                   F1B40810
       TRA CP0540                                                       F1B40820
CP0880 CAL L(FSB)            OPERATION IS -.                            F1B40830
       SLT 4                 TEST LIGHT 4 FOR FIXED OR FLOATING POINT.  F1B40840
       TRA CP1680            FLOATING POINT, COMPILE  FSB.              F1B40850
       SLN 4                 FIXED POINT, COMPILE  SUB.                 F1B40860
       CAL L(SUB)            AND LEAVE LIGHT 4 ON FOR LATER TEST.       F1B40870
       TRA CP1680                                                       F1B40880
CP0960 TQP CP0980            FIRST OPERATION IN LEVEL IS * OR **.       F1B40890
       TRA CP4140            TEST FOR WHICH. IF ** GO TO EXPONTENTIATIONF1B40900
CP0980 LGL 29                OPERATION OF FIRST ENTRY IS *. THIS MEANS  F1B40910
       SLN 3                 A LEVEL OF * OR OF / OR OF * AND /         F1B40920
       LBT                   OPERATIONS.                                F1B40930
       TRA CP1050            OP1 (S(I)) 34 = 0, SO LEAVE LITE 3 ON      F1B40940
       SLT 3                 OP1 (S(I)) 34 = 1, SO TURN LITE 3 OFF      F1B40950
       TXH 0,0,0                                                        F1B40960
CP1050 TQP CP1070                                                       F1B40970
       TRA CP0540            OP1 (S(I)) 35 = 1, SO GO MODIFY J          F1B40980
CP1070 ZET BOOLIN            TEST WHETHER THIS IS BOOLEAN...            F1B40990
       TRA CP1130            YES, GO COMPILE CLA (CAL).                 F1B41000
       CAL L(LDQ)            OP1 (S(I)) 35 = 0                          F1B41010
       SLT 3                                                            F1B41020
       TRA CP1680                                                       F1B41030
       SLN 3                 EL1 (S(II) TO ACC                          F1B41040
CP1130 CAL L(CLA)                                                       F1B41050
       TRA CP1680                                                       F1B41060
CP1200 SLT 3                 OPJ (S(I)) = /                             F1B41070
       TRA CP1330                                                       F1B41080
       SLT 4                 PREDECESSOR IN ACC                         F1B41090
       TRA CP1670            FLO PT.                                    F1B41100
       SLN 4                 FIX PT. RESTORE FXPTSW                     F1B41110
       TSX CIT00,C           COMPILE LRS 35                             F1B41120
       PZE L(0),,L(LRS)              LOC,,OP-DEC                        F1B41130
       PZE L(0),,DEC35               ADR,,RA-TAG                        F1B41140
       TRA CP1450                                                       F1B41150
CP1330 SLT 4                 PREDECESSOR IN MQ                          F1B41160
       TRA CP1570            AND SEGMENT IS                             F1B41170
       SLN 4                 FIX PT. RESTORE FXPTSW                     F1B41180
CP1450 CAL L(DVP)                                                       F1B41190
       TSX COMPM4,B                                                     F1B41200
       TSX CIT00,C           COMPILE CLM                                F1B41210
       PZE L(0),,L(CLM)              LOC,,OP-DEC                        F1B41220
       PZE L(0),,L(0)                ADR,,RA-TAG                        F1B41230
       TSX CIT00,C           COMPILE LLS 18                             F1B41240
       PZE L(0),,L(LLS)              LOC,,OP-DEC                        F1B41250
       PZE L(0),,DEC18               ADR,,RA-TAG                        F1B41260
       TRA CP0540            GO MODIFY J                                F1B41270
CP1570 TSX COMP0C,2          COMPILE   XCA                              F1B41280
CP1670 CAL L(FDP)                                                       F1B41290
CP1680 SLW CW+1                                                         F1B41300
CP1690 TSX COMPM3,2                                                     F1B41310
       TRA CP0540            GO MODIFY J                                F1B41320
CP1720 NZT BOOLIN            TEST WHETHER THIS IS BOOLEAN...            F1B41330
       TRA *+2               NO.                                        F1B41340
       SLT     3             BOOLEAN, TURN OFF LITE 3 TO AVOID XCA      F1B41350
       SLT 3                 OPJ(S(I))=*                                F1B41360
       TRA CP1840                                                       F1B41370
       TSX COMP0C,2          COMPILE    XCA                             F1B41380
CP1840 SLN 3                 TURN LATE 3 ON                             F1B41390
       SLT 4                                                            F1B41400
       TRA CP2000                                                       F1B41410
       SLN 4                 FIX PT. RESTORE FXPTSW                     F1B41420
       CAL L(MPY)                                                       F1B41430
       TSX COMPM4,B                                                     F1B41440
       TSX CIT00,C           COMPILE ALS 17                             F1B41450
       PZE L(0),,L(ALS)              LOC,,OP-DEC                        F1B41460
       PZE L(0),,DEC17               ADR,,RA-TAG                        F1B41470
       TRA CP0540            GO MODIFY J                                F1B41480
CP2000 CAL L(FMP)                                                       F1B41490
       TRA CP1680                                                       F1B41500
       REM     **  FUNCTION COMPILATION  **                             F1B41501
CP2040 LGL 7                 OP1(S(I))=SPOP                             F1B41510
       LBT                   TEST OP1(S(I))12                           F1B41520
       TQP CP2650            LIB OR OPEN FUNCTION                       F1B41530
       TQP     CP5000        FUNCTION SUBPROGRAM (FNII)                 F1B41540
       PXD     0,0           ARITHMETIC STATEMENT FUNCTION              F1B41550
       LLS 15                PUT TYPE NO IN ADD(ACC)                    F1B41560
       ORA P(                FORM 4...TYPE NO.                          F1B41570
       SLW ARGORG            AND STO IN ARGORG                          F1B41580
       ANA MASK2                                                        F1B41590
       ORA X(                FORM 7...TYPE NO.                          F1B41600
       SLW XRSAVE            AND STO IN XRSAVE                          F1B41610
       CLA SCRIPL+1,A                                                   F1B41620
       LBT                   EXAMINE OP2(S(I))35                        F1B41630
       TRA CP2150            1ST ARG STORED                             F1B41640
CP2100 TSX CIT00,C           1ST ARG IN ACC                             F1B41650
       PZE L(0),,L(STO)              LOC,,OP-DEC                        F1B41660
       PZE ARGORG,,L(0)              ADR,,RA-TAG                        F1B41670
       TXI CP2200,A,-3       GO ON TO OP3(S(I))                         F1B41680
CP2150 CAL L(CLA)                                                       F1B41690
       TSX COMPM4,B                                                     F1B41700
       TRA CP2100                                                       F1B41710
CP2200 LXD CP0400,B                                                     F1B41720
       TXI CP2230,B,3                                                   F1B41730
CP2230 TXH CP2500,B,-6       FINISHED WITH S(I)                         F1B41740
       SXD CP0400,B                                                     F1B41750
       CLA SCRIPL+1,A                                                   F1B41760
       LBT                   EXAMINE OP3(S(I))35                        F1B41770
       TRA CP2300            2ND ARG STORED                             F1B41780
CP2250 TSX CIT00,C           2ND ARG IN MQ                              F1B41790
       PZE L(0),,L(STQ)              LOC,,OP-DEC                        F1B41800
       PZE ARGORG,,2E18              ADR,,RA-TAG                        F1B41810
       TXI CP2350,A,-3       GO ON TO SYM4(S(I))                        F1B41820
CP2300 CAL L(LDQ)                                                       F1B41830
       TSX COMPM4,B                                                     F1B41840
       TRA CP2250                                                       F1B41850
CP2350 CLA DECMI2            INITIALIZE DEC(P(CNTR) TO 2                F1B41860
       SLW P(CNTR                                                       F1B41870
CP2370 LXD CP0400,B                                                     F1B41880
       TXI CP2390,B,3                                                   F1B41890
CP2390 TXH CP2500,B,-6       FINISHED WITH S(I)                         F1B41900
       SXD CP0400,B                                                     F1B41910
       CAL L(CLA)                                                       F1B41920
       TSX COMPM4,B                                                     F1B41930
       TSX CIT00,C           COMPILE STO 4...TYPE NO. + J-2, J=4,...    F1B41940
       PZE L(0),,L(STO)              LOC,,OP-DEC                        F1B41950
       PZE ARGORG,,P(CNTR            ADR,,RA-TAG                        F1B41960
       CLA P(CNTR            UPDATE P(CNTR                              F1B41970
       ADD 2E18                                                         F1B41980
       STO P(CNTR                                                       F1B41990
       TXI CP2370,A,-3                                                  F1B42000
CP2500 LXD 3LBAR,A           FINISHED WITH S(I)                         F1B42010
       CAL SCRIPL+2,A        RETURN TO FIRST ELEMENT OF SEGMENT AND GET F1B42020
       SLW CW+2              NAME OF FUNCTION FOR TSX ....,4            F1B42030
       LXD ARGCTR,4          DETERMINE WHETHER IN AN ARITHMETIC FUNCTIONF1B42040
       TXL CP2600,4,0        OR NOT.                                    F1B42050
       TSX     PCH2,4         GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX  $F1B42060
       PZE L(0),,L(SXD)                                                 F1B42070
       PZE XRSAVE,,L(4)      SXD   7(I,4                                F1B42080
       TSX CIT00,4                                                      F1B42090
       PZE L(0),,L(TSX)      TSX ....,4                                 F1B42100
       PZE CW+2,,L(4)                                                   F1B42110
       TSX FLTR00,4          COMPILE FLOW TRACING INSTRUCTIONS AND THEN F1B42120
       PZE L(0),,L(LXD)                                                 F1B42130
       PZE XRSAVE,,L(4)      LXD   7(I,4                                F1B42140
       TRA ES0000            AND GO TO END OF SEGMENT ROUTINE.          F1B42150
CP2600 TSX COMP0A,2          NOT IN AN ARITHMETIC FUNCTION, COMPILE     F1B42160
       TSX CIT00,4           SXD   6(+4,4                               F1B42170
       PZE L(0),,L(TSX)      TSX  ....,4                                F1B42180
       PZE CW+2,,L(4)                                                   F1B42190
       TSX FLTR00,4          COMPILE FLOW TRACING INSTRUCTIONS AND THEN F1B42200
       PZE L(0),,L(LXD)      LXD  6(+4,4                                F1B42210
       PZE O(,,D4A4                                                     F1B42220
CP5830 TXI ES0000,0,**                                                  F1B42230
       REM     **  LIBRARY (OR OPEN) SUBROUTINE  **                     F1B42231
CP2650 LGL 20                TEST OP1(S(I))33                           F1B42240
       TQP CP3060            0... LIB. SBRTN                            F1B42250
       TSX OPENSB,4          USE SUBROUTINE TO COMPILE CALLING SEQUENCE.F1B42260
       TRA ES0000                                                       F1B42270
CP3060 TXL CP3350,B,-9                                                  F1B42280
       CLA SCRIPL+1,A        CLOSED UNIVARIATE FUNCTION                 F1B42290
       LBT                   EXAMINE OP2(S(I))35                        F1B42300
       TRA CP3280            0... ARG STORED                            F1B42310
CP3100 LXD ARGCTR,4          DETERMINE WHETHER THIS IS AN ARITHMETIC    F1B42320
       TXL CP3200,4,0        FUNCTION BEING COMPILED.                   F1B42330
       TSX COMP0B,2          YES, COMPILE  SXD  7(,4                    F1B42340
       TRA *+2                                                          F1B42350
CP3200 TSX COMP0A,2          NOT A FUNCTION, COMPILE  SXD  6(+4,4       F1B42360
       CLA SCRIPL-1,1        GET NAME OF FUNCTION FOR  TSX  ....,4      F1B42370
       STO CW+2                                                         F1B42380
       TSX CIT00,4           COMPILE                                    F1B42390
       PZE L(0),,L(TSX)      TSX  ....,4                                F1B42400
       PZE CW+2,,L(4)                                                   F1B42410
       TRA CP5010            GO COMPILE  PROPER LXD                     F1B42420
CP3280 CAL L(CLA)                                                       F1B42430
       TSX COMPM4,B                                                     F1B42440
       TRA CP3100            GO COMPILE SXD,TSX,LXD SEQUENCE            F1B42450
CP3350 TXL CP3560,B,-12                                                 F1B42460
       CLA SCRIPL+1,A        CLOSED BIVARIATE FUNCTION                  F1B42470
       LBT                   EXAMINE OP2(S(I))35                        F1B42480
       TRA CP3450            0... ARG1 STORED                           F1B42490
CP3390 CAL L(LDQ)            1... ARG1 IN ACC                           F1B42500
       TXI CP3420,A,-3                                                  F1B42510
CP3420 TSX COMPM4,B                                                     F1B42520
       TXI CP3100,A,3        GO COMPILE SXD,TSX,LXD SEQUENCE            F1B42530
CP3450 CLA SCRIPL+4,A                                                   F1B42540
       LBT                   EXAMINE OP3(S(I))35                        F1B42550
       TRA CP3490            0... ARG2 STORED                           F1B42560
       TRA CP3280            1... ARG2 IN MQ                            F1B42570
CP3490 CAL L(CLA)                                                       F1B42580
       TSX COMPM4,B                                                     F1B42590
       TRA CP3390            GO COMPILE LDQ,SXD,TSX,LXD SEQUENCE        F1B42600
CP3560 CLA SCRIPL+1,A        CLOSED MULTIVARIATE FUNCTION               F1B42610
       LBT                   EXAMINE OP2(S(I))35                        F1B42620
       TXI CP3820,A,-6       0... ARG1 STORED                           F1B42630
       TXI CP3600,A,-6       1... ARG1 IN ACC                           F1B42640
CP3600 CLA DECMI2                                                       F1B42650
       STO P(CNTR            INITIALIZE P(CNTR TO -2                    F1B42660
CP3620 CAL L(LDQ)                                                       F1B42670
       TSX COMPM4,B                                                     F1B42680
       TSX CIT00,C           COMPULE   STQ  P(, I                       F1B42690
       PZE L(0),,L(STQ)              LOC,,OP-DEC                        F1B42700
       PZE P(,,P(CNTR                ADR,,RA-TAG                        F1B42710
       CLA P(CNTR                                                       F1B42720
       SUB 2E18                                                         F1B42730
       STO P(CNTR                                                       F1B42740
       LXD CP0400,B                                                     F1B42750
       TXI CP3770,B,3                                                   F1B42760
CP3770 TXL CP3800,B,-12                                                 F1B42770
       LXD 3LBAR,A           FINISHED WITH ARG VECTOR                   F1B42780
       TXI CP3390,A,-3                                                  F1B42790
CP3800 SXD CP0400,B                                                     F1B42800
       TXI CP3620,A,-3       GO PICK UP NEXT ARG.                       F1B42810
CP3820 CLA SCRIPL-2,A                                                   F1B42820
       LBT                   EXAMINE OP3(S(I))35                        F1B42830
       TXI CP4070,A,6        0... ARG2 STORED                           F1B42840
       CLA DECMI2            1... ARG2 IN MQ                            F1B42850
       STO P(CNTR                                                       F1B42860
CP3870 CAL L(CLA)                                                       F1B42870
       TSX COMPM4,B                                                     F1B42880
       TSX CIT00,C           COMPILE   STO P(, I                        F1B42890
       PZE L(0),,L(STO)              LOC,,OP-DEC                        F1B42900
       PZE P(,,P(CNTR                ADR,,RA-TAG                        F1B42910
       CLA P(CNTR                                                       F1B42920
       SUB 2E18                                                         F1B42930
       STO P(CNTR                                                       F1B42940
       LXD CP0400,B                                                     F1B42950
       TXI CP4020,B,3                                                   F1B42960
CP4020 TXL CP4050,B,-12                                                 F1B42970
       LXD 3LBAR,A           FINISHED WITH ARG VECTOR                   F1B42980
       TXI CP3280,A,-3                                                  F1B42990
CP4050 SXD CP0400,B                                                     F1B43000
       TXI CP3870,A,-3       GO PICK UP NEXT ARG                        F1B43010
CP4070 CAL L(CLA)                                                       F1B43020
       TSX COMPM4,B                                                     F1B43030
       TXI CP3600,A,-6                                                  F1B43040
       REM     **  COMPILE EXPONENTIATION SEGMENT  **                   F1B43041
CP4140 LGL 27                OP1(S(I))=**                               F1B43050
       TQP CP4410            CLOSED SBRTN SINCE OP1(S(I))33=0           F1B43060
       LBT                  * OPEN SUBROUTINE BIT 33=1                  F1B43070
       TRA CP4200            BASE FIX PT SINCE OP1(S(I))32=0            F1B43080
       CLA STRSTR            BASE FLO PT SINCE OP1(S(II))32=1           F1B43090
       TRA CP4210                                                       F1B43100
CP4200 CLA ADSTAR                                                       F1B43110
CP4210 STO CW+1                                                         F1B43120
       LGL 2                 EXAMINE OP1(S(I))35                        F1B43130
       TQP CP4310            0... BASE STORED                           F1B43140
       LDQ ADSTAR            1... BASE NOT STORED                       F1B43150
       LBT                   EXAMINE OP1(S(I))34                        F1B43160
       LDQ ADPLUS            0... BASE IN ACC                           F1B43170
       STQ CW+2              1...BASE IN MQ                             F1B43180
       STZ CW+3                                                         F1B43190
       TRA CP4320                                                       F1B43200
CP4310 TSX AC0000,C          ADDRESS COMPILE SYM1(S(I))                 F1B43210
CP4320 CLS CW                                                           F1B43220
       STO CW                CW TO -CW                                  F1B43230
       TSX COMP,B            COMPILE BASE                               F1B43240
       CLA SCRIPL+5,A                                                   F1B43250
       STO CW+2                                                         F1B43260
       TSX COMP,B            COMPILE FIX PT CONSTANT EXPONENT           F1B43270
       STZ CW+1              RESET CW+1                                 F1B43280
       TRA ES0000                                                       F1B43290
CP4410 LGL     3            * CLOSED EXP. SBRTN                         F1B43300
       LBT                   EXAMINE OP1(S(I))35                        F1B43310
       TRA CP4860            0... BASE STORED                           F1B43320
CP4440 CAL L(LDQ)            1... BASE IN ACC.                          F1B43330
       TXI CP4470,A,-3                                                  F1B43340
CP4470 TSX COMPM4,B                                                     F1B43350
CP4490 LXD ARGCTR,4          DETERMINE WHETHER AN ARITHMETIC FUNCTION ISF1B43360
       TXL CP4500,4,0        IS BEING COMPILED.                         F1B43370
       TSX COMP0B,2          YES, COMPILE  SXD  7(,4                    F1B43380
       TRA *+2                                                          F1B43390
CP4500 TSX COMP0A,2          NO, COMPILE   SXD  6(+4,4                  F1B43400
       CLA SCRIPL+1,A                                                   F1B43410
       ARS 3                                                            F1B43420
       LBT                   EXAMINE OP2(S(I))32                        F1B43430
       TXI CP4660,A,3        0...                                       F1B43440
       CLA FLFL              1... FLO**FLO                              F1B43450
       LDQ SCRIPL-2,A        EXAMINE OP1(S(I))32 TO CHECK               F1B43460
       RQL 32                FOR MIXED EXPONENTIAL EXPRESSION           F1B43470
       TQP MC0310+2          ERROR FIX PT BASE, FLOAT EXP.              F1B43480
       TRA CP4730                                                       F1B43490
CP4660 LDQ SCRIPL+1,A                                                   F1B43500
       RQL 32                EXAMINE OP1(S(I))32                        F1B43510
       CLA FXFX                                                         F1B43520
       TQP CP4730            0...FX**FX                                 F1B43530
       CLA FLFX              1... FL**FX                                F1B43540
CP4730 STO G                 FOR CLOSUB ENTRY AND FOR TSX ....,4        F1B43550
       TSX CIT00,4           COMPILE                                    F1B43560
       PZE L(0),,L(TSX)      TSX  ....,4                                F1B43570
       PZE G,,L(4)                                                      F1B43580
       TSX TET00,A                                                      F1B43590
       HTR 9                                                            F1B43600
       TRA CP5010                                                       F1B43610
CP4860 CAL L(CLA)                                                       F1B43620
       TSX COMPM4,B                                                     F1B43630
       CLA SCRIPL+4,A                                                   F1B43640
       LBT                   EXAMINE OP2(S(I))35                        F1B43650
       TXI CP4440,0,0        0...EXP STORED                             F1B43660
       TXI CP4490,A,-3       1... EXP IN MQ                             F1B43670
CP5000 TSX FNIISB,4          USE SUBROUTINE TO COMPILE CALLING SEQUENCE.F1B43680
CP5010 LXD ARGCTR,4          DETERMINE WHETHER THIS IS AN ARITHMETIC    F1B43690
       TXL CP5020,4,0        FUNCTION BEING COMPILED.                   F1B43700
       TSX FLTR00,4          COMPILE FLOW TRACING INSTRUCTIONS AND THEN F1B43710
       PZE L(0),,L(LXD)      LXD  7(,4                                  F1B43720
       PZE X(,,L(4)                                                     F1B43730
       TRA ES0000            GO TO END OF SEGMENT ROUTINE.              F1B43740
CP5020 TSX FLTR00,4          COMPILE FLOW TRACING INSTRUCTIONS AND THEN F1B43750
       PZE L(0),,L(LXD)      LXD  6(+4,4                                F1B43760
       PZE O(,,D4A4                                                     F1B43770
       REM                                                              F1B43780
       REM END OF SEGMENT ROUTINE.                                      F1B43790
ES0000 LXD 3LBAR,A           -3Q TO XA                                  F1B43800
       SLT     1             IS A STORE NEEDED                          F1B43810
       TRA     CP0130        NO, GO TO NEXT SEGMENT                     F1B43820
       CAL     SCRIPL,A      YES, ARE WE AT LEVEL ZERO                  F1B43830
       ANA MASK2                                                        F1B43840
       TZE     ES0160        TRA=YES                                    F1B43850
       ZET XCAIND            WAS XCA INDICATOR SET.                     F1B43860
       TRA ESXCA0            YES, POSSIBILITY OF USING XCA.             F1B43870
       CLA ARERAS            S(I) NOT = S(0)                            F1B43880
       STO CW+2                                                         F1B43890
       CLA PHI(I)                                                       F1B43900
       STO CW+3                                                         F1B43910
       CAL L(STQ)                                                       F1B43920
       SLT     2             IS STQ LITE ON                             F1B43930
       CAL L(STO)                                                       F1B43940
       TSX COMPM2,B          COMPILE STO/STQ 1... TYPE NO + PHI(I)      F1B43950
       TRA CP0130            GO TO NEXT SEGMENT                         F1B43960
ES0160 LDQ LEFT+2            S(I)=S(0)                                  F1B43970
       LGL 12                                                           F1B43980
       CAS IFSYM             IS THIS AN IF STATEMENT                    F1B43990
       TRA ES0200                                                       F1B44000
       TRA ES1500                                                       F1B44010
ES0200 CAS CALLER            IS THIS A CALL STATEMENT                   F1B44020
       TRA ES0220                                                       F1B44030
       TRA ES1520                                                       F1B44040
ES0220 ARS 6                                                            F1B44050
       LXD ARGCTR,C          IS THIS A FUNCTION STATEMENT               F1B44060
       TXH ES1300,C,0        YES                                        F1B44070
       CAS L(H)              NOT A FUNCTION STATEMENT                   F1B44080
       CAS L(O)                                                         F1B44090
       TRA ES0300                                                       F1B44100
       TRA ES0300                                                       F1B44110
       SLT 4                                                            F1B44120
       TRA ES0870                                                       F1B44130
ES0710 CLA L(STQ)            FX(FLO) PT ON LEFT, FX(FLO) PT ON RIGHT    F1B44140
       SLT 2                                                            F1B44150
ES0730 CLA L(STO)                                                       F1B44160
       STO CW+1                                                         F1B44170
       TSX AC0M60,C          ADDRESS COMPILE VARIABLE ON LEFT           F1B44180
       TSX COMP,B            COMPILE STO/STQ LEFT+2                     F1B44190
       TRA ES1590            EXIT TO FETCH STATE A                      F1B44200
ES0870 SLT 2                 FX PT ON LEFT, FLO PT ON RIGHT             F1B44210
       TRA ES0990                                                       F1B44220
       TSX COMP0C,2          COMPILE    XCA                             F1B44230
ES0990 TSX CIT00,C           COMPILE FIXING INSTRUCTIONS, WHEN          F1B44240
       PZE L(0),,L(UFA)              LOC,,OP-DEC                        F1B44250
       PZE O(,,L(0)                  ADR,,RA-TAG                        F1B44260
       TSX CIT00,C                                                      F1B44270
       PZE L(0),,L(LRS)              LOC,,OP-DEC                        F1B44280
       PZE L(0),,L(0)                ADR,,RA-TAG                        F1B44290
       TSX CIT00,C                                                      F1B44300
       PZE L(0),,L(ANA)              LOC,,OP-DEC                        F1B44310
       PZE O(,,2E18                  ADR,,RA-TAG                        F1B44320
       TSX CIT00,C                                                      F1B44330
       PZE L(0),,L(LLS)              LOC,,OP-TAG                        F1B44340
       PZE L(0),,L(0)                ADR,,RA-TAG                        F1B44350
       TSX CIT00,C                                                      F1B44360
       PZE L(0),,L(ALS)              LOC,,OP-DEC                        F1B44370
       PZE L(0),,DEC18               ADR,,RA-TAG                        F1B44380
       TRA ES0610                                                       F1B44390
ES0300 SLT 4                                                            F1B44400
       TRA ES0710                                                       F1B44410
ES0320 SLT 2                                                            F1B44420
       TRA ES0440                                                       F1B44430
       TSX COMP0C,2          COMPILE    XCA                             F1B44440
ES0440 TSX CIT00,C           COMPILE FLOATING INSTRUCTIONS, WHEN        F1B44450
       PZE L(0),,L(LRS)              LOC,,OP-DEC                        F1B44460
       PZE L(0),,DEC18               ADR,,RA-TAG                        F1B44470
       TSX CIT00,C                                                      F1B44480
       PZE L(0),,L(ORA)              LOC,,OP-DEC                        F1B44490
       PZE O(,,L(0)                  ADR,,RA-TAG                        F1B44500
       TSX CIT00,C                                                      F1B44510
       PZE L(0),,L(FAD)              LOC,,OP-DEC                        F1B44520
       PZE O(,,L(0)                  ADR,,RA-TAG                        F1B44530
ES0610 LXD ARGCTR,C          IS THIS A FUNCTION STATEMENT               F1B44540
       TXL ES0730,C,0        NO                                         F1B44550
ES0630 TSX     PCH2,4         GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX  $F1B44560
       PZE L(0),,L(TRA)              LOC,,OP-DEC                        F1B44570
       PZE L(0),,ABTAG1              ADR,,RA-TAG                        F1B44580
       TRA ES1590            EXIT TO FETCH STATE A                      F1B44590
       REM     **  FUNCTION SUBPROGRAM  **                              F1B44591
ES1300 SUB     L(X)          TEST FIXED OR FLOAT                        F1B44600
       TZE ES1360                                                       F1B44610
       SLT 4                                                            F1B44620
       TRA     ES1380        FLO NAME, FLO RESULT, STORE IT.            F1B44630
       TRA     ES0320        FLO NAME, FIX RESULT, GO FLOAT IT.         F1B44640
ES1360 SLT     4             FIX NAME,                                  F1B44650
       TRA     ES0870        FLO RESULT, GO FIX IT.                     F1B44660
ES1380 SLT     2             FIX NAME, FIX RESULT, STORE IT             F1B44670
       TRA ES0630                                                       F1B44680
       TSX COMP0C,2          COMPILE    XCA                             F1B44690
       TRA ES0630                                                       F1B44700
       REM     **  IF STATEMENT  **                                     F1B44701
ES1500 TRA     PCH4           GO TO PROGRAM TET                        $F1B44710
       TSX     DBCHK,4        GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX  $F1B44720
       REM     **  IF AND CALL STATEMENT  **                            F1B44721
ES1520 SLT 2                                                            F1B44730
       TRA ES1590            EXIT TO FETCH STATE A                      F1B44740
       TSX COMP0C,2          COMPILE    XCA                             F1B44750
ES1590 CLA FNSW                                                         F1B44760
       STZ LEFT+2                                                       F1B44770
       TRA ES1595            TO RESET ARITHMETIC FORTAG FLAG.       (23)F1B44780
       STD CALLNM                                                       F1B44790
       TSX TET00,1           MAKE ENTRY OF FIRST, LAST IFN IN CALL TABLEF1B44800
           16                                                           F1B44810
       TRA CHSIFN                                                       F1B44820
       REM                                                              F1B44830
ESXCA0 CLA SCRIPL-3,1        IS FIRST ELEMENT OF NEXT SEGMENT LEVEL     F1B44840
       PAX ,2                NUMBER, IF NOT XCA IMPOSSIBLE.             F1B44850
       CLA CPBETA,2                                                     F1B44860
       PAC ,4                LENGTH OF NEXT LEVEL TO IR4.               F1B44870
       SXD *+1,4                                                        F1B44880
       TXI *+1,1,**          BUMP IR1 TO BEGINNING OF NEXT SEGMENT.     F1B44890
       CAL SCRIPL+1,1        GET OP1 OF NEXT LEVEL AND TEST FOR ** OR $ F1B44900
       LGR 30                DO NOT COMPILE XCA FOR EITHER CASE.        F1B44910
       SUB SPECOP                                                       F1B44920
       TZE ESXCA1                                                       F1B44930
       TQP *+2                                                          F1B44940
       TRA ESXCA1                                                       F1B44950
       CLA SCRIPL,1          GET TAGWORD OF FIRST ELEMENT OF NEXT SEG-  F1B44960
       TPL ESXCA1            MENT AND TEST FOR SUBSCRIPTED VAR., EXIT IFF1B44970
       REM                   YES.                                       F1B44980
       LDQ SCRIPL+2,1        GET SYMBOL WORD AND TEST FOR LEVEL NUMBER. F1B44990
       LGL 1                                                            F1B45000
       LBT                                                              F1B45010
       TQP *+2                                                          F1B45020
       TRA ESXCA1            ANYTHING OTHER THAN LEVEL NUMBER EXCLUDES  F1B45030
       REM                   XCA, EXIT.                                 F1B45040
       LGL 35                                                           F1B45050
       PAX ,2                                                           F1B45060
       CAL CPBETA,2          IS LEVEL NUMBER BEGINNING THIS SEGMENT     F1B45070
       ANA MASK1             SAME AS LEVEL NUMBER ENDING PREVIOUS SEG-  F1B45080
       SUB PHI(I)            MENT. IF NOT XCA IS EXCLUDED.              F1B45090
       TNZ ESXCA1                                                       F1B45100
       REM                   ALL CONDITIONS HAVE BEEN SATISFIED.        F1B45110
       TSX COMP0C,2          COMPILE  XCA.                              F1B45120
       SLT 2                 TURN LITE I OFF.                           F1B45130
       NOP                                                              F1B45140
       TRA CP0130-1          GO TO NEXT SEGMENT.                        F1B45150
       REM                   SOME CONDITION FAILED, XCA EXCLUDED.       F1B45160
ESXCA1 LXD 3LBAR,1           RELOAD IR1                                 F1B45170
       STZ XCAIND            CLEAR INDICATOR OF LINKED BIT.             F1B45180
       TRA ES0000+8          GO COMPILE STO OR STQ  1(+I                F1B45190
       REM                                                              F1B45200
       REM                                                              F1B45210
OPENSB SXA CP2890,4          SAVE CALLING TAG.                          F1B45220
       CLS CW                1... OPEN SBRTN                            F1B45230
       STO CW                CW TO -CW                                  F1B45240
       CLA SCRIPL-1,A                                                   F1B45250
       STO CW+2                                                         F1B45260
PATF   CAL     L(PZE)        SET OPERATION CODE TO PZE.                 F1B45270
       SLW     CW+1                                                     F1B45280
       TSX COMP,B            COMPILE FUNCTION NAME                      F1B45290
       LXD CP0400,B                                                     F1B45300
       TXL CP2930,B,-9                                                  F1B45310
       CAL ALL1              OPEN UNIVARIATE FUNCTION                   F1B45320
       SLW CW                                                           F1B45330
       CLA SCRIPL+1,A                                                   F1B45340
       LBT                   EXAMINE OP2(S(I))35                        F1B45350
       TRA CP2900            0... ARG STORED                            F1B45360
       ARS 1                 1... ARG NOT STORED                        F1B45370
       LDQ ADPLUS                                                       F1B45380
       LBT                                                              F1B45390
       TRA CP2860                                                       F1B45400
       LDQ ADSTAR                                                       F1B45410
CP2860 STQ CW+2                                                         F1B45420
       STZ CW+3                                                         F1B45430
CP2880 TSX COMP,B            COMPILE ACC OR MQ INDICATOR                F1B45440
CP2890 AXT ..,4              RELOAD CALLING TAG.                        F1B45450
       TRA 1,4               RETURN TO CALLER.                          F1B45460
CP2900 TSX AC0000,C          ADDRESS COMPILE SYM2(S(I))                 F1B45470
       TRA CP2880            GO COMPILE SYM2(S(I))                      F1B45480
CP2930 TSX AC0000,C          OPEN MULTIVARIATE FUNCTION                 F1B45490
       LXD CP0400,B                                                     F1B45500
       TXI CP2960,B,3                                                   F1B45510
CP2960 TXH CP3000,B,-6                                                  F1B45520
       SXD CP0400,B                                                     F1B45530
       TSX COMP,B            COMPILE SYMJ(S(I))                         F1B45540
       TXI CP2930,A,-3                                                  F1B45550
CP3000 CAL ALL1                                                         F1B45560
       SLW CW                                                           F1B45570
       TRA CP2880                                                       F1B45580
       REM                                                              F1B45590
FNIISB SXA CP5780,4          SAVE CALLING TAG.                          F1B45600
       STZ FNSW2             INITIALIZE SUPP IFN SWITCH.            (23)F1B45610
       TRA *+2                                                      (23)F1B45620
FNSW2      ,,**                                                     (23)F1B45630
       LXA L(1),C            INITIALIZE STAIX TO 1                      F1B45640
CP5050 CLA SCRIPL,A          EXAMINE TAGJ(S(I)), J=2,...                F1B45650
       TMI CP8000            NON-SUBSCRIPTED VARIABLE                   F1B45660
       SXD CP5830,B          SUBSCRIPTED-IS THERE A GENERAL TAG         F1B45670
       SXD STACTR,C                                                     F1B45680
       TSX AC0000,C                                                     F1B45690
       CAL TAGPRT                                                       F1B45700
       TNZ CP5220            GENERAL TAG PRESENT                        F1B45710
       CAL CW+3              NO GENERAL TAG PRESENT,SO PLACE            F1B45720
       ARS 11                RELATIVE ADDRESS IN OPJ(S(I))14'28 AND     F1B45730
       ORA NGTBIT            SET OPJ(S(I))10=1 FROM NGTBIT              F1B45740
       ORS SCRIPL+1,A                                                   F1B45750
CP5160 LXD STACTR,C                                                     F1B45760
       LXD CP5830,B                                                     F1B45770
CP5180 TXI CP5190,B,3                                                   F1B45780
CP5190 TXH CP5460,B,-6       FINISHED WITH PRELUDE,IF ANY               F1B45790
       TXI CP5210,C,1        NOT FINISHED-STAIX=STAIX+1                 F1B45800
CP5210 TXI CP5050,A,-3       GO ON TO NEXT ARGUMENT                     F1B45810
CP5220 CAL L(PXA)                                                       F1B45820
       TSX COMPM2,B          COMPILE PXD SYMJ(S(I)), TAGJ(S(I))         F1B45830
       TSX CIT00,C           COMPILE ADD *-2                            F1B45840
       PZE L(0),,L(SUB)              LOC,,OP-DEC                        F1B45850
       PZE PROCTR,,DECMI1            ADR,,RA-TAG                        F1B45860
       LXD EIFNO,C           COMPUTE VALUE OF                       (23)F1B45870
       TXI CP5221,C,1        NEEDED SUPP IFN.                       (23)F1B45880
CP5222 SLW CW+2              STORE IT FOR STA INSTR.                (23)F1B45890
       LXD STACTR,C                                                     F1B45900
       PXD 0,C                                                          F1B45910
       SLW CW+3                                                         F1B45920
       CAL L(STA)                                                       F1B45930
       TSX COMPM2,B          COMPILE STA IFN+STAIX                      F1B45940
       TXI CP5160,0,0        GO ON TO NEXT ARGUMENT,IF ANY              F1B45950
CP5460 LXD 3LBAR,A                                                      F1B45960
       LXD ARGCTR,4          DETERMINE WHETHEN AN ARITHMETIC FUNCTION   F1B45970
       TXL CP5470,4,0        IS BEING COMPILED.                         F1B45980
       TSX COMP0B,2          YES, COMPILE  SXD  7(,4                    F1B45990
       TSX CIT00,C           COMPILE STRING OF ONES FOR SEC. THREE.     F1B46000
       PZE ALL1,,ALL1                                                   F1B46010
       PZE ALL1,,ALL1                                                   F1B46020
       TRA *+2                                                          F1B46030
CP5470 TSX COMP0A,2          NO, COMPILE   SXD  6(+4,4                  F1B46040
CP5520 CAL FNSW2             PICK UP SUPPLEMENTAL IFN               (23)F1B46050
       SLW CW                AND STORE FOR LOCATION FIELD.          (23)F1B46060
       TNZ CP5521            WAS IT NEEDED, YES.                    (23)F1B46070
       CAL SCRIPL+2,A                                                   F1B46080
       SLW CW+2                                                         F1B46090
       TSX CIT00,4           COMPILE                                    F1B46100
       PZE CW,,L(TSX)        TSX   ...,4                                F1B46110
       PZE CW+2,,L(4)                                                   F1B46120
       STZ CW                CLEAR CW OF IFN.                           F1B46130
       CLA L(TSX)            SET OPERATION CODE FOR ARGUMENTS TO TSX.   F1B46140
       STO CW+1                                                         F1B46150
       TXI CP5680,A,-3       POSITION XA TO SYM2(S(I))                  F1B46160
CP5680 CLA SCRIPL,A                                                     F1B46170
       TPL CP5700                                                       F1B46180
CORR08 CLA     MODECL        TEST FOR DOUBLE PRECISION                  F1B46190
       SUB     L(D)                                                     F1B46200
       TZE     DPMD                                                     F1B46210
       SUB     L(5)          OR COMPLEX ARITHMETIC                      F1B46220
       TZE     DPMD                                                     F1B46230
       TSX AC0000,C          NONSUBSCRIPTED                             F1B46240
       TRA     *+2                                                      F1B46250
       REM                                                              F1B46260
 DPMD  TSX     ACDP00,4                                                 F1B46270
STACTR TXI CP5720,0,0                                                   F1B46280
CP5700 LDQ SCRIPL+1,A        SUBSCRIPTED                                F1B46290
       LGL 11                                                           F1B46300
       LBT                                                              F1B46310
       LDQ L(0)              GENERAL TAG PRESENT                        F1B46320
       STQ CW+3              NO GENERAL TAG PRESENT                     F1B46330
       CAL SCRIPL+2,A                                                   F1B46340
       SLW CW+2                                                         F1B46350
CP5720 TSX COMP,B            COMPILE TSX SYMJ(S(I)) , J=2,...           F1B46360
       LXD CP0400,B                                                     F1B46370
       TXI CP5750,B,3                                                   F1B46380
CP5750 TXH CP5780,B,-6       FINISHED SCANNING                          F1B46390
       SXD CP0400,B                                                     F1B46400
       TXI CP5680,A,-3                                                  F1B46410
CP5780 AXT ..,4              RELOAD CALLING TAG.                        F1B46420
       TRA 1,4               RETURN TO CALLER.                          F1B46430
CP8000 LDQ SCRIPL+2,1        THIS ARGUMENT OF A SUBPROGRAM IS NOT A     F1B46440
       STQ G+1               SUBSCRIPTED VARIABLE. TEST WHETHER IT IS A F1B46450
       PXD ,0                SOURCE LANGUAGE FIXED POINT VARIABLE.      F1B46460
       LGL 6                                                            F1B46470
       CAS L(H)              TEST FIRST CHARACTER FOR I,J,K,L,M,N       F1B46480
       CAS L(O)                                                         F1B46490
       TXI CP5180,0,0        NOT FIXED POINT BEGINNING.                 F1B46500
       TXI CP5180,0,0                                                   F1B46510
       PXD ,0                                                           F1B46520
       LGL 6                 TEST SECOND CHARACTER FOR  (  WHICH MEANS  F1B46530
       SUB OPEN              FIXED POINT CONSTANT.                      F1B46540
       TZE     CP5180         DO NOT ENTER IN FORVAL.                   F1B46550
       CLA     LEFT+2        TEST WHETHER THIS FUNCTION IS WITHIN AN    F1B46560
       SUB     IFSYM2        IF(...) STATEMENT.                         F1B46570
       TZE     CP5180         DO NOT ENTER IN FORVAL.                   F1B46580
       CLA CALLNM            ALL TEST SATISFIED, PREPARE TO ENTER THE   F1B46590
       ALS 18                FIRST INTERNAL FORMULA NUMBER AND THE NAME F1B46600
       STO G                 OF THE VARIABLE IN FORVAL.                 F1B46610
       SXD CP8001,1          SAVE IR1.                                  F1B46620
       TSX TET00,1           MAKE FORVAL TABLE ENTRY.                   F1B46630
           6                                                            F1B46640
       LXD CP8001,1          RELOAD IR1.                                F1B46650
CP8001 TXI CP5180,0,**                                                  F1B46660
       REM                                                              F1B46670
       REM ADDRESS COMPLETION SUBROUTINE.                               F1B46680
       REM USING INFORMATION IN SCRIPL TABLE THIS ROUTINE FORMS WORDS 3 F1B46690
       REM AND 4 ( SYMBOL AND ADDEND-TAG WORDS) FOR NEXT CIT ENTRY.     F1B46700
       REM THESE WORDS ARE PLACED IN CW+2 AND CW+3.                     F1B46710
       REM                                                              F1B46720
AC0M60 CLA LEFT              ENTRY POINT FROM END OF SEGMENT ROUTINE.   F1B46730
       STO TAGWRD            MOVE CONTENTS OF LEFT WORDS TO WORKING     F1B46740
       CLA LEFT+1            STORAGE FOR THIS SUBROUTINE.               F1B46750
       STO OPWORD                                                       F1B46760
       CLA LEFT+2                                                       F1B46770
       STO SYMWRD                                                       F1B46780
       TRA AC0060                                                       F1B46790
AC0000 CLA SCRIPL,1          ENTRY POINT FROM COMPILER ROUTINE.         F1B46800
       STO TAGWRD                                                       F1B46810
       CLA SCRIPL+1,1        MOVE SCRIPL TABLE ENTRY TO WORKING STORAGE.F1B46820
       STO OPWORD                                                       F1B46830
       CLA SCRIPL+2,1                                                   F1B46840
       STO SYMWRD                                                       F1B46850
AC0060 CAL TAGWRD            GET TAGS IF ANY                            F1B46860
       SXD ACXR2,2           SAVE IR2                                   F1B46870
       ANA MASK1             EXTRACT TAGS IN ACC.                       F1B46880
       PBT                   SUBSCRIPTED OR NON-SUBSCRIPTED...          F1B46890
       TRA AC0540            SUBSCRIPTED                                F1B46900
       PXD 0,0               NON-SUBSCRIPTED SYMBOL                     F1B46910
       LDQ SYMWRD            GET SYMBOL AND TEST FOR LEVEL NUMBER OR    F1B46920
       LGL 1                 VARIABLE NAME.                             F1B46930
       LBT                                                              F1B46940
       TQP AC0460            SYMBOL IS SOME LEVEL NUMBER  S(K).         F1B46950
       LGL 11                NON-SUBSCRIPTED EX/INTERNAL VARIABLE       F1B46960
       SUB L(A()             IS THIS A FLO PT CONSTANT                  F1B46970
       TZE AC0410            YES                                        F1B46980
       ADD L(A()             NO                                         F1B46990
       SUB L(I()             IS THIS A FIX PT CONSTANT                  F1B47000
       TZE AC0390            YES                                        F1B47010
       ADD L(I()             NO                                         F1B47020
       SUB L(H()             IS THIS A HOLLERITH FIELD                  F1B47030
       TZE AC0350            YES                                        F1B47040
       LDQ     OPWORD       * NON-SUBSCRIPTED EXTERANL VARIABLE         F1B47050
       LGL     13            IS THIS A DUMMY VARIABLE                   F1B47060
       TQP     AC0340        NO, FSIND BIT=0                            F1B47070
       LLS     15            YES,FSIND BIT=1                            F1B47080
       COM                                                              F1B47090
       SUB L(1)              FORM ADDEND FOR ARGUMENT ADDRESS.          F1B47100
       PAX 0,B                                                          F1B47110
       PXD 0,B                                                          F1B47120
       SLW CW+3              STORE ARGUMENT BUFFER RELATIVE ADDRESS     F1B47130
       LXD BK,B                                                         F1B47140
       CAL FORSUB-1,2                                                   F1B47150
       ANA MASK2             EXTRACT FUNCTION STATEMENT TYPE            F1B47160
       ORA P(                FORM 4(I                                   F1B47170
AC0320 SLW CW+2                                                         F1B47180
AC0330 LXD ACXR2,2           RELOAD IR2                                 F1B47190
       TRA 1,C               RETURN                                     F1B47200
AC0340 STZ     CW+3         * NON-SUBSCRIPTED, REAL VARIABLE            F1B47210
       CAL SYMWRD                                                       F1B47220
       TRA AC0320                                                       F1B47230
AC0350 CAL     ADSPOP       * HOLLERITH FIELD                           F1B47240
       TRA AC0420                                                       F1B47250
AC0390 CLA     I(           * FIX PT. CONSTANT, 2) ADDR                 F1B47260
AC0420 STO CW+2                                                         F1B47270
       RQL 6                                                            F1B47280
AC0450 STQ CW+3                                                         F1B47290
       TRA AC0330            GO TO COMMON EXIT.                         F1B47300
AC0410 CLA     A(           * FLO PT. CONSTANT, 3) ADDR                 F1B47310
       TRA AC0420                                                       F1B47320
       REM LEVEL NUMBER                                                 F1B47330
AC0460 LGL 35                SYMBOL IS SOME S(K)                        F1B47340
       PAX ,2                                                           F1B47350
       CAL CPBETA,2                                                     F1B47360
       ANA     MASK1         GET THE PREPARED ADDEND FROM BETA          F1B47370
       SLW CW+3                                                         F1B47380
       CAL     ARERAS        PUT IN AN ADDRESS OF 1)                    F1B47390
       TRA AC0320                                                       F1B47400
       REM SUBSCRIPTED VARIABLE                                         F1B47410
AC0540 SLW TAGWRD                                                       F1B47420
       LDQ TAGWRD                                                       F1B47430
       PXD ,0                CLEAR AC.                                  F1B47440
       LGL 12                I-TAU TAGS TO AC.                          F1B47450
       SLW CW+3              STORE FOR NEXT CIT ENTRY.                  F1B47460
AC0990 TQP AC1000            THERE IS AN I-TAU TAG FOR CURRENT CIT.     F1B47470
       STZ CW+3                                                         F1B47480
       PXD ,0                REPLACE NULL TAG.                          F1B47490
       SLW TAGPRT            SAVE FOR LATER USE.                        F1B47500
       LGL 1                                                            F1B47510
       PXD ,0                CLEAR AC.                                  F1B47520
       LGL 8                 SIGMA TAG TO AC.                           F1B47530
       ADD SIG1IX-1          FORM BASE OF TABLE + SIGMA TAG.            F1B47540
       STA *+1                                                          F1B47550
       CAL **                GET RELATIVE ADDRESS.                      F1B47560
       ORS CW+3              ADD RELATIVE ADDRESS TO I-TAU TAG.         F1B47570
       CAL SYMWRD            VARIABLE NAME FOR NEXT CIT ENTRY.          F1B47580
ACXR2  TXI AC0320,0,**       GO STORE AC AND EXIT.                      F1B47590
       REM                                                              F1B47600
AC1000 LXD ARGCTR,2          TEST WHETHER THIS SUBSCRIPTED VARIABLE IS  F1B47610
       TXL AC1050,2,0        WITHIN AN ARITHMETIC FUNCTION.         (23)F1B47620
ER0071 TSX DIAG,4            YES, THIS IS IN ERROR, GO TO DIAGNOSTIC.   F1B47630
       DUP 1,6                                                      (23)F1B47640
       PZE                   (UNUSED STORAGE)                       (23)F1B47650
AC1050 CAL EIFNO             PREPARE TO MAKE FORTAG                 (23)F1B47700
       ANA MASK1             ENTRY.. CONSISTS OF IFN                (23)F1B47710
       ORA CW+3              IN THE DECREMENT AND TAU TABLE         (23)F1B47720
       SLW G                 POINTER IN THE ADDRESS.                (23)F1B47730
       SXA AC1070,1          SAVE IR1                               (23)F1B47740
       TSX CFTAG,2                                                  (23)F1B47750
AC1070 AXT **,1              RELOAD IR1                                 F1B47760
AC1080 LDQ TAGWRD            RESTORE AC AND MQ TO PREVIOUS CONTENTS.    F1B47770
       PXD ,0                                                           F1B47780
       LGL 12                                                           F1B47790
       TRA AC0990+3          RETURN TO ORIGINAL CODING.                 F1B47800
       REM                                                              F1B47810
       REM                                                              F1B47820
COMPM4 SLW CW+1              STORE SYMBOLIC OPERATION CODE.             F1B47830
COMPM3 TSX AC0000,4                                                     F1B47840
       TRA COMP                                                         F1B47850
COMPM2 SLW CW+1              STORE SYMBOLIC OPERATION CODE.             F1B47860
COMP   TSX CIT00,C           COMPILE CONTENTS OF CW,CW+1,CW+2,CW+3.     F1B47870
       PZE CW,,CW+1                  LOC,,OP-DEC                        F1B47880
       PZE CW+2,,CW+3                ADR,,RA-TAG                        F1B47890
       STZ CW                CLEAR INTERNAL FORMULA NUMBER IF ANY.      F1B47900
       TRA 1,B               RETURN TO CALLER.                          F1B47910
       REM                                                              F1B47920
COMP0A TSX CIT00,4                                                      F1B47930
       PZE CW,,L(SXD)                LOC,,OP-DEC                        F1B47940
       PZE O(,,D4A4                  ADR,,RA-TAG                        F1B47950
       TRA     PCH5           GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX  $F1B47960
       REM                                                              F1B47970
COMP0B TSX CIT00,4           COMPILE   SXD  7(,4                        F1B47980
       PZE     CW,,L(SXD)                                               F1B47990
       PZE X(,,L(4)                                                     F1B48000
       TRA     PCH5           GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX  $F1B48010
       REM                                                              F1B48020
COMP0C TSX CIT00,4                                                      F1B48030
       PZE L(0),,L(XCA)              LOC,,OP-DEC                        F1B48040
       PZE L(0),,L(0)                ADR,,RA-TAG                        F1B48050
       TRA 1,2                                                          F1B48060
       REM                                                              F1B48070
       REM SUBROUTINE TO COMPILE  TSX NAME OF FUNCTION,4                F1B48080
COMTSX TSX  CIT00,4                                                     F1B48090
            L(0),,L(TSX)                                                F1B48100
            CW+2,,L(4)                                                  F1B48110
       TRA  1,2              RETURN TO CALLER.                          F1B48120
       REM                                                              F1B48130
       REM                                                              F1B48140
       REM DOUBLE PRECISION ARITHMETIC COMPILER ROUTINE.                F1B48150
       REM                                                              F1B48160
       REM                                                              F1B48170
CP000D STZ     TRAPCL        RESET INDICATOR OF LAST ROUTINE CALLED     F1B48180
       SXD     CPBETA,0                                                 F1B48190
CP005D LXD     3LBAR,1        GET LENGTH OF REMAINING SCRIPL TABLE.     F1B48200
CP013D CLA SCRIPL-3,1        EXTRACT CURRENT S(I)                       F1B48210
CP014D PAX ,2                                                           F1B48220
       CLA CPBETA,2                                                     F1B48230
       STD PHI(I)            STO ERAS. REL. ADD. IN PHI (I)             F1B48240
       ANA MASK2                                                        F1B48250
CP018D PAX ,2                SAVE LENGTH OF SEGMENT IN DECREMENT        F1B48260
       SXD CP040D,2          FOR LATER BUMPING AND TESTING              F1B48270
       PAC 0,4                                                          F1B48280
       SXD *+1,4                                                        F1B48290
       TXI *+1,1,..          MOVE XA TO 1ST ELEMENT OF CURRENT S(I)     F1B48300
       SXD 3LBAR,1           STORE LEVEL FOR ESR00                      F1B48310
       LDQ SCRIPL+1,1        EXAMINE OP1 (S(I)) 29,30,31,32             F1B48320
       LGL 30                                                           F1B48330
       LBT                                                              F1B48340
       TRA CP031D            OP1 (S(I)) 29 = 0 LINKAGE NOT POSSIBLE     F1B48350
       TQP     CP037D        OP1 (S(I)) 30 = 0 NO SUB EXPRESS TO STO    F1B48360
CP031D SLN 1                 OP1 (S(I)) 29 = 0 OR OP1 (S(I)) 30 = 1, SO F1B48370
CP032D RQL 1                 SET STORE LITE  THEN DECIDE IS AC OR MQ    F1B48380
       TQP CP035D            OP1 (S(I)) 31 = 0, SO SET STO LITE         F1B48390
       SLN 2                 OP1 (S(I)) 31 = 1, SO SET STQ LITE 2 ON    F1B48400
CP035D RQL 1                                                            F1B48410
       TRA CP038D                                                       F1B48420
CP037D RQL 2                                                            F1B48430
CP038D TQP CP042D            TEST OP1 (S(I)) 32                         F1B48440
       SLT 4                 OP1 (S(I)) 32 = 1, SO SET FLPTSW           F1B48450
CP040D TXH     0,0,..        ACTS AS NOP,WITH A USEFUL DECREMENT        F1B48460
       TRA CP043D                                                       F1B48470
       REM                                                              F1B48480
       REM ROUTINE TO COMPILE FIXED POINT + - * / WHEN IN D.P. OR C.A.  F1B48490
       REM MODES.  OP(1) SPECIAL CASE                                   F1B48500
       REM                                                              F1B48510
CP042D SLN 4                 LITE 4 ON FOR FIXED                        F1B48520
       PXD 0,0                                                          F1B48530
       LDQ SCRIPL+1,1        GET OP WORD OF FIRST ENTRY OF LEVEL        F1B48540
       LGL 6                                                            F1B48550
       CAS SPECOP            COMPARE WITH $                             F1B48560
       TRA CP096F            OF IS * OR **                              F1B48570
       TXI CP204D,1,-3       OF IS $                                    F1B48580
       SUB 11Z               OP IS + OR -                               F1B48590
       TZE     CP076F                                                   F1B48600
       LGL     29                                                       F1B48610
       TQP     CP113F             35=0  NO LINKAGE                      F1B48620
       TRA     CP054F             LINKAGE, TEST END OF SEGMENT          F1B48630
CP113F CAL     L(CLA)             NO LINK COMPILE CLA                   F1B48640
CP168F SLW CW+1                                                         F1B48650
       TSX     ACDP00,4      PREPARE CW+2, CW+3                         F1B48660
       TSX     COMP,2        TAKES TO CIT00 AND COMPILES                F1B48670
       REM                                                              F1B48680
CP054F LXD CP040D,2          GET SEGMENT LENGTH                         F1B48690
       TXI *+1,2,3           BUMP IT                                    F1B48700
       TXL ES000D,2,0        TEST END OF SEGMENT                        F1B48710
       SXD CP040D,2          SAVE SEGMENT LENGTH LEFT                   F1B48720
       TXI *+1,1,-3          GET NEXT ELEMENT OF LEVEL                  F1B48730
       PXD 0,0                                                          F1B48740
       LDQ SCRIPL+1,1                                                   F1B48750
       LGL 6                                                            F1B48760
       CAS STAR                                                         F1B48770
       TRA CP120F            OP IS /                                    F1B48780
       TRA CP172F            OP IS *                                    F1B48790
       SUB 11Z               OP IS + OR -                               F1B48800
       TZE CP088F            OP IS -                                    F1B48810
       CAL L(ADD)            OP IS +                                    F1B48820
       TRA CP168F            GO COMPILE ALL                             F1B48830
       REM                                                              F1B48840
CP076F LGL     29                                                       F1B48850
       TQP     CP085F             35 = 0, NO LINKAGE                    F1B48860
       TSX     CIT00,4       COMPILE CHS                                F1B48870
       PZE     L(0),,L(CHS)                                             F1B48880
       PZE     L(0),,L(0)                                               F1B48890
       TRA     CP054F                                                   F1B48900
CP085F CAL     L(CLS)                                                   F1B48910
       TRA     CP168F                                                   F1B48920
       REM                                                              F1B48930
CP088F CAL L(SUB)            OP(4) IS -                                 F1B48940
       TRA CP168F            GO COMPILE SUB                             F1B48950
       REM                                                              F1B48960
CP096F TQP *+2               OP(1) IS * OR **                           F1B48970
       TRA CP414D            CASE OF **                                 F1B48980
       LGL     29                                                       F1B48990
       SLN 3                                                            F1B49000
       LBT                                                              F1B49010
       TRA     CP105F             LEAVE 3 ON                            F1B49020
       SLT     3                  BIT 34 = 1  SO TURN 3 OFF             F1B49030
       NOP                                                              F1B49040
CP105F TQP     CP107F             TEST BIT 35                           F1B49050
       TRA     CP054F             LECEL IS LINKED                       F1B49060
CP107F SLT     3                  TEST 3 FOR AC OR MQ                   F1B49070
       TRA     *+4                                                      F1B49080
       SLN     3                                                        F1B49090
       CAL     L(CLA)             COMPILE CLA                           F1B49100
       TRA     CP168F                                                   F1B49110
       CAL     L(LDQ)             COMPILE LDQ                           F1B49120
       TRA     CP168F                                                   F1B49130
       REM                                                              F1B49140
CP120F SLT 3                                                            F1B49150
       TRA *+4                                                          F1B49160
       TSX CIT00,4           COMPILE LRS 35                             F1B49170
       PZE L(0),,L(LRS)                                                 F1B49180
       PZE L(0),,DEC35                                                  F1B49190
CP145D TSX     ACDP00,4      PREPARE CW+2, CW+3                         F1B49200
       CAL L(DVP)                                                       F1B49210
       TSX     COMPM2,2                                                 F1B49220
       TSX CIT00,4           COMPILE CLM                                F1B49230
       PZE L(0),,L(CLM)                                                 F1B49240
       PZE L(0),,L(0)                                                   F1B49250
       TSX CIT00,4           COMPILE LLS 18                             F1B49260
       PZE L(0),,L(LLS)                                                 F1B49270
       PZE L(0),,DEC18                                                  F1B49280
       TRA CP054F                                                       F1B49290
CP172F SLT 3                                                            F1B49300
       TRA *+2                                                          F1B49310
       TSX COMP0C,2                                                     F1B49320
       SLN 3                                                            F1B49330
       TSX     ACDP00,4      PREPARE CW+2, CW+3                         F1B49340
       CAL L(MPY)                                                       F1B49350
       TSX     COMPM2,2                                                 F1B49360
       TSX CIT00,4                                                      F1B49370
       PZE L(0),,L(ALS)                                                 F1B49380
       PZE L(0),,DEC17                                                  F1B49390
       TRA CP054F                                                       F1B49400
       REM                                                              F1B49410
       REM ROUTINE FOR FLOATING POINT + - * / WHEN IN D.P. OR C.A. MODESF1B49420
       REM                                                              F1B49430
       REM COMPILATION OF BOTH DP AND CA SEGMENT OP(1) FOR + - *        F1B49440
       REM                                                              F1B49450
CP043D TSX     ACDP00,4      PREPARE CW+2, CW+3, DPCW                   F1B49460
       PXD 0,0                                                          F1B49470
       LDQ SCRIPL+1,1        PLACE OP1 (S(I)) IN MQ                     F1B49480
       LGL 6                                                            F1B49490
       CAS SPECOP            WHAT OPERATION                             F1B49500
       TRA CP096D            * OR **                                    F1B49510
       TXI CP204D,1,-3       $ , GET NEXT LEVEL AND PROCEED             F1B49520
       SUB 11Z               OP IS + OR -                               F1B49530
       TZE CP076D            OP IS -                                    F1B49540
       LGL 29                OP1 (S(I)) = + TEST LINKAGE BIT 35         F1B49550
       TQP CP113D            OP1 (S(I)) 35 = 0 NO LINKAGE COMPILE CLA   F1B49560
       TRA     CP054D        LINKAGE, SEE IF END OF SEGMENT             F1B49570
CP076D LGL     29            OP IS -, SO TEST LINKAGE BIT 35            F1B49580
       TQP CP085D            NO LINK SO SKIP                            F1B49590
       TSX CPDCHS,2          COMPILE SEQUENCE FOR BOTH DP AND CA CHS    F1B49600
       TRA CP054D            SINCE LINKED IN AC                         F1B49610
CP085D TSX CPDCLS,2          COMPILE SEQUENCE FOR BOTH DP AND CA CLS    F1B49620
       TRA CP054D                                                       F1B49630
       REM                                                              F1B49640
CP096D TQP *+2               OP IS * OR **                              F1B49650
       TRA CP414D            OP IS **                                   F1B49660
       LGL 29                OP1 (S(I)) = *                             F1B49670
       SLN 3                 TURN LITE 3 ON NEEDS MULTIPLIER IN MQ      F1B49680
       LBT                   TEST OP1 (S(I)) 34 1= PREV LEVEL TYPE AC   F1B49690
       TRA CP105D            OP1 (S(I)) 34 = 0, SO LEAVE LITE 3 ON      F1B49700
       SLT 3                 OP1 (S(I)) 34 = 1, SO TURN LITE 3 OFF      F1B49710
       NOP                                                              F1B49720
CP105D TQP CP107D            BIT 35 = 0                                 F1B49730
       TRA CP054D            OP1 (S(I)) 35 = 1, SO GO MODIFY J          F1B49740
CP107D SLT 3                                                            F1B49750
       TRA     *+4                                                      F1B49760
       SLN 3                 EL1 (S(II) TO ACC                          F1B49770
CP113D TSX CPDCLA,2          COMPILE SEQUENCE FOR BOTH DP AND CA CLA    F1B49780
       TRA CP054D                                                       F1B49790
       TSX CPDLDQ,2          COMPILE SEQUENCE FOR BOTH DP AND CA LDQ    F1B49800
       REM                                                              F1B49810
       REM COMPILATION OF DP SEGMENT OP(2) THRU OP(N) FOR + - * /       F1B49820
       REM                                                              F1B49830
CP054D LXD CP040D,2          OP1 (S(I)) 35 = 1 OBTAIN SEGMENT LENGTH    F1B49840
       TXI *+1,2,3           BUMP IT                                    F1B49850
       TXL ES000D,2,0        GO TO END-OF-SEGMENT SBRTN                 F1B49860
       SXD CP040D,2          STORE CURRENT SEGMENT LENGTH               F1B49870
       TXI *+1,1,-3                                                     F1B49880
       TSX     ACDP00,4      PREPARE CW+2, CW+3, DPCW                   F1B49890
       LDQ SCRIPL+1,1        PLACE OPJ (S(I)) IN MQ                     F1B49900
       CLA MODECL                                                       F1B49910
       SUB L(I)              TEST FOR COMPLEX ARITHMETIC                F1B49920
       TZE CP059I            GO TO COMPLEX ROUTINE                      F1B49930
       PXD 0,0                                                          F1B49940
       LGL 6                                                            F1B49950
       CAS STAR                                                         F1B49960
       TRA CP120D            OPJ (S(I)) = /                             F1B49970
       TRA CP172D            OPJ (S(I)) = *                             F1B49980
       SUB 11Z                                                          F1B49990
       TZE CP088D            OPJ (S(I)) = -                             F1B50000
       TSX CPDFAD,2          GO COMPILE DP FAD SEQUENCE                 F1B50010
       TRA CP054D            GO TO NEXT ELEMENT IN SEGMENT.             F1B50020
       REM                                                              F1B50030
CP088D TSX CPDFSB,2          COMPILE SEQUENCE FOR DP FSB                F1B50040
       TRA CP054D            GO TO NEXT ELEMENT IN SEGMENT              F1B50050
       REM                                                              F1B50060
CP120D SLT 3                 OPJ (S(I)) = / DIVIDEND MUST BE IN AC      F1B50070
       TSX CPMQAC,2          COMPILE SEQUENCE TO MAVE MQ TO AC          F1B50080
       TSX CPDFDP,2          COMPILE SEQUENCE FOR DP FDP                F1B50090
       TRA CP054D            LEAVE THREE OFF FOR RESULT IS IN MQ        F1B50100
       REM                                                              F1B50110
CP172D SLT 3                 OPJ(S(I))=*                                F1B50120
       TRA *+2               PREVIOUS RESULT IN MQ                      F1B50130
       TSX CPACMQ,2          COMPILE SEQUENCE TO MOVE AC TO MQ          F1B50140
       SLN 3                 TURN THREE ON BECAUSE RESULT IN AC         F1B50150
       TSX CPDFMP,2          COMPILE SEQUENCE FOR DP FMP                F1B50160
       TRA CP054D                                                       F1B50170
       REM                                                              F1B50180
       REM COMPILATION OF CA SEGMENT OP(2) THRU OP(N) FOR + - * /       F1B50190
       REM                                                              F1B50200
CP059I LGL 6                                                            F1B50210
       CAS STAR                                                         F1B50220
       TRA CP120I                                                       F1B50230
       TRA CP172I                                                       F1B50240
       LXD     CP040D,2      GET SEGMENT LENGTH                         F1B50250
       SXA     CP054I,2      SAVE IT FOR LATER BUMPING AND TESTING      F1B50260
       SXA     CP154I,2                                                 F1B50270
       SXA     CP160I-1,1    SAVE IR(1) TO MOVE THROUGH SCRIPL AGAIN    F1B50280
       PAX     0,2           SAVE PLUS OR MINUS                         F1B50290
       TSX     CIT00,4       COMPILE CLA REAL PART                      F1B50300
       PZE     L(0),,L(CLA)                                             F1B50310
       PZE     P(,,L(0)                                                 F1B50320
       PXA     0,2           RETRIEVE + OR -                            F1B50330
CP087I SUB     11Z           TEST                                       F1B50340
       TZE     CP088I        OP IS -                                    F1B50350
       TSX     CIT00,4       OP IS +, COMPILE FAD                       F1B50360
       PZE     L(0),,L(FAD)                                             F1B50370
       PZE     CW+2,,CW+3                                               F1B50380
       TRA     CP054I                                                   F1B50390
CP088I TSX     CIT00,4       COMPILE FSB                                F1B50400
       PZE     L(0),,L(FSB)                                             F1B50410
       PZE     CW+2,,CW+3                                               F1B50420
CP054I AXT     0,2           PICK UP SEGMENT LENGTH                     F1B50430
       TXI     *+1,2,3       BUMP IT                                    F1B50440
       TXL     CP254I,2,0    TIME TO START IMAG.                        F1B50450
       SXA     CP054I,2      SAVE LENGTH AGAIN                          F1B50460
       TXI     *+1,1,-3      MOVE TO NEXT ELEMENT                       F1B50470
       TSX     ACDP00,4       GET NEXT ADDRESS.                         F1B50480
       LDQ     SCRIPL+1,1    GET OP(N)                                  F1B50490
       PXD     0,0           PREPARE TO TEST FOR + OR -                 F1B50500
       LGL     6                                                        F1B50510
       TRA     CP087I                                                   F1B50520
CP254I TSX     CIT00,4       STORE REAL RESULT                          F1B50530
       PZE     L(0),,L(STO)                                             F1B50540
       PZE     P(,,L(0)                                                 F1B50550
       TSX     CIT00,4       START IMAGINARY PART                       F1B50560
       PZE     L(0),,L(CLA)                                             F1B50570
       PZE     P(,,DECMI1                                               F1B50580
       AXT     0,1           RESTORE IR(1) TO OP(2)                     F1B50590
CP160I TSX     ACDP00,4      PREPARE IMAGINARY ADDRESS                  F1B50600
       LDQ     SCRIPL+1,1    GET OP(N)                                  F1B50610
       PXD     0,0           TEST FOR + OR -                            F1B50620
       LGL     6                                                        F1B50630
       SUB     11Z                                                      F1B50640
       TZE     CP188I        OP IS -                                    F1B50650
       TSX     CIT00,4       OP IS +, COMPILE FAD                       F1B50660
       PZE     L(0),,L(FAD)                                             F1B50670
       PZE     CW+2,,DPCW                                               F1B50680
       TRA     CP154I                                                   F1B50690
CP188I TSX     CIT00,4       COMPILE FSB                                F1B50700
       PZE     L(0),,L(FSB)                                             F1B50710
       PZE     CW+2,,DPCW                                               F1B50720
CP154I AXT     0,2           GET SEGMENT LENGTH                         F1B50730
       TXI     *+1,2,3       BUMP IT                                    F1B50740
       TXL     CP255I,2,0    FINISHED WITH IMAG.                        F1B50750
       SXA     CP154I,2      NO SAVE LENGTH AGAIN                       F1B50760
       TXI     CP160I,1,-3   MOVE THROUGH SCRIPL                        F1B50770
CP255I TSX     CIT00,4       STORE IMAGINARY RESULT                     F1B50780
       PZE     L(0),,L(STO)                                             F1B50790
       PZE     P(,,DECMI1                                               F1B50800
       TRA     ES000D                                                   F1B50810
       REM                                                              F1B50820
CP120I SLT 3                                                            F1B50830
       TSX CPMQAC,2          COMPILE SEQUENCE TO MOVE FROM MQ TO AC     F1B50840
       TSX CPIFDP,2          COMPILE SEQUENCE FOR CA FDP                F1B50850
       TRA CP054D                                                       F1B50860
       REM                                                              F1B50870
CP172I SLT 3                                                            F1B50880
       TRA *+2                                                          F1B50890
       TSX CPACMQ,2          COMPILE SEQUENCE TO MOVE FROM AC TO MQ.    F1B50900
       SLN 3                                                            F1B50910
       TSX CPIFMP,2          COMPILE SEQUENCE FOR CA FMP                F1B50920
       TRA CP054D                                                       F1B50930
       REM                                                              F1B50940
       REM FUNCTION LEVEL                                               F1B50950
       REM FIRST DETERMINE TYPE OF FUNCTION                             F1B50960
       REM                                                              F1B50970
CP204D TRA     P1B00B        GO TO PATCH                               *F1B50980
       LBT                   TEST OP1(S(I))12                           F1B50990
       TQP CP265D            LIB OR OPEN FUNCTION                       F1B51000
       TQP CP500D            FN-FUNCTION                                F1B51010
       PXD 0,0               FS-FUNCTION                                F1B51020
       LLS 15                PUT TYPE NO IN ADD(ACC)                    F1B51030
       ORA P(                FORM 4...TYPE NO.                          F1B51040
       SLW     ARGORG                                                   F1B51050
       ANA MASK2                                                        F1B51060
       ORA X(                                                           F1B51070
       SLW XRSAVE                                                       F1B51080
       STZ     COUNT2                                                   F1B51090
       CLA     2E18                                                     F1B51100
       STO     COUNT1                                                   F1B51110
       CAL     SCRIPL-1,1    GET FUNCTION NAME                          F1B51120
       ARS     30                                                       F1B51130
       SUB     L(X)          AND TEST FOR FIXED POINT BEGINNING         F1B51140
       TNZ     *+2                                                      F1B51150
ERDP02 TSX DIAG,4                                                       F1B51160
       CLA     SCRIPL+1,1                                               F1B51170
       LBT                   EXAMINE OP2(S(I))35                        F1B51180
       TRA CP215D            1ST ARG STORED                             F1B51190
       REM FIRST ARGUMENT IS IN PSEUDO-AC                               F1B51200
       CLA     P(                                                       F1B51210
       STO     CW+2                                                     F1B51220
       STZ     CW+3                                                     F1B51230
       CLA     DECMI1                                                   F1B51240
       STO     DPCW                                                     F1B51250
       TSX     CPDARG,2      COMPILE SEQUENCE TO MOVE ARGUMENT 1        F1B51260
       TRA     CP220D        CONTINUE TO ARGUMENT 2                     F1B51270
       REM FIRST ARGUMENT IS STORED                                     F1B51280
CP215D TSX     ACDP00,4      PREPARE CW+2, CW+3, DPCW                   F1B51290
       TSX     CPDARG,2      COMPILE SEQUENCE TO MOVE ARGUMENT 1        F1B51300
CP220D STZ     CW            CLEAR CW OF IFN IF ANY.                    F1B51310
       LXD     CP040D,2                                                 F1B51320
       TXI     *+1,2,6                                                  F1B51330
       TXL     CP250D,2,0    EXIT IF ONLY ONE ARGUMENT                  F1B51340
       SXD     CP040D,2                                                 F1B51350
       TXI     *+1,1,-3      MOVE TO SECOND ARGUMENT                    F1B51360
       REM                                                              F1B51370
       CLA     SCRIPL+1,1    GET OP WORD                                F1B51380
       LBT                                                              F1B51390
       TRA     CP230D                                                   F1B51400
       REM SECOND ARGUMENT IS IN PSEUDO-MQ                              F1B51410
       CLA     P(                                                       F1B51420
       STO     CW+2                                                     F1B51430
       CLA     DECMI2                                                   F1B51440
       STO     CW+3                                                     F1B51450
       CLA     DECMI3                                                   F1B51460
       STO     DPCW                                                     F1B51470
       TSX     CPDARG,2      COMPILE SEQUENCE TO MOVE ARGUMENT 2        F1B51480
       TRA     CP235D        CONTINUE TO ARGUMENT 3                     F1B51490
       REM SECOND ARGUMENT IS STORED                                    F1B51500
CP230D TSX     ACDP00,4      PREPARE CW+2, CW+3, DPCW                   F1B51510
       TSX     CPDARG,2      COMPILE SEQUENCE TO MOVE ARGUMENT 2        F1B51520
       REM                                                              F1B51530
CP235D LXD     CP040D,2                                                 F1B51540
       TXI     *+1,2,3                                                  F1B51550
       TXL     CP250D,2,0    EXIT IF ONLY TWO ARGUMENTS                 F1B51560
       SXD     CP040D,2                                                 F1B51570
       REM ARGUMENTS 3 THRU N ARE ALWAYS STORED                         F1B51580
       TXI     CP230D,1,-3   COMTINUE WITH REST OF ARGUMENTS            F1B51590
       REM                                                              F1B51600
       REM FINISHED WITH ARGUMENTS                                      F1B51610
CP250D LXD     3LBAR,1                                                  F1B51620
       CAL     SCRIPL+2,1    GET NAME OF FUNCTION                       F1B51630
       SLW     CW+2                                                     F1B51640
       LXD     ARGCTR,4                                                 F1B51650
       TXL     CP260D,4,0                                               F1B51660
       REM WITHIN AN ARITHMETIC STATEMENT FUNCTION                      F1B51670
       TSX     PCH2,4         GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX  $F1B51680
       PZE     L(0),,L(SXD)                                             F1B51690
       PZE     XRSAVE,,L(4)                                             F1B51700
       TSX     COMTSX,2                                                 F1B51710
       TSX     FLTR00,4                                                 F1B51720
       PZE     L(0),,L(LXD)                                             F1B51730
       PZE     XRSAVE,,L(4)                                             F1B51740
       TRA     ES000D        GO TO END-OF-SEGMENT ROUTINE               F1B51750
       REM NOT WITHIN AN ARITHMETIC STATEMENT FUNCTION                  F1B51760
CP260D TSX     COMP0A,2      COMPILE  SXD  6)+4,4                       F1B51770
       TSX     COMTSX,2      COMPILE  TSX  NAME,4                       F1B51780
       TSX     FLTR00,4                                                 F1B51790
       PZE     L(0),,L(LXD)                                             F1B51800
       PZE     O(,,D4A4                                                 F1B51810
       TRA     ES000D        GO TO END-OF-SEGMENT ROUTINE               F1B51820
       REM                                                              F1B51830
CP265D LGL     20                                                       F1B51840
       TQP     CP306D        FOR LIBRARY FUNCTIONS, TRANSFER            F1B51850
       LXD     CP040D,4      GET SEGMENT LENGTH                         F1B51860
       SXD     CP0400,4      STORE IT AND GO TO NORMAL FORTRAN          F1B51870
       TSX     OPENSB,4      FOR OPEN SUBROUTINES                       F1B51880
       TRA     ES000D        GO TO END-OF-SEGMENT ROUTINE               F1B51890
       REM                                                              F1B51900
       REM CLOSED (LIBRARY) FUNCTIONS                                   F1B51910
CP306D CAL     P(                                                       F1B51920
       SLW     ARGORG                                                   F1B51930
       CLS     L(0)                                                     F1B51940
       STO     COUNT1                                                   F1B51950
       CLS     2E18                                                     F1B51960
       STO     COUNT2                                                   F1B51970
       CLA     SCRIPL+1,1                                               F1B51980
       LBT                                                              F1B51990
       TRA     CP354D                                                   F1B52000
       REM ARGUMENT 1 IS IN PSEUDO-AC                                   F1B52010
       TSX     DARG02,2      BUMP COUNT WORDS FOR ARG SKIPPED           F1B52020
       TRA     CP356D        CONTINUE TO ARGUMENT 2                     F1B52030
       REM ARGUMENT 1 IS STORED                                         F1B52040
CP354D TSX     ACDP00,4      PREPARE CW+2, CW+3, DPCW                   F1B52050
       TSX     CPDARG,2      COMPILE SEQUENCE TO MOVE ARGUMENT 1        F1B52060
       REM                                                              F1B52070
CP356D LXD     CP040D,2                                                 F1B52080
       STZ     CW            CLEAR IFN IF ANY                           F1B52090
       TXI     *+1,2,6                                                  F1B52100
       TXL     CP310D,2,0    EXIT IF ONLY ONE ARGUMENT.                 F1B52110
       SXD     CP040D,2                                                 F1B52120
       TXI     CP349D,1,-3   MOVE TO ARGUMENT 2                     (22)F1B52130
       DUP     1,5                                                  (22)F1B52140
       PZE                   (NOT USED)                             (22)F1B52150
CP349D TSX     ACDP00,4      PREPARE CW+2, CW+3, DPCW                   F1B52210
       TSX     CPDARG,2      COMPILE SEQUENCE TO MOVE ARGUMENT 2        F1B52220
       REM                                                              F1B52230
CP328D LXD     CP040D,2                                                 F1B52240
       TXI     *+1,2,3                                                  F1B52250
       TXL     CP310D,2,0    EXIT IF ONLY TWO ARGUMENTS                 F1B52260
       SXD     CP040D,2                                                 F1B52270
       REM ARGUMENT 3 THRU ARGUMENT N ARE STORED.                       F1B52280
       TXI     CP349D,1,-3                                              F1B52290
       REM FINISHED WITH ARGUMENTS                                      F1B52300
CP310D LXD     3LBAR,1                                                  F1B52310
       CAL     SCRIPL+2,1    GET FUNCTION NAME                          F1B52320
       SLW     CW+2                                                     F1B52330
       LAS     DABS                                                     F1B52340
       TRA     *+2                                                      F1B52350
       TRA     CPDABS        COMPILE DABS SEQUENCE IN LINE              F1B52360
       LAS     DSIGN                                                    F1B52370
       TRA     *+2                                                      F1B52380
       TRA     CDSIGN        COMPILE DSIGN SEQUENCE IN LINE             F1B52390
       TRA     *+6                                                  (22)F1B52400
DARG05 AXT     **,2          OPERAND LEVEL FOUND                    (22)F1B52410
       CAL     SCRIPL+1,4    FROM OP OF FIRST ENTRY                 (22)F1B52420
       ARS     3                                                    (22)F1B52430
       TRA     DARG06                                               (22)F1B52440
       PZE                   (NOT USED)                             (22)F1B52450
       LAS     DFLOAT                                                   F1B52460
       TRA     *+2                                                      F1B52470
       TRA     CDFLOT        COMPILE SEQUENCE FOR DFLOAT IN LINE        F1B52480
       LAS     IFLOAT                                                   F1B52490
       TRA     *+2                                                      F1B52500
       TRA     CDFLOT        COMPILE SAME SEQUENCE FOR IFLOAT AS DFLOAT F1B52510
       LAS     ISIGN          COMPARE NAME TO ISIGN.                    F1B52511
       TRA     *+2                                                      F1B52512
       TRA     CISIGN        *COMPILE SEQUENCE FOR ISIGN IN-LINE.       F1B52513
       NOP                   IF MORE OPEN SUBROUTINES ARE ADDED, THIS   F1B52520
       REM                   PROVIDES SPACE FOR A TRANSFER TO THE TEST. F1B52530
       REM                                                              F1B52540
       LXD     ARGCTR,4      IS THIS IN AN ASF                          F1B52550
       TXL     CP320D,4,0    NO WILL TRANSFER                           F1B52560
       REM WITHIN AN ARITHMETIC STATEMENT FUNCTION.                     F1B52570
       TSX     COMP0B,2      COMPILE  SXD  7),4                         F1B52580
       TSX     COMTSX,2      COMPILE A TSX                              F1B52590
       TRA     CP501D        COMPILE LXD 7),4                           F1B52600
       REM NOT WITHIN AN ARITHMETIC STATEMENT FUNCTION                  F1B52610
CP320D TSX     COMP0A,2      COMPILE SXD 6)+4,4                         F1B52620
       TSX     COMTSX,2      COMPILE TSX                                F1B52630
       TRA     CP502D        COMPILE LXD 6)+4,4                         F1B52640
       REM                                                              F1B52650
DOPSUB PZE     7              DOPSUB TABLE, NUMBER OF ENTRIES.          F1B52660
       REM                   OF ENTRIES FOR INDEXING SEARCH.            F1B52670
DSIGN  BCD 1DSIGN                                                       F1B52680
DABS   BCD 1DABS                                                        F1B52690
       BCI     1,XXXXXX      TABLE ENTRY DELETED                    (22)F1B52700
       BCI     1,XXXXXX      TABLE ENTRY DELETED                    (22)F1B52710
IFLOAT BCD 1IFLOAT                                                      F1B52720
DFLOAT BCD 1DFLOAT                                                      F1B52730
ISIGN  BCI     1,ISIGN                                                  F1B52731
       BSS     5             PATCH SPACE FOR ADDING DOPSUB NAMES        F1B52740
       REM                                                              F1B52750
       REM CASE OF **                                                   F1B52760
CP414D LGL 30                POSITION BIT WHICH INDICATES BASE IN AC.   F1B52770
       LDQ SCRIPL+1,1        DETERMINE IF BASE IS FIXED OR FLOATING.    F1B52780
       RQL 32                                                           F1B52790
       TQP *+2                                                          F1B52800
       TRA CP447D            BASE IS FLOATING.                          F1B52810
       LBT                   BASE IS FIXED.                             F1B52820
       TRA CP486D            BASE NOT IN AC.                            F1B52830
       TXI     *+1,1,-3      MOVE IR1 TO EXPONENT                       F1B52840
CP444D TSX     ACDP00,4      PREPARE CW+2,CW+3, DPCW                    F1B52850
       CAL     L(LDQ)        COMPILE LDQ OF BASE                        F1B52860
       TSX     COMPM2,2                                                 F1B52870
CP448D CLA     SCRIPL+1,1    GET OP WORD                                F1B52880
       LGR     4                                                        F1B52890
       TQP     *+2           TEST FOR FIXED OR FLOATING EXPONENT        F1B52900
       TRA     MC0310+2      FIXED BASE FLOATING EXPONENT ILLEGAL       F1B52910
       CLA FXFX              PREPARE TO COMPILE  TSX  EXP(1             F1B52920
CP449D STO G                                                            F1B52930
       LXD ARGCTR,4          DETERMINE IF IN AN ARITHMETIC FUNCTION     F1B52940
       TXH     SXTRP,4,0                                                F1B52950
       TSX     PCH9,2         IF NOT COMPILE SXD 6)+4,4                $F1B52960
CP473D TSX CIT00,4           COMPILE  TSX EXP(1 OR DEXP(2 OR DEXP(3     F1B52970
       PZE L(0),,L(TSX)                                                 F1B52980
       PZE G,,L(4)                                                      F1B52990
       TSX TET00,1                                                      F1B53000
       PZE 9                                                            F1B53010
       LXD     ARGCTR,4                                                 F1B53020
       TXH     CP501D,4,0                                               F1B53030
       TRA     CP502D                                                   F1B53040
       TRA CP501D                                                       F1B53050
 SXTRP TSX     PCH10,2        COMPILE SXD 7)                           $F1B53060
       TRA     CP473D                                                   F1B53070
CP486D TSX     ACDP00,4      PREPARE CW+2, CW+3, DPCW                   F1B53080
       CAL L(CLA)            BASE NOT IN AC, COMPILE CLA OF BASE.       F1B53090
       TSX     COMPM2,2                                                 F1B53100
       TXI     *+1,1,-3                                                 F1B53110
       CLA     SCRIPL+1,1                                               F1B53120
       LBT                                                              F1B53130
       TRA CP444D            EXPONENT NOT IN MQ,                        F1B53140
       TRA CP448D            EXPONENT IN MQ.                            F1B53150
CP447D LBT                   FLOATING BASE.                             F1B53160
       TRA CP450D            BASE IN CORES.                             F1B53170
CP460D LDQ SCRIPL+4,1                                                   F1B53180
       RQL 32                                                           F1B53190
       TQP CP470D            EXPONENT IS FIXED POINT.                   F1B53200
CP461D TXI *+1,1,-3                                                     F1B53210
       TSX     ACDP00,4      PREPARE  CW+2, CW+3, DPCW                  F1B53220
       TSX     CPDLDQ,2      COMPILE SEQUENCE TO LOAD PSEUDO-MQ         F1B53230
CP465D CLA     MODECL                                                   F1B53240
       SUB     L(I)          TEST FOR CA MODE                           F1B53250
       TNZ     *+3                                                      F1B53260
       TRA     ICM6                                                    $F1B53270
       TRA     CP449D                                                   F1B53280
       CLA     DFLFL                                                    F1B53290
       TRA     CP449D                                                   F1B53300
CP450D TSX     ACDP00,4      PREPARE  CW+2, CW+3, DPCW                  F1B53310
       TSX     CPDCLA,2      COMPILE SEQUENCE TO LOAD PSEUDO-AC         F1B53320
       LDQ SCRIPL+4,1        POSITION BIT WHICH INDICATES THAT EXPONENT F1B53330
       RQL 32                IS FIXED OR FLOATING TO S OF MQ.           F1B53340
       CLA SCRIPL+4,1                                                   F1B53350
       LBT                                                              F1B53360
       TRA CP455D                                                       F1B53370
       TQP CP471D            FIXED EXPONENT IN AC.                      F1B53380
       TRA CP465D            FLOATING EXPONENT IN PSEUDO AC.            F1B53390
CP455D TQP CP470D            FIXED POINT EXPONENT IN CORES.             F1B53400
       TRA CP461D            FLOATING EXPONENT IN CORES.                F1B53410
CP470D TXI *+1,1,-3                                                     F1B53420
       TSX     ACDP00,4      PREPARE CW+2, CW+3, DPCW                   F1B53430
       CAL L(LDQ)            FIXED EXPONENT, COMPILE LDQ                F1B53440
       TSX     COMPM2,2                                                 F1B53450
CP471D CLA     MODECL                                                   F1B53460
       SUB     L(I)          TEST FOR CA MODE                           F1B53470
       TNZ     *+3                                                      F1B53480
       CLA     IFLFX                                                    F1B53490
       TRA     CP449D                                                   F1B53500
       CLA     DFLFX                                                    F1B53510
       TRA     CP449D                                                   F1B53520
       REM                                                              F1B53530
DFLFX  BCD 1DEXP(2                                                      F1B53540
DFLFL  BCD 1DEXP(3                                                      F1B53550
IFLFX  BCD 1IEXP(2                                                      F1B53560
IFLFL  BCD 1IEXP(3                                                      F1B53570
       REM                                                              F1B53580
       REM                                                              F1B53590
CP500D LXD     CP040D,2                                                 F1B53600
       SXD     CP0400,2                                                 F1B53610
       STZ     TRAPCL        WHO KNOWS WHAT CHANGES LURK IN A SUBPROGRAMF1B53620
       TSX     FNIISB,4      COMPILE CALLING SEQUENCE FOR SUBPROGRAMS   F1B53630
       LXD     ARGCTR,4                                                 F1B53640
       TXL     CP502D,4,0                                               F1B53650
       REM WITHIN AN ARITHMETIC STATEMENT FUNCTION                      F1B53660
CP501D TSX     FLTR00,4                                             (33)F1B53670
       PZE     L(0),,L(LXD)                                             F1B53680
       PZE     X(,,L(4)                                                 F1B53690
       TRA     ES000D                                                   F1B53700
       REM NOT WITHIN AN ARITHMETIC STATEMENT FUNCTION                  F1B53710
CP502D TSX FLTR00,4                                                     F1B53720
       PZE L(0),,L(LXD)                                                 F1B53730
       PZE O(,,D4A4                                                     F1B53740
       REM                                                              F1B53750
       REM END OF SEGMENT ROUTINE                                       F1B53760
       REM                                                              F1B53770
ES000D LXD     3LBAR,1       GET INDEX TO FIRST ELEMENT OF CURRENT LEVELF1B53780
       CAL     SCRIPL,1      GET TAGWORD OF FIRST ELEMENT OF LEVEL      F1B53790
       ANA     MASK2                                                    F1B53800
       TZE     ES016D        ZERO IS LAST OF EQUAL SIGN RIGHT           F1B53810
       CLA     ARERAS                                                   F1B53820
       STO     CW+2          PREPARE ADDRESS AND ADDEND FOR             F1B53830
       CLA     PHI(I)        POSSIBLE COMPILATION OF STO (STQ) BETWEEN  F1B53840
       ALS     1             LEVELS.                                    F1B53850
       STO     DPCW                                                     F1B53860
       ADD     2E18                                                     F1B53870
       STO     CW+3                                                     F1B53880
       SLT     4                                                        F1B53890
       TRA     ES010D        TO FLOATING POINT LEVEL                    F1B53900
       SLT     1             LEVEL IS FIXED POINT, TEST LINKAGE     (22)F1B53910
       TRA     CP005D        LEVEL LINKED AND NOT CS                (22)F1B53920
       CAL     L(STQ)        STORE NEEDED, PREPARE STQ              (22)F1B53930
       SLT     2             IS RESULT IN MQ                        (22)F1B53940
       CAL     L(STO)        NO, MAKE IT STO                        (22)F1B53950
       TSX     COMPM2,2      COMPILE IT                             (22)F1B53960
       TRA     CP005D        GO TO NEXT LEVEL                       (22)F1B53970
       REM                                                          (22)F1B53980
DARG06 LBT                   DETERMINE TYPE                         (22)F1B53990
       TRA     DARGFX        FIXED                                  (22)F1B54000
       CAL     SCRIPL+1,1    IS THERE LINKAGE                       (22)F1B54010
       LBT                                                          (22)F1B54020
       TRA     DARGFL        NO, COMPILE FLOATING ARGUMENT          (22)F1B54030
       CAL     ARGORG        YES, IS IT LIBRARY                     (22)F1B54040
       ERA     P(            OR OPEN FUNCTION                       (22)F1B54050
       TZE     DARG02        NO                                     (22)F1B54060
       TRA     DARGFL        YES, COMPILE FLOATING ARGUMENT         (22)F1B54061
DARGFX AXT     L(STQ),4      YES, PREPARE TO COMPILE                (22)F1B54070
       NZT     COUNT1        STQ, BUT IS IT FIRST ARGUMENT          (22)F1B54080
       AXT     L(STO),4      YES, PREPARE FOR CLA                   (22)F1B54090
       SXD     DARG08,4      INITIALIZE CIT CELL                    (22)F1B54100
       CAL     SCRIPL+1,1    GET OP WORD                            (22)F1B54110
       LBT                   DOES LINKAGE EXIST                     (22)F1B54120
       TRA     DARG09        NO, COMPILE CLA                        (22)F1B54130
       CAL     ARGORG        IS ARG FOR LIBRARY OR                  (22)F1B54140
       ERA     P(            OPEN FUNCTION                          (22)F1B54150
       TNZ     DARG07        STORE IF NOT                           (22)F1B54160
       NZT     COUNT1        IS IT FIRST ARGUMENT                   (22)F1B54170
       TRA     DARG02        DONT STORE IF YES                      (22)F1B54180
DARG07 TSX     CIT00,4       STORE FUNCTION ARGUMENT                (22)F1B54190
DARG08         L(0),,**                                             (22)F1B54200
               ARGORG,,COUNT1                                       (22)F1B54210
       TRA     DARG02        UPDATE COUNTS                          (22)F1B54220
DARG09 AXT     L(LDQ),4      IF NOT FIRST ARGUMENT                  (22)F1B54230
       NZT     COUNT1        COMPILE LDQ                            (22)F1B54240
       AXT     L(CLA),4      OTHERWISE COMPILE CLA                  (22)F1B54250
       SXD     *+2,4         FOR UNLINKED                           (22)F1B54260
       TSX     CIT00,4       FIXED POINT ARGUMENT                   (22)F1B54270
               CW,,**                                               (22)F1B54280
               CW+2,,CW+3                                           (22)F1B54290
       TRA     DARG07                                               (22)F1B54300
       REM                                                              F1B54310
ES010D SLT     1                                                        F1B54320
       TRA     CP013D        LEVEL IS LINKED, GO TO NEXT LEVEL.         F1B54330
       SLT     2                                                        F1B54340
       TRA     *+3                                                      F1B54350
       TSX     CPDSTQ,2      COMPILE SEQUENCE FOR DP AND CA STQ         F1B54360
       TRA     CP013D        GO TO NEXT LEVEL.                          F1B54370
       TSX     CPDSTO,2      COMPILE SEQUENCE FOR DP AND CA STO         F1B54380
       TRA     CP013D        GO TO NEXT LEVEL.                          F1B54390
       REM                                                              F1B54400
       REM                                                              F1B54410
       REM SCRIPL ENTRIES COMPLETED, NOW COMPILE TERMINAL CITS FOR LEFT F1B54420
       REM OF EQUAL SIGN.                                               F1B54430
ES016D LDQ     LEFT+2                                                   F1B54440
       LGL     12                                                       F1B54450
       CAS     IFSYM                                                    F1B54460
       TRA     *+2                                                      F1B54470
       TRA     ES150D        THIS IS AN  IF(...)N1,N2,N3                F1B54480
       CAS     CALLER                                                   F1B54490
       TRA     *+2                                                      F1B54500
       TRA     ES1520        THIS IS A  CALL NAME (ARG1,...,ARGN)       F1B54510
       ARS     6                                                        F1B54520
       LXD     ARGCTR,4      THIS IS AN ARITHMETIC STATEMENT FUNCTION   F1B54530
       TRA     PCH7           GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX  $F1B54540
       REM                                                              F1B54550
       REM STATEMENT OF FORM  X = Y....                                 F1B54560
       CAS     L(H)                                                     F1B54570
       CAS     L(O)                                                     F1B54580
       TRA     ES030D        FLOATING POINT ON LEFT OF EQUAL SIGN       F1B54590
       TRA     ES030D        FLOATING POINT                             F1B54600
       SLT     4             FIXED POINT                                F1B54610
       TRA     ES087D        FLOATING POINT ON RIGHT OF EQUAL SIGN.     F1B54620
       REM                                                              F1B54630
       REM FIXED POINT ON BOTH RIGHT AND LEFT OF EQUAL SIGN.            F1B54640
       CAL     L(STQ)        COMPILE  STQ  IF LAST RESULT IN MQ         F1B54650
       SLT     2                                                        F1B54660
ES073D CAL     L(STO)        COMPILE  STO  IF LAST RESULT IN AC.        F1B54670
       SLW     CW+1                                                     F1B54680
       TSX     AC0M60,4      PREPARE CW+2, CW+3                         F1B54690
       TSX     COMP,2                                                   F1B54700
       TRA     ES1590        RETURN TO STANDARD FORTRAN ARITHMETIC.     F1B54710
       REM                                                              F1B54720
       REM FIXED POINT ON LEFT, FLOATING POINT ON RIGHT.                F1B54730
ES087D SLT     2                                                        F1B54740
       TRA     *+3                                                      F1B54750
       TSX     CPCLA2,2      MOST SIGN. (REAL) MQ TO MACHINE AC         F1B54760
       TRA     *+2                                                      F1B54770
       TSX     CPCLA1,2      MOST SIGN. (REAL) AC TO MACHINE AC         F1B54780
       TSX     CPFIX,2       COMPILE FIXING INSTRUCTIONS                F1B54790
       TRA     ES073D                                                   F1B54800
       REM                                                              F1B54810
       REM FLOATING POINT ON LEFT OF EQUAL SIGN.                        F1B54820
ES030D SLT     4                                                        F1B54830
       TRA     ES031D        FLOATING POINT ON RIGHT.                   F1B54840
       REM                                                              F1B54850
       REM FIXED ON RIGHT, FLOATING ON LEFT.                            F1B54860
       SLT     2             RESULT IN AC OR MQ                         F1B54870
       TRA     *+2           IN AC                                      F1B54880
       TSX     COMP0C,2      IN MQ  COMPILE XCA                         F1B54890
       TSX     CFLOAT,2      FLOAT MOST SIGNIFICANT                     F1B54900
       TSX     ACDP0L,4      PRE                                        F1B54910
       TSX     CIT00,4                                                  F1B54920
       PZE     L(0),,L(STO)  COMPILE STO                                F1B54930
       PZE     CW+2,,CW+3                                               F1B54940
       TSX     CIT00,4                                                  F1B54950
       PZE     L(0),,L(STZ)   COMPILE STZ FOR LEAST SIGNIFCANT PART.    F1B54960
       PZE     CW+2,,DPCW                                               F1B54970
       TRA     ES1590                                                   F1B54980
       REM                                                              F1B54990
       REM FLOATING POINT ON BOTH SIDES OF EQUAL.                       F1B55000
ES031D TSX     ACDP0L,4      PREPARE CW+2, CW+3, DPCW                   F1B55010
       SLT     2                                                        F1B55020
       TRA     *+3                                                      F1B55030
       TSX     CPDSTQ,2      COMPILE SEQUENCE FOR DP AND CA  STQ        F1B55040
       TRA     ES1590        RETURN TO STANDARD FORTRAN ARITHMETIC      F1B55050
       TSX     CPDSTO,2      COMPILE SEQUENCE FOR DP AND CA  STO        F1B55060
       TRA     ES1590        RETURN TO STANDARD FORTRAN ARITHMETIC      F1B55070
       REM                                                              F1B55080
       REM STATEMENT IS AN ARITHMETIC STATEMENT FUNCTION.               F1B55090
ES130D SUB     L(X)                                                     F1B55100
       TZE     ES136D        FIXED POINT ON LEFT OF EQUAL               F1B55110
       SLT     4                                                        F1B55120
       TRA     ES132D        FLOATING POINT ON RIGHT OF EQUAL.          F1B55130
       REM                                                              F1B55140
       REM FIXED POINT ON RIGHT, FLOATING POINT ON LEFT.                F1B55150
       SLT     2                                                        F1B55160
       TRA     *+2                                                      F1B55170
       TSX     COMP0C,2      RESULT IS IN MQ, COMPILE  XCA              F1B55180
       TSX     CFLOAT,2      COMPILE INSTRUCTIONS TO FLOAT MOST SIGN.   F1B55190
       TSX     CIT00,4                                                  F1B55200
       PZE     L(0),,L(STO)  STO IN 4)                                  F1B55210
       PZE     P(,,L(0)                                                 F1B55220
       TSX     CIT00,4                                                  F1B55230
       PZE     L(0),,L(STZ)   COMPILE STZ IN 4)-1 FOR LEAST SIGNIF PART.F1B55240
       PZE     P(,,DECMI1                                               F1B55250
       TRA     ES0630        RETURN TO STANDARD FORTRAN                 F1B55260
       REM                                                              F1B55270
       REM FLOATING POINT ON BOTH SIDES OF EQUAL SIGN.                  F1B55280
ES132D SLT     2                                                        F1B55290
       TRA     ES0630                                                   F1B55300
       TSX     CPMQAC,2      COMPILE SEQUENCE TO MOVE MQ TO AC.         F1B55310
       TRA     ES0630                                                   F1B55320
       REM                                                              F1B55330
       REM FIXED POINT ON LEFT OF EQUAL SIGN.                           F1B55340
ES136D TSX     DIAG,4        ILLEGAL DP OR CA DEFINITION OF FIXED FUNCT F1B55350
       REM                                                              F1B55360
       REM                                                              F1B55370
       REM STATEMENT IS AN  IF(...)N1,N2,N3                             F1B55380
ES150D SLT     4                                                        F1B55390
       TRA     *+2                                                      F1B55400
       TRA     ES1500        FIXED POINT, RETURN TO STANDARD FORTRAN.   F1B55410
       REM FLOATING POINT ON RIGHT OF EQUAL.                            F1B55420
       SLT     2                                                        F1B55430
       TRA     *+4                                                      F1B55440
       TSX     CPCLA2,2       MOST SIGN. (REAL) MQ TO MACHINE AC.       F1B55450
       AXT     DECMI3,2                                                 F1B55460
       TRA     *+3                                                      F1B55470
       TSX     CPCLA1,2       MOST SIGN. (REAL) AC TO MACHINE AC.       F1B55480
       AXT     DECMI1,2                                                 F1B55490
       TRA     ES1500         RETURN TO STANDARD FORTRAN.               F1B55500
       REM                                                              F1B55510
       CLA     MODECL         IS THIS DOUBLE-PRECISION.                 F1B55520
       SUB     L(D)                                                     F1B55530
       TNZ     ES1500         NO, EXIT.                                 F1B55540
       SXD     *+3,2          YES, SET ADDEND.                          F1B55550
       TSX     CIT00,4                                                  F1B55560
       PZE     L(0),,L(ADD)                                             F1B55570
       PZE     P(,,**                                                   F1B55580
       TRA     ES1500         RETURN TO STANDARD FORTRAN.               F1B55590
       REM                                                              F1B55600
       REM                                                              F1B55610
       REM                                                              F1B55620
       REM SUBROUTINE TO PROVIDE ADDRESS OF MOST SIGNIFICANT (REAL) PARTF1B55630
       REM AND ADDRESS OF LEAST SIGNIFICANT (IMAGINARY) PART FOR        F1B55640
       REM FOR COMPILATION OF DOUBLE PRECISION AND COMPLEX ARITHMETIC.  F1B55650
       REM                                                              F1B55660
       REM USES STANDARD AC0000 ROUTINE TO GET ADDRESS OF MOST SIGN.    F1B55670
       REM PART. THEN SUBTRACTS ONE FOR ALL BUT SUBSCRIPTED VARIABLES.  F1B55680
       REM FOR SUBSCRIPTED VARIABLES LOOKS IN DLIST1 AND GETS SIZE OF   F1B55690
       REM ARRAY WHICH IT THEN SUBTRACTS TO FORM LEAST SIGN ADDRESSS.   F1B55700
       REM                                                              F1B55710
       REM ENTRY POINT FOR LEFT OF EQUAL.                               F1B55720
ACDP0L SXA     ACDP04,4      SAVE CALLING TAG.                          F1B55730
       TSX     AC0M60,4      PREPARE CW+2, CW+3                         F1B55740
       TRA     ACDP00+2                                                 F1B55750
       REM                                                              F1B55760
       REM ENTRY POINT FOR RIGHT OF EQUAL.                              F1B55770
ACDP00 SXA     ACDP04,4      SAVE CALLING TAG                           F1B55780
       TSX     AC0000,4      GET ADDRESS OF MOST SIGNIFICANT PART       F1B55790
       LXD     DLIST1-2,4    SUBSCRIPTED, GET COUNT OF ENTRIES IN DLST1 F1B55800
       AXT     0,2            INITIALIZE INDEX FOR SEARCH.              F1B55810
       CLA     CW+2           GET VARIABLE NAME.                        F1B55820
ACDP01 CAS     **,2          AND                                        F1B55830
       TXI     ACDP02,2,-2   SEARCH FOR IT IN DLST1                     F1B55840
       TRA     ACDP03        FOUND                                      F1B55850
       TXI     ACDP02,2,-2                                              F1B55860
ACDP02 TIX     ACDP01,4,1    CONTINUE SEARCH                            F1B55870
       CLA     TAGWRD         IS THIS A NON-SUBSCRIPTED VARIABLE.       F1B55880
       TRA     ACDP08                                               (25)F1B55890
ERDP01 TSX     DIAG,4        NOT FOUND IS ERROR                         F1B55900
ACDP03 CLA     CW+3                                                     F1B55910
       STO     DPCW          ADDRESS AND STORE                          F1B55920
       LRS     0                                                        F1B55930
       ANA     1BAR          ERASE ALL BUT ADDEND                       F1B55940
       LLS     0             GET SIGN BACK                              F1B55950
ACDP07 SUB     **,2          SUBTRACT SIZE OF ARRAY        (DLST1+1)    F1B55960
       STD     DPCW          STORE NEW ADDEND                           F1B55970
       LDQ     L(0)                                                     F1B55980
       LRS     0             SAVE SIGN                                  F1B55990
       XCL                                                              F1B56000
       STP     DPCW          STORE NEW SIGN                             F1B56010
       TRA     ACDP04                                                   F1B56020
ACDP05 CLA     CW+3          GET ADDRESS                                F1B56030
       SUB     2E18          SUBTRACT ONE TO FORM LEAST SIGNIFICANT     F1B56040
       STO     DPCW          ADDRESS AND STORE                          F1B56050
       CAL     CW+2                                                     F1B56060
       TZE     ACDP04        ABSOLUTE ADDRESS CASE                      F1B56070
       ARS     30                                                       F1B56080
       CAS     L(1)          1) ERASEABLE CASE                          F1B56090
       TRA     *+2                                                      F1B56100
       TRA     ACDP06                                                   F1B56110
       CAS     L(4)          4) ERASEABLE CASE                          F1B56120
       TRA     ACDP04                                                   F1B56130
       TRA     ACDP06                                                   F1B56140
       TRA     ACDP04                                                   F1B56150
ACDP06 LXD     CW+3,4        GET ADDEND                                 F1B56160
       PXD     0,4                                                      F1B56170
       ALS     1             DOUBLE IT                                  F1B56180
       STO     DPCW          USE X)+2I AS LEAST SIGNIF ADDRESS          F1B56190
       ADD     2E18          ADD ONE FOR MOST SIGNIF                    F1B56200
       STO     CW+3          USE AS MOST SIGNIF                         F1B56210
ACDP04 AXT     ..,4          RELOAD CALLING TAG                         F1B56220
       TRA     1,4           RETURN TO CALLER                           F1B56230
       REM                                                              F1B56240
       REM SUBROUTINE TO COMPILE DP AND CA SEQUENCE FOR  CLA            F1B56250
CPDCLA TSX     CIT00,4                                                  F1B56260
       PZE     CW,,L(CLA)              CLA  MOST. SIGN. (REAL) PART.    F1B56270
       PZE     CW+2,,CW+3                                               F1B56280
       STZ     CW                                                       F1B56290
       TSX     CIT00,4                                                  F1B56300
       PZE     L(0),,L(STO)            STO  4)                          F1B56310
       PZE     P(,,L(0)                                                 F1B56320
       TSX     CIT00,4                                                  F1B56330
       PZE     L(0),,L(CLA)            CLA  LEAST SIGN. (IMAG.) PART.   F1B56340
       PZE     CW+2,,DPCW                                               F1B56350
       TSX     CIT00,4                                                  F1B56360
       PZE     L(0),,L(STO)            STO  4)-1                        F1B56370
       PZE     P(,,DECMI1                                               F1B56380
       TRA     1,2                                                      F1B56390
       REM                                                              F1B56400
       REM SUBROUTINE TO COMPILE DP AND CA SEQUENCE FOR  CLS            F1B56410
CPDCLS TSX     CIT00,4                                                  F1B56420
       PZE     CW,,L(CLS)              CLS  MOST. SIGN. (REAL) PART.    F1B56430
       PZE     CW+2,,CW+3                                               F1B56440
       STZ     CW                                                       F1B56450
       TSX     CIT00,4                                                  F1B56460
       PZE     L(0),,L(STO)            STO  4)                          F1B56470
       PZE     P(,,L(0)                                                 F1B56480
       TSX     CIT00,4                                                  F1B56490
       PZE     L(0),,L(CLS)            CLS  LEAST SIGN. (IMAG.) PART.   F1B56500
       PZE     CW+2,,DPCW                                               F1B56510
       TSX     CIT00,4                                                  F1B56520
       PZE     L(0),,L(STO)            STO  4)-1                        F1B56530
       PZE     P(,,DECMI1                                               F1B56540
       TRA     1,2                                                      F1B56550
       REM                                                              F1B56560
       REM SUBROUTINE TO COMPILE DP AND CA SEQUENCE FOR  STO            F1B56570
CPDSTO TSX     CIT00,4                                                  F1B56580
       PZE     L(0),,L(CLA)                                             F1B56590
       PZE     P(,,L(0)                                                 F1B56600
       TSX     CIT00,4                                                  F1B56610
       PZE     L(0),,L(STO)                                             F1B56620
       PZE     CW+2,,CW+3                                               F1B56630
       TSX     CIT00,4                                                  F1B56640
       PZE     L(0),,L(CLA)                                             F1B56650
       PZE     P(,,DECMI1                                               F1B56660
       TSX     CIT00,4                                                  F1B56670
       PZE     L(0),,L(STO)                                             F1B56680
       PZE     CW+2,,DPCW                                               F1B56690
       TRA     1,2                                                      F1B56700
       REM                                                              F1B56710
       REM SUBROUTINE TO COMPILE DP AND CA SEQUENCE FOR LDQ             F1B56720
CPDLDQ TSX     CIT00,4                                                  F1B56730
       PZE     CW,,L(LDQ)                                               F1B56740
       PZE     CW+2,,CW+3                                               F1B56750
       STZ     CW                                                       F1B56760
       TSX     CIT00,4                                                  F1B56770
       PZE     L(0),,L(STQ)                                             F1B56780
       PZE     P(,,DECMI2                                               F1B56790
       TSX     CIT00,4                                                  F1B56800
       PZE     L(0),,L(LDQ)                                             F1B56810
       PZE     CW+2,,DPCW                                               F1B56820
       TSX     CIT00,4                                                  F1B56830
       PZE     L(0),,L(STQ)                                             F1B56840
       PZE     P(,,DECMI3                                               F1B56850
       TRA     1,2                                                      F1B56860
       REM                                                              F1B56870
       REM SUBROUTINE TO COMPILE DP AND CA SEQUENCE FOR  STQ            F1B56880
CPDSTQ TSX     CIT00,4                                                  F1B56890
       PZE     L(0),,L(LDQ)                                             F1B56900
       PZE     P(,,DECMI2                                               F1B56910
       TSX     CIT00,4                                                  F1B56920
       PZE     L(0),,L(STQ)                                             F1B56930
       PZE     CW+2,,CW+3                                               F1B56940
       TSX     CIT00,4                                                  F1B56950
       PZE     L(0),,L(LDQ)                                             F1B56960
       PZE     P(,,DECMI3                                               F1B56970
       TSX     CIT00,4                                                  F1B56980
       PZE     L(0),,L(STQ)                                             F1B56990
       PZE     CW+2,,DPCW                                               F1B57000
       TRA     1,2                                                      F1B57010
       REM                                                              F1B57020
       REM SUBROUTINE TO COMPILE DP AND CA SEQUENCE FOR  CHS            F1B57030
CPDCHS TSX     CIT00,4                                                  F1B57040
       PZE     L(0),,L(CLS)            CLS  4)                          F1B57050
       PZE     P(,,L(0)                                                 F1B57060
       TSX     CIT00,4                                                  F1B57070
       PZE     L(0),,L(STO)            STO  4)                          F1B57080
       PZE     P(,,L(0)                                                 F1B57090
       TSX     CIT00,4                                                  F1B57100
       PZE     L(0),,L(CLS)            CLS  4)-1                        F1B57110
       PZE     P(,,DECMI1                                               F1B57120
       TSX     CIT00,4                                                  F1B57130
       PZE     L(0),,L(STO)            STO  4)-1                        F1B57140
       PZE     P(,,DECMI1                                               F1B57150
       TRA     1,2                                                      F1B57160
       REM                                                              F1B57170
       REM SUBROUTINE TO COMPILE SEQUENCE TO MOVE AC TO MQ.             F1B57180
CPACMQ TSX     CIT00,4                                                  F1B57190
       PZE     L(0),,L(LDQ)            LDQ  4)                          F1B57200
       PZE     P(,,L(0)                                                 F1B57210
       TSX     CIT00,4                                                  F1B57220
       PZE     L(0),,L(STQ)            STQ  4)-2                        F1B57230
       PZE     P(,,DECMI2                                               F1B57240
       TSX     CIT00,4                                                  F1B57250
       PZE     L(0),,L(LDQ)            LDQ  4)-1                        F1B57260
       PZE     P(,,DECMI1                                               F1B57270
       TSX     CIT00,4                                                  F1B57280
       PZE     L(0),,L(STQ)            STQ  4)-3                        F1B57290
       PZE     P(,,DECMI3                                               F1B57300
       TRA     1,2                                                      F1B57310
       REM                                                              F1B57320
       REM SUBROUTINE TO COMPILE SEQUENCE TO MOVE MQ TO AC.             F1B57330
CPMQAC TSX     CIT00,4                                                  F1B57340
       PZE     L(0),,L(CLA)            CLA  4)-2                        F1B57350
       PZE     P(,,DECMI2                                               F1B57360
       TSX     CIT00,4                                                  F1B57370
       PZE     L(0),,L(STO)            STO  4)                          F1B57380
       PZE     P(,,L(0)                                                 F1B57390
       TSX     CIT00,4                                                  F1B57400
       PZE     L(0),,L(CLA)            CLA  4)-3                        F1B57410
       PZE     P(,,DECMI3                                               F1B57420
       TSX     CIT00,4                                                  F1B57430
       PZE     L(0),,L(STO)            STO  4)-1                        F1B57440
       PZE     P(,,DECMI1                                               F1B57450
       TRA     1,2                                                      F1B57460
       REM                                                              F1B57470
       REM SUBROUTINE TO COMPILE THE DP SEQUENCE FOR FAD                F1B57480
CPDFAD CLA     (DFAD)        GET NAME OF SUBROUTINE                     F1B57490
       STO     G             AND PREPARE TO ENTER IT IN CLOSUB TABLE.   F1B57500
       NZT     *+2           TEST WHETHER FIRST TIME THIS CALLING       F1B57510
       TRA     DPSUB2        NOT FIRST TIME, SKIP CLOSUB ENTRY.         F1B57520
       STZ     *             FIRST TIME, RESET TEST FOR ALL LATER TIMES.F1B57530
       TRA     DPSUB1        FIRST TIME, MAKE CLOSUB ENTRY              F1B57540
       REM                                                              F1B57550
       REM SUBROUTINE TO COMPILE THE DP SEQUENCE FOR FSB                F1B57560
CPDFSB CLA     (DFSB)        GET NAME OF SUBROUTINE                     F1B57570
       STO     G             AND PREPARE TO ENTER IT IN CLOSUB TABLE.   F1B57580
       NZT     *+2           TEST WHETHER FIRST TIME THIS CALLING       F1B57590
       TRA     DPSUB2        NOT FIRST TIME, SKIP CLOSUB ENTRY.         F1B57600
       STZ     *             FIRST TIME, RESET TEST FOR ALL LATER TIMES.F1B57610
       TRA     DPSUB1        FIRST TIME, MAKE CLOSUB ENTRY              F1B57620
       REM                                                              F1B57630
       REM SUBROUTINE TO COMPILE THE DP SEQUENCE FOR FMP                F1B57640
CPDFMP CLA     (DFMP)        GET NAME OF SUBROUTINE                     F1B57650
       STO     G             AND PREPARE TO ENTER IT IN CLOSUB TABLE.   F1B57660
       NZT     *+2           TEST WHETHER FIRST TIME THIS CALLING       F1B57670
       TRA     DPSUB2        NOT FIRST TIME, SKIP CLOSUB ENTRY.         F1B57680
       STZ     *             FIRST TIME, RESET TEST FOR ALL LATER TIMES.F1B57690
       TRA     DPSUB1        FIRST TIME, MAKE CLOSUB ENTRY              F1B57700
       REM                                                              F1B57710
       REM SUBROUTINE TO COMPILE THE DP SEQUENCE FOR FDP                F1B57720
CPDFDP CLA     (DFDP)        GET NAME OF SUBROUTINE                     F1B57730
       STO     G             AND PREPARE TO ENTER IT IN CLOSUB TABLE.   F1B57740
       NZT     *+2           TEST WHETHER FIRST TIME THIS CALLING       F1B57750
       TRA     DPSUB2        NOT FIRST TIME, SKIP CLOSUB ENTRY.         F1B57760
       STZ     *             FIRST TIME, RESET TEST FOR ALL LATER TIMES.F1B57770
       TRA     DPSUB1        FIRST TIME, MAKE CLOSUB ENTRY              F1B57780
       REM                                                              F1B57790
       REM SUBROUTINE TO COMPILE THE CA SEQUENCE FOR FDP                F1B57800
CPIFMP CLA     (IFMP)        GET NAME OF SUBROUTINE                     F1B57810
       STO     G             AND PREPARE TO ENTER IT IN CLOSUB TABLE.   F1B57820
       NZT     *+2           TEST WHETHER FIRST TIME THIS CALLING       F1B57830
       TRA     DPSUB2        NOT FIRST TIME, SKIP CLOSUB ENTRY.         F1B57840
       STZ     *             FIRST TIME, RESET TEST FOR ALL LATER TIMES.F1B57850
       TRA     DPSUB1        FIRST TIME, MAKE CLOSUB ENTRY              F1B57860
       REM                                                              F1B57870
       REM SUBROUTINE TO COMPILE THE CA SEQUENCE FOR FMP                F1B57880
CPIFDP CLA     (IFDP)        GET NAME OF SUBROUTINE                     F1B57890
       STO     G             AND PREPARE TO ENTER IT IN CLOSUB TABLE.   F1B57900
       NZT     *+2           TEST WHETHER FIRST TIME THIS CALLING       F1B57910
       TRA     DPSUB2        NOT FIRST TIME, SKIP CLOSUB ENTRY.         F1B57920
       STZ     *             FIRST TIME, RESET TEST FOR ALL LATER TIMES.F1B57930
       REM                                                              F1B57940
       REM COMMON PART OF SUBROUTINE FOR ABOVE SIX ENTRIES...           F1B57950
DPSUB1 SXA     *+3,1                                                    F1B57960
       TSX     TET00,1                                                  F1B57970
       PZE     9                                                        F1B57980
       AXT     ..,1                                                     F1B57990
       REM                                                              F1B58000
DPSUB2 TRA     PCH8           GO SAVE CURRENT OPERATION NAME           $F1B58010
       CAS     TRAPCL        COMPARE TO LAST NAME IN LOC. 2             F1B58020
       TRA     *+2                                                      F1B58030
       TRA     DPSUB4        SAME NAME, DO NOT COMPILE  CAL (...), SLW 2F1B58040
       STO     TRAPCL        DIFFERENT NAME, CHANGE INDICATOR           F1B58050
       TSX     CIT00,4                                                  F1B58060
       PZE     L(0),,L(CLA)                                            $F1B58070
       PZE     G,,L(0)                                                  F1B58080
       TSX     CIT00,4                                                  F1B58090
       PZE     L(0),,L(STO)                                            $F1B58100
       PZE     L(0),,2E19                                               F1B58110
DPSUB4 TSX     CIT00,4                                                  F1B58120
       PZE     L(0),,L(STR)                                             F1B58130
       PZE     CW+2,,CW+3                                               F1B58140
       TSX     CIT00,4                                                  F1B58150
       PZE     L(0),,L(PZE)                                             F1B58160
       PZE     CW+2,,DPCW                                               F1B58170
       TRA     1,2           SEQUENCE HAS BEEN COMPILED.                F1B58180
       REM                                                              F1B58190
TRAPCL PZE     0             INDICATOR OF CONTENTS OF LOC. 2            F1B58200
(DFAD) BCD 1(DFAD)                                                      F1B58210
(DFSB) BCD 1(DFSB)                                                      F1B58220
(DFMP) BCD 1(DFMP)                                                      F1B58230
(DFDP) BCD 1(DFDP)                                                      F1B58240
(IFMP) BCD 1(IFMP)                                                      F1B58250
(IFDP) BCD 1(IFDP)                                                      F1B58260
       REM                                                              F1B58270
DPCW   PZE                                                              F1B58280
DECMI3 MZE     ,,3                                                      F1B58290
       REM                                                              F1B58300
       REM SUBROUTINE TO COMPILE SEQUENCE TO SET UP AN ARGUMENT FOR     F1B58310
       REM EITHER ARITHMETIC STATEMENT FUNCTIONS OR FOR CLOSED (LIBRARY)F1B58320
       REM FUNCTIONS.                                                   F1B58330
       REM                                                              F1B58340
CPDARG ZAC                                                          (22)F1B58350
       LDQ     SCRIPL+2,1    OBTAIN OPERAND                         (22)F1B58360
       LGL     1                                                    (22)F1B58370
       LBT                   TEST FOR VARIABLE                      (22)F1B58380
       TQP     DARG03        LEVEL NUMBER                           (22)F1B58390
       LGL     5             VARIABLE, TEST TYPE                    (22)F1B58400
       CAS     L(H)                                                 (26)F1B58410
       CAS     L(O)                                                 (26)F1B58420
       TRA     DARGFL        FLOATING                               (22)F1B58430
       TRA     DARGFL        FLOATING                               (22)F1B58440
       TRA     DARGFX        FIXED                                  (22)F1B58450
DARGFL TSX     CIT00,4       MOVE HIGH ORDER (REAL) PART            (22)F1B58460
               CW,,L(CLA)                                           (22)F1B58470
               CW+2,,CW+3                                           (22)F1B58480
       TSX     CIT00,4                                              (22)F1B58490
               L(0),,L(STO)                                         (22)F1B58500
               ARGORG,,COUNT1                                       (22)F1B58510
       TSX     CIT00,4       MOVE LOW ORDER (IMAGINARY) PART        (22)F1B58520
               L(0),,L(CLA)                                         (22)F1B58530
               CW+2,,DPCW                                           (22)F1B58540
       TSX     CIT00,4                                              (22)F1B58550
               L(0),,L(STO)                                         (22)F1B58560
               ARGORG,,COUNT2                                       (22)F1B58570
       REM     REENTRY TO UPDATE ARGUMENT COUNT CELLS               (22)F1B58580
DARG02 CAL     COUNT1                                                   F1B58590
       ADD     2E19                                                     F1B58600
       SLW     COUNT1                                                   F1B58610
       CAL     COUNT2                                                   F1B58620
       ADD     2E19                                                     F1B58630
       SLW     COUNT2                                                   F1B58640
       TRA 1,2                                                          F1B58650
       REM                                                              F1B58660
       REM SUBROUTINE TO COMPILE STZ IN LEAST SIGN) (REAL) PART.        F1B58670
CPSTZ1 TSX     CIT00,4                                                  F1B58680
       PZE     L(0),,L(STZ)                                             F1B58690
       PZE     CW+2,,CW+3                                               F1B58700
       TRA     1,2                                                      F1B58710
       REM                                                              F1B58720
       REM SUBROUTINE TO COMPILE CLA OF MOST SIGN) (REAL) AC.           F1B58730
CPCLA1 TSX     CIT00,4                                                  F1B58740
       PZE     L(0),,L(CLA)                                             F1B58750
       PZE     P(,,L(0)                                                 F1B58760
       TRA     1,2                                                      F1B58770
       REM                                                              F1B58780
       REM SUBROUTINE TO COMPILE CLA OF MOST SIGN. (REAL) PART OF MQ.   F1B58790
CPCLA2 TSX     CIT00,4                                                  F1B58800
       PZE     L(0),,L(CLA)                                             F1B58810
       PZE     P(,,DECMI2                                               F1B58820
       TRA     1,2                                                      F1B58830
       REM                                                              F1B58840
       REM SUBROUTINE TO COMPILE SEQUENCE TO FIX A FLOATING POINT RESULTF1B58850
CPFIX  TSX     CIT00,4                                                  F1B58860
       PZE     L(0),,L(UFA)                                             F1B58870
       PZE     O(,,L(0)                                                 F1B58880
       TSX     CIT00,4                                                  F1B58890
       PZE     L(0),,L(LRS)                                             F1B58900
       PZE     L(0),,L(0)                                               F1B58910
       TSX     CIT00,4                                                  F1B58920
       PZE     L(0),,L(ANA)                                             F1B58930
       PZE     O(,,2E18                                                 F1B58940
       TSX     CIT00,4                                                  F1B58950
       PZE     L(0),,L(LLS)                                             F1B58960
       PZE     L(0),,L(0)                                               F1B58970
       TSX     CIT00,4                                                  F1B58980
       PZE     L(0),,L(ALS)                                             F1B58990
       PZE     L(0),,DEC18                                              F1B59000
       TRA     1,2                                                      F1B59010
       REM                                                              F1B59020
       REM SUBROUTINE TO COMPILE FLOATING SEQUENCE                      F1B59030
CFLOAT TSX     CIT00,4                                                  F1B59040
       PZE     L(0),,L(LRS)                                             F1B59050
       PZE     L(0),,DEC18                                              F1B59060
       TSX     CIT00,4                                                  F1B59070
       PZE     L(0),,L(ORA)                                             F1B59080
       PZE     O(,,L(0)                                                 F1B59090
       TSX     CIT00,4                                                  F1B59100
       PZE     L(0),,L(FAD)                                             F1B59110
       PZE     O(,,L(0)                                                 F1B59120
       TRA     1,2                                                      F1B59130
COUNT1 PZE     0                                                        F1B59140
COUNT2 PZE     0                                                        F1B59150
       REM                                                              F1B59160
       REM SUBROUTINE TO COMPILE SEQUENCE FOR DABS FUNCTION             F1B59170
CPDABS TSX     CIT00,4                                                  F1B59180
       PZE     L(0),,L(CLA)                                             F1B59190
       PZE     P(,,L(0)                                                 F1B59200
       TSX     CIT00,4                                                  F1B59210
       PZE     L(0),,L(SLW)                                             F1B59220
       PZE     P(,,L(0)                                                 F1B59230
       TSX     CIT00,4                                                  F1B59240
       PZE     L(0),,L(CLA)                                             F1B59250
       PZE     P(,,DECMI1                                               F1B59260
       TSX     CIT00,4                                                  F1B59270
       PZE     L(0),,L(SLW)                                             F1B59280
       PZE     P(,,DECMI1                                               F1B59290
       TRA     ES000D                                                   F1B59300
       REM                                                              F1B59310
       REM SUBROUTINE TO COMPILE SEQUENCE FOR DSIGN FUNCTION            F1B59320
       REM                    OR ISIGN FUNCTION.                        F1B5932A
       REM                                                              F1B5932B
CISIGN STL     CAFLG          SET SWITCH TO COMPILE ISIGN.              F1B5932C
       TRA     CDSIGN+1                                                 F1B5932D
       REM                                                              F1B5932E
CAFLG  PZE     **             CA OR DP FLAG.                            F1B5932F
       REM                                                              F1B5932G
CDSIGN STZ     CAFLG          SET SWITCH TO COMPILE DSIGN.              F1B5932H
       TSX     CIT00,4                                                  F1B59330
       PZE     L(0),,L(CLA)                                             F1B59340
       PZE     P(,,L(0)                                                 F1B59350
       TSX     CIT00,4                                                  F1B59360
       PZE     L(0),,L(LDQ)                                             F1B59370
       PZE     P(,,DECMI2                                               F1B59380
       TSX     CIT00,4                                                  F1B59390
       PZE     L(0),,L(LLS)                                             F1B59400
       PZE     L(0),,L(0)                                               F1B59410
       TSX     CIT00,4                                                  F1B59420
       PZE     L(0),,L(STO)                                             F1B59430
       PZE     P(,,L(0)                                                 F1B59440
       NZT     CAFLG          IS THIS COMPLEX OR DP.                    F1B59441
       TRA     *+4            DOUBLE PRECISION.                         F1B59442
       TSX     CIT00,4        COMPLEX.                                  F1B59443
       PZE     L(0),,L(LDQ)                                             F1B59444
       PZE     P(,,DECMI3                                               F1B59445
       TSX     CIT00,4                                                  F1B59450
       PZE     L(0),,L(CLA)                                             F1B59460
       PZE     P(,,DECMI1                                               F1B59470
       TSX     CIT00,4                                                  F1B59480
       PZE     L(0),,L(LLS)                                             F1B59490
       PZE     L(0),,L(0)                                               F1B59500
       TSX     CIT00,4                                                  F1B59510
       PZE     L(0),,L(STO)                                             F1B59520
       PZE     P(,,DECMI1                                               F1B59530
       TRA     ES000D                                                   F1B59540
       REM                                                              F1B59550
       REM                                                              F1B59560
       REM                                                              F1B59570
DARG03 SXA     DARG05,2      OPERAND IS LEVEL NUMBER                (22)F1B59580
       AXT     0,2           FIND MATCHING LEVEL                    (26)F1B59590
       LXD     3LBAR,4                                              (22)F1B59600
DARG04 SXD     *+1,2         BUMP TO BEGINNING OF                   (22)F1B59610
       TXI     *+1,4,**      NEXT LEVEL                             (22)F1B59620
       CAL     SCRIPL,4      OBTAIN ITS LEVEL NUMBER                (22)F1B59630
       ANA     MASK2         ISOLATE IT AND                         (22)F1B59640
       LAS     SCRIPL+2,1    COMPARE WITH DESIRED                   (22)F1B59650
       TRA     *+2           OPERAND                                (22)F1B59660
       TRA     DARG05        FOUND                                  (22)F1B59670
       PAX     ,2            NOT FOUND, OBTAIN SEGMENT              (22)F1B59680
       CLA     CPBETA,2      LENGTH FROM CORRESPONDING              (22)F1B59690
       PAX     CPBETA,2      BETA ENTRY, AND THEN                   (22)F1B59700
       TRA     DARG04        LOOK AT NEXT LEVEL                     (22)F1B59710
       REM                                                          (22)F1B59720
       REM SUBROUTINE TO COMPILE SEQUENCE FOR DFLOAT, IFLOAT IN LINE(22)F1B59730
       REM                                                          (22)F1B59740
CDFLOT TSX     CFLOAT,2      COMPILE FLOATING SEQUENCE              (22)F1B59750
       TSX     CIT00,4                                                  F1B59760
       PZE     L(0),,L(STO)                                             F1B59770
       PZE     P(,,L(0)                                                 F1B59780
       TSX     CIT00,4                                                  F1B59790
       PZE     L(0),,L(STZ)                                             F1B59800
       PZE     P(,,DECMI1                                               F1B59810
       TRA     ES000D                                                   F1B59820
       REM                                                              F1B59830
       REM                                                              F1B59840
       REM SUBROUTINE TO ENTER DOUBLE PRECISION FLOATING POINT CONSTANT F1B59850
       REM IN FLOCON TABLE.                                             F1B59860
       REM                                                              F1B59870
       REM THIS ROUTINE ASSUMES THE MOST SIGNIFICANT PART IN G+1, THE   F1B59880
       REM LEAST SIGNIFICANT PART IN G. IT SCANS THE FLOCON TABLE AND I F1B59890
       REM NOT FOUND ENTERS AS A TWO WORD ENTRY WITH THE LEAST SIGN.    F1B59900
       REM PART FIRST, WHETHER FOUND OR ENTERED IT RETURNS A TAG IN AC  F1B59910
       REM WHICH IS THE RELATIVE POSITION OF THE MOST SIGN. PART IN THE F1B59920
       REM TABLE.                                                       F1B59930
       REM                                                              F1B59940
DFLCON SXA     XR1,1          SAVE INDEX REGISTERS.                     F1B59950
       SXA     XR2,2                                                    F1B59960
       SXA     XR4,4                                                    F1B59970
       LXA L(0),3            SET FOR FORWARD SCAN.                      F1B59980
       CLA G                 GET LEAST SIGN. PART.                      F1B59990
       LXD FLCNIX-2,4        GET AND TEST NUMBER OF ENTRIES IN FLOCON.  F1B60000
       TXL ENFC05,4,0        0 MEANS NO PREVIOUS DP-CA ENTRIES, GO ENTERF1B60010
ENFC01 CAS **,2              SCAN FLOCON TABLE FOR MATCH TO LEAST SIGN. F1B60020
       TXI *+3,2,-1          PART OF AGRUMENT.                          F1B60030
       TXI ENFC04,1,1        MATCH FOUND.                               F1B60040
       TXI *+1,2,-1          NO MATCH, GO TO NEXT ENTRY.                F1B60050
ENFC02 TXI *+1,1,1           KEEP IR1 UPDATED AS TAG TO BE RETURNED.    F1B60060
       TIX ENFC01,4,1        TEST FOR LAST ENTRY IN TABLE.              F1B60070
ENFC05 STO **,2              STORE LEAST SIGN. PART IN FLOCON TABLE.    F1B60080
       CLA G+1                                                          F1B60090
ENFC06 STO **,2              NOW STORE MOST SIGN. PART IN NEXT PLACE.   F1B60100
       CLA FLCNIX-2                                                     F1B60110
       ADD 2AND2                                                        F1B60120
       STO FLCNIX-2                                                     F1B60130
       TXI *+1,1,1           READJUST TAG FOR EXIT.                     F1B60140
ENFC03 PXA     ,1             TAG TO AC.                                F1B60150
XR1    AXT     **,1           RESTORE INDEX REGISTERS.                  F1B60170
XR2    AXT     **,2                                                     F1B60180
XR4    AXT     **,4                                                     F1B60190
       TRA 1,4               RETURN TO CALLER.                          F1B60200
ENFC04 TXL     ENFC07+3,4,2  *IS THERE ANOTHER ENTRY IN FLOCON, NO.    $F1B60210
       CLA     G+1            YES, COMPARE MOST MOST SIGNIFICANT PART.  F1B60211
ENFC07 SUB **,2              PART AGAINST NEXT WORD OF FLOCON.          F1B60220
       TZE ENFC03            MATCH, THEREFORE THIS DP FLOCON INTABLE,   F1B60230
       CLA G                 NO MATCH, CONTINUE SEARCH.                 F1B60240
       TXI ENFC02+1,2,-1                                                F1B60250
       REM                                                              F1B60260
       REM                                                              F1B60270
       REM  END OF ARITHMETIC PROCESSOR.                                F1B60280
       REM                                                              F1B60290
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B60300
       REM                                                              F1B60310
       REM                                                              F1B60320
       REM PASS 2/5-PATCH AREA=                                         F1B60330
BEGP2P SYN     *              BEGINNING OF PASS 2 PATCHING AREA.        F1B60340
P1B00B STZ     TRAPCL        RESET LAST OP-CODE                        *F1B60341
       LGL     7             OP1(S(I)) = SPOP   (RESTORE OP)           *F1B60342
       TRA     CP204D+1      RETURN FROM PATCH                         *F1B60343
       REM                                                             *F1B60344
 CPPCH STZ     XCAIND                                                  $F1B60345
       STZ     PHI(I)                                                  $F1B60346
       TRA     CP0000+3                                                $F1B60347
 PCH1  CLA     SIG1ST                                                  $F1B60348
       STZ     DBRCP          SET SWITCH FOR DP OR I ROUTINES          $F1B60349
       TRA     ARITH+2                                                 $F1B60350
 PCH2  SXA     *+2,4          SAVE RETURN FOR CIT00                    $F1B60351
       TSX     DBCHK,4        PUTS IN LDQ6)+5 STQ2 IF DP OR COMPLEX    $F1B60352
       AXT     **,4                                                    $F1B60353
       TRA     CIT00                                                   $F1B60354
 PCH4  TSX     TET00,1        GO TO PROGRAM TO ENTER 1C,1C+1           $F1B60360
       PZE     2              INTO TIFGO TABLE (TABLE 2)               $F1B60361
       TRA     ES1500+1                                                $F1B60362
 PCH5  TSX     DBCHK,4        GO PUT IN LDQ6)+5 STQ2 IF DP OR COMPLEX  $F1B60368
       TRA     1,2                                                     $F1B60369
       REM                                                              F1B60370
 PCH7  TXH     ES130D,4,0     YES WILL TRA  NO WILL NOP                $F1B60373
       STO     DBSAC          SAVE AC                                  $F1B60374
       TSX     DBCHK,4        COMPILE LDQ6)+5 STQ2 IF NECESSARY        $F1B60375
       CLA     DBSAC          RESTORE AND CONTINUE                     $F1B60376
       TRA     ES016D+11                                               $F1B60377
 PCH8  CLA     G              GET CURRENT OPERATION NAME               $F1B60378
       STL     DBRCP          SET NON ZERO FOR DP OR I ROUTINES        $F1B60379
       TRA     DPSUB2+1                                                $F1B60380
 PCH9  TSX     CIT00,4        COMPILE                                  $F1B60381
       PZE     CW,,L(SXD)     SXD 6)+4,4                               $F1B60382
       PZE     O(,,D4A4                                                $F1B60383
       TRA     1,2                                                     $F1B60390
DBCHK  NZT     DBRCP          SEE IF ANY DP OR I ROUTINES WERE COMPILED$F1B60392
       TRA     1,4            NO                                       $F1B60393
       SXA     DBRTN,4                                                 $F1B60400
       REM                                                              F1B60410
       TSX     CIT00,4        COMPILE                                  $F1B60419
       PZE     L(0),,L(LDQ)   LDQ 6)+5                                 $F1B60420
       PZE     O(,,DEC5                                                $F1B60421
       TSX     CIT00,4        COMPILE                                  $F1B60422
       PZE     L(0),,L(STQ)   STQ 2                                    $F1B60423
       PZE     L(0),,D2                                                $F1B60424
 DBRTN AXT     **,4                                                    $F1B60425
       TRA     1,4                                                     $F1B60426
 DBSAC PZE                    SAVE AC                                  $F1B60427
 DBRCP PZE                                                             $F1B60429
 PCH10 TSX     CIT00,4        COMPILE                                  $F1B6042A
       PZE     CW,,L(SXD)     SXD 7),4                                 $F1B6042B
       PZE     X(,,L(4)                                                $F1B6042C
       TRA     1,2                                                     $F1B6042D
1D1P   ALS     4             TAKE RESULT                               $F1B60430
       ARS     4             MODULO 32,768                             $F1B60431
       STO     GTAG                                                    $F1B60432
       TRA     1D1+2         RETURN FROM PATCH AREA                    $F1B60433
PFTAG  STL     ACFTG         SET SWITCH FOR ARITH.                  (23)F1B60434
       TRA     PCH1                                                 (23)F1B60435
  LSCP AXT     NXS,4                                                   $F1B60436
       SXA     CMASW,4                                                 $F1B60437
       CAL     SPC4                                                    $F1B60438
       SSM                                                             $F1B60439
       STO     SPC4                                                    $F1B6043A
       STZ     GTAG           CLEAR GENERALIZED TAG.                   $F1B6043B
       TRA     LSC                                                     $F1B6043C
 EXPCH CAL     SCRIPL+4,A                                              $F1B6043D
       ERA     STRSTR                                                  $F1B6043E
       ANA     EXPCH2         IS SECOND OP **                          $F1B6043F
       TNZ     EXPCH1         TRA IF NOT - NO ERROR                    $F1B6043G
       CAL     SCRIPL+7,A                                              $F1B6043H
       ERA     STRSTR                                                  $F1B6043I
       ANA     EXPCH2         IS THIRD OP **                           $F1B6043J
       TNZ     EXPCH1         TRA IF NOT - NO ERROR                    $F1B6043K
       TXH     EXPCH1,C,-8    ARE THERE THREE OPS IN SEGMENT           $F1B6043L
ER0082 TSX     DIAG,4         YES, DOUBLE EXPONENTIATION ERROR         $F1B6043M
EXPCH1 CAL     SCRIPL+2,A                                              $F1B6043N
       TRA     PL0680+2                                                $F1B6043O
EXPCH2 OCT     777700000000                                            $F1B6043P
ARITH1 CLA     MODECL         CHECK FOR CA MODE                        $F1B60440
       SUB     L(I)                                                    $F1B60441
       TZE     ARITH2                                                  $F1B60442
       CAL     TXHOP          NOT CA MODE                              $F1B60443
       TRA     *+2                                                     $F1B60444
ARITH2 CAL     TXLOP          CA MODE, DO NOT SCAN FOR ILLEGAL COMMA   $F1B60445
       STP     CMPCH                                                   $F1B60446
       TRA     PFTAG          TO SET ARITH COMPILER SWITCH.         (23)F1B60447
       REM                                                             $F1B60448
CMPCH  TXH     CMPCH1+2,0,0   TRANSFER IF CA MODE                      $F1B6044C
       AXT     0,2            INITIALIZE XR2                           $F1B6044D
       TXI     *+1,1,3        BUMP BACK TO LAST ENTRY IN IN LAMBDA TBL $F1B6044E
       TXL     *+2,1,0        TABLE EXHAUSTED,NO FUNCTION AT LEVEL     $F1B6044F
       CAS     LAMBDA,1       SEARCH FOR MATCHING LEVEL                $F1B6044G
       TRA     ER0002         HIGHER LEVEL FOUND,NO FUNCTION AT LEVEL  $F1B6044H
       TXI     CMPCH1,2,1     SAME LEVEL FOUND-CHECK FOR FUNCTION      $F1B6044I
       TRA     CMPCH+1        NOT FOUND, LOOK HIGHER IN TABLE          $F1B6044J
CMPCH1 TXL     CMPCH+2,2,1    TRA IF THIS NOT DUPLICATE ENTRY          $F1B6044K
       LXD     3LBAR,1        DUPLICATE ENTRY AT SAME LEVEL FOUND      $F1B6044L
       CAL     ADSPOP         COMMA SEPARATES FUNCTION ARGUMENTS-OK    $F1B6044M
       TRA     MS210+6        RETURN                                   $F1B6044N
PDFN2  TOV     *+1            TURN OFF OVERFLOW.                    (20)F1B6044O
       TQP     DFN3           TO THE RIGHT OR TO THE LEFT OF DP.    (20)F1B6044P
       TRA     DFN2+2         RETURN.                               (20)F1B6044Q
CFTAG  LDC     INTETE-3,1     COUNT OF WORDS IN FORTAG              (23)F1B60450
       TXL     *+4,1,0        BUFFER.. IS IT ZERO                   (23)F1B60451
       CAL     FRTGBF-1,1     NO, COMPARE LAST ENTRY                (23)F1B60452
       ERA     G              WITH NEW ONE                          (23)F1B60453
       TZE     1,2            SAME                                  (23)F1B60454
       TSX     TET00,1        NO, MAKE FORTAG ENTRY                 (23)F1B60455
       PZE     4                                                    (23)F1B60456
       TRA     1,2                                                  (23)F1B60457
ACFTG          **             FLAG FOR ARITHMETIC COMPILATION       (23)F1B60458
ES1595 STZ     ACFTG          RESET ARITHMETIC COMPILER FLAG        (23)F1B60459
       TZE     PASS2          WAS AN EXTRA IFN GENERATED            (23)F1B6045A
       TRA     ES1590+3       YES, ENTER IN CALLFN TABLE            (23)F1B6045B
CP5221 PXD     0,C            STORE SUPP IFN                        (23)F1B6045C
       SLW     FNSW2          FOR LATER                             (23)F1B6045D
       TRA     CP5222                                               (23)F1B6045E
CP5521 TSX     JIF,4          CREATE SUPPLEMENTARY IFN.             (23)F1B6045F
       STD     1C             KEEP PENDING TIFGO ENTRY UPDATED.     (23)F1B6045G
       STO     FNSW           SIGNAL CALLFN ENTRY NEEDED.           (23)F1B6045H
       TRA     CP5520+3                                             (23)F1B6045I
ACDP08 TMI     ACDP05        *YES                                   (25)F1B6045J
       CAL     CW+2          GET VARIABLE NAME.                     (25)F1B6045K
       ARS     30                                                   (25)F1B6045L
       CAS     L(H)          COMPARE WITH H.                        (25)F1B6045M
       CAS     L(O)          IF GREATER, COMPARE WITH O.            (25)F1B6045N
       TRA     ERDP01        FLOATING POINT VARIABLE                (25)F1B6045O
       TRA     ERDP01        TAKE ERROR EXIT.                       (25)F1B6045P
       TRA     ACDP05        FIXED POINT, OKAY.                     (25)F1B6045Q
 MS238 CLA     MS093         CHECK = SWITCH                         (29)F1B6045R
       TMI     MS040         NEG OKAY, GO COLLECT SYMBOL            (29)F1B6045S
       TRA     ER0073        WRONG SIDE   GIVE DIAGNOSTIC           (29)F1B6045T
 MS239 CLA     MS093         TEST = SWITCH                          (29)F1B6045U
       TPL     ER0073        WRONG SIDE   GIVE DIAGNOSTIC           (29)F1B6045V
       TSX     C0190,4       GET NEXT CHARACTER,CHECK EXPONENTIATION(29)F1B6045W
       TRA     TRBLKA+2                                             (29)F1B6045X
 C3302 STO     C3303         SAVE ARGUMENT INDICATOR                (29)F1B6045Y
       CAL     1G            GET SUBROUTINE NAME                    (29)F1B6045Z
       SLW     E+2           PREPARE FOR TABLE CHECK                (29)F1B60460
       TSX     DIM1SR,4      CHECK ONE DIMENSIONAL ENTRIES          (29)F1B60461
       TRA     *+2           NO ENTRY, CHECK TWO DIMENSIONAL TABLE  (29)F1B60462
       TRA     ER0031        ERROR, SUBROUTINE NAME IS DIMENSIONED  (29)F1B60463
       TSX     DIM2SR,4      CHECK TWO DIMENSIONAL ENTRIES          (29)F1B60464
       TRA     *+2           NO ENTRY, CHECK THREE DIMENSIONAL TABLE(29)F1B60465
       TRA     ER0031        ERROR, SUBROUTINE NAME IS DIMENSIONED  (29)F1B60466
       TSX     DIM3SR,4      CHECK THREE DIMENSIONAL ENTRIES        (29)F1B60467
       TRA     *+2           NO ENTRY, CONTINUE WITH CALL PROCESSING(29)F1B60468
ER0031 TSX     DIAG,4        WRITE ERROR MESSAGE FOR DIMENSIONED SUB(29)F1B60469
       CLA     C3303         RESTORE ARGUMENT INDICATOR             (29)F1B6046A
       TZE     C3301         NO ARGUMENTS                           (29)F1B6046B
       TRA     C3300+4       CALL STATEMENT HAS ARGUMENTS           (29)F1B6046C
 C3303 PZE                   STORAGE FOR ARGUMENT INDICATOR         (29)F1B6046D
 C0501 STO     2H            SET 2H FOR SENSE LIGHT                 (30)F1B6046E
       TSX     C0180X,2      OBTAIN LIGHT NO.                       (30)F1B6046F
       TSX     TESTF0,4      CHECK FOR RIGHT PAREN                  (30)F1B6046G
       CLA     1G            CHECK LIGHT NUMBER                     (30)F1B6046H
       CAS     L(0)          TO BE SURE THAT IT IS                  (30)F1B6046I
       CAS     L(4)          VALID(BETWEEN 1 + 4, INCLUSIVE)        (30)F1B6046J
ER0018 TSX     DIAG,4        INVALID LIGHT NUMBER, WRITE DIAGNOSTIC (30)F1B6046K
       NOP                                                          (30)F1B6046L
       TRA     C0401+3       RETURN TO SENSE LIGHT PROCESSING       (30)F1B6046M
       BSS     245           ***PATCH SPACE                         (30)F1B6046N
       REM                                                              F1B60470
ENDP2P SYN     *              END OF PASS 2 PATCHING AREA.             $F1B60472
       REM                                                             $F1B60473
       REM     * * * * * * * * * * * * * * * * * * * * * * * * * * * * $F1B60474
       REM                                                             $F1B60475
ENDP2C SYN     *                                                       $F1B60476
       REM                                                             $F1B60477
       ORG     FLTR00         PATCH TO ELIMINATE THE COMPILATION       $F1B60478
       LBL     9F14FLOW,X                                           (23)F1B60479
       TRA     CIT00          OF FLOW TRACING INSTRUCTIONS.         (23)F1B6047A
       EJECT                                                            F1B60480
       REM                                                              F1B60490
       REM SECTION 1 / ERASABLE STORAGE, BUFFERS AND CORE TABLES=       F1B60500
       REM                                                              F1B60510
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B60520
       REM                                                              F1B60530
       REM ERASABLE USED ONLY BY PASS 2.                                F1B60540
       LBL     9F14CIT1,THE WORKS                                       F1B60550
       ORG     ENDP2C         ORIGIN OF CIT BUFFER.                     F1B60560
CITBUF SYN     *              COMPILED INSTRUCTION BUFFER.              F1B60570
       REM     FIRST ENTRY IN EVERY PROGRAM                            $F1B60580
       BCD 1$$                                                          F1B60590
       BCD 1CLA000                                                      F1B60600
       BCD 1000000                                                     $F1B60610
       PZE     ,,2                                                     $F1B60620
       REM     SECOND ENTRY IN EVERY PROGRAM                           $F1B60630
       BCD 1000000                                                      F1B60640
       BCD 1STO000                                                      F1B60650
       BCD 1600000                                                     $F1B60660
       PZE     ,,5                                                     $F1B60670
       REM     ASSUMED THIRD  ENTRY                                    $F1B60680
       BCD 1000000                                                     $F1B60690
       BCD 1CLA000                                                     $F1B60700
       BCD 1(FPT)                                                      $F1B60710
       BCD 1000000                                                     $F1B60720
       REM     ASSUMED FOURTH ENTRY                                    $F1B60721
       BCD 1000000                                                     $F1B60722
       BCD 1STO000                                                     $F1B60723
       BCD 1000000                                                     $F1B60724
       PZE     ,,8                                                     $F1B60725
       REM     ASSUMED FIFTH ENTRY                                     $F1B60726
       BCD 1000000                                                     $F1B60727
       BCD 1STZ000                                                     $F1B60728
       BCD 1400000                                                     $F1B60729
       MZE     ,,205                                                   $F1B60730
       REM                                                             $F1B60731
       BSS     CITSIZ-20                                               $F1B60740
       BSS     CITSIZ         LENGTH OF SECOND CIT BUFFER.              F1B60750
ENDCIT SYN     *              END OF CIT BUFFER.                        F1B60760
       REM                                                              F1B60770
ENDONE BSS 0                         RECORD LIMIT FOR PASS TWO.         F1B60780
       REM                                                              F1B60790
       REM                                                              F1B60800
COMERA ORG     ENDCIT                                                   F1B60810
       REM                                                              F1B60820
2H     BSS 1                                                            F1B60830
3LBAR  BSS 1                         STORAGE USED BY ARITHMETIC.        F1B60840
ARERAS BSS 1                         STORAGE USED BY ARITHMETIC.        F1B60850
ARGCTR BSS 1                         STORAGE USED BY ARITHMETIC.        F1B60860
DIMSAV BSS 1                         WORKING STORAGE USED BY SS000.     F1B60870
EPSM3  BSS 3                                                            F1B60880
 EPS   BSS 1                         EPSILON - VARIABLE USED BY RA000.  F1B60890
 GTAG  BSS 1                         VARIABLE USED BY IOT, RA.          F1B60900
I      BSS 1                                                            F1B60910
LENGTH BSS 1                                                            F1B60920
NBAR   BSS 1                         STORAGE USED BY ARITHMETIC.        F1B60930
 N2    BSS 1                                                            F1B60940
PHI(I) BSS 1                                                            F1B60950
 SL    BSS 1                                                            F1B60960
SYMBOL BSS 1                         WORKING STORAGE USED BY SS000.     F1B60970
       SYN     *              END OF ERASABLE COMMON TO STATES A,B,C,D. F1B60980
       REM                                                              F1B60990
       REM *************************************************************F1B61000
       REM                                                              F1B61010
       EJECT                                                            F1B61020
       REM     TABLE BUFFER RESERVATIONS.                               F1B61030
       REM                                                              F1B61040
       REM *************************************************************F1B61050
       REM                                                              F1B61060
       REM ERASABLE/1-PASS1 SPECIFICATION TABLE BUFFERS=                F1B61070
       REM ERASABLE USED ONLY BY PASS 1.                                F1B61080
       REM                                                              F1B61090
       ORG     TABORG-BFSZ    TEMPORARY FORMAT BUFFER.                  F1B61100
       BSS     0              EXTENDS UP TO TABORG.                     F1B61110
       REM                                                              F1B61120
       REM                                                              F1B61130
       REM                                                              F1B61140
       REM     ERASABLE/ PASS 1 AND PASS 2 COMMON TABLE BUFFERS.        F1B61150
       REM                                                              F1B61160
       REM                                                              F1B61170
       ORG     TABORG         ORIGIN FOR TABLE BUFFERS.                 F1B61180
SIGMA1 BSS     SGMASZ         SIGMA TABLE.                              F1B61190
FLCNBF BSS     FLCNSZ         FLOCON TABLE.                             F1B61200
DIM1BF BSS     DIM1SZ*2       DIM1 TABLE.                               F1B61210
DIM2BF BSS     DIM2SZ*2       DIM2 TABLE.                               F1B61220
DIM3BF BSS     DIM3SZ*3       DIM3 TABLE.                               F1B61230
DLT1BF BSS     DLT1SZ*2       DLST1 TABLE.                              F1B61240
DLT2BF BSS     DLT2SZ         DLST2 TABLE.                              F1B61250
FMTNBF BSS     FMTNSZ         FMTEFN BUFFER.                            F1B61260
ENDIBF BSS     ENDISZ         END TABLE.                                F1B61270
TRADBF BSS     TRADSZ         TRAD BUFFER.                              F1B61280
CALLBF BSS     CALLSZ         CALLFN BUFFER.                            F1B61290
FRVLBF BSS     FRVLSZ*2       FORVAL BUFFER                             F1B61300
FRVRBF BSS     FRVRSZ*2       FORVAR BUFFER.                            F1B61310
FRTGBF BSS     FRTGSZ         FORTAG BUFFER.                            F1B61320
EQITBF BSS     EQITSZ*2       EQUIT BUFFER.                             F1B61330
FRMTBF BSS     FRMTSZ         FORMAT STATEMENT BUFFER.                  F1B61340
SBDFBF BSS     SBDFSZ         SUBDEF BUFFER.                            F1B61350
STOPBF BSS     STOPSZ         TSTOPS BUFFER.                            F1B61360
NONXBF BSS     NONXSZ         NONEXC BUFFER.                            F1B61370
       BSS     1              RESERVATION FOR FRET WORD COUNT.          F1B61380
TIFGBF BSS     TIFGSZ*2       TIFGO BUFFER.                             F1B61390
CLSBBF BSS     CLSBSZ         CLOSUB BUFFER.                            F1B61400
TEIFBF BSS     TEIFSZ         TEIFNO BUFFER.                            F1B61410
DOLPBF BSS     DOLPSZ*5       TDO BUFFER.                               F1B61420
CMMNBF BSS     CMMNSZ         COMMON BUFFER.                            F1B61430
HLRGBF BSS     HLRGSZ         HOLARG BUFFER.                            F1B61440
FRETBF BSS     FRETSZ         FRET BUFFER.                              F1B61450
OTHRBF BSS     OTHRSZ         VARIABLE FOR ADJUSTING BUFFER POSITIONS.  F1B61460
TAU1BF BSS     TAU1SZ*2       TAU1 TABLE.                               F1B61470
TAU2BF BSS     TAU2SZ*4       TAU2 TABLE.                               F1B61480
TAU3BF BSS     TAU3SZ*6       TAU3 TABLE.                               F1B61490
FXCNWC BSS     1              WORD COUNT OF FIXCON TABLE.               F1B61500
FXCNBF BSS     FXCNSZ         FIXCON TABLE.                             F1B61510
ELSEBF BSS     ELSESZ         VARIABLE FOR ADJUSTING BUFFER POSITIONS.  F1B61520
FRSBBF BSS     FRSBSZ*2       FORSUB BUFFER.                            F1B61530
       BSS     1                                                        F1B61540
       REM                                                              F1B61550
       REM                                                              F1B61560
GERASE SYN     *                                                        F1B61570
       REM                                                              F1B61580
       REM *************************************************************F1B61590
       REM                                                              F1B61600
       REM     SECTION I INTERNAL TABLES, BUFFERS AND ERASABLE.         F1B61610
       REM                                                              F1B61620
       REM *************************************************************F1B61630
       REM                                                              F1B61640
       REM                                                              F1B61650
       ORG     GERASE                                                   F1B61660
       REM     GENERAL ERASABLE AS USED BY STATE A.                     F1B61670
 OP    BSS 1                                                            F1B61680
 SA    BSS 1                                                            F1B61690
 RA    BSS 1                                                            F1B61700
 BIN   BSS 1                                                            F1B61710
 SYM   BSS 1                                                            F1B61720
 CHR   BES 6                                                            F1B61730
       BSS 250                                                          F1B61740
 DOLEV BSS 1                                                            F1B61750
TLDOS  BSS 1000                      DO TABLE USED BY IOT.              F1B61760
TLINE  BSS 1                                                            F1B61770
       SYN     *              END OF STATE A ERASABLE.                  F1B61780
       REM                                                              F1B61790
       REM *************************************************************F1B61800
       REM                                                              F1B61810
       REM     GENERAL ERASABLE AS USED BY STATE B.                     F1B61820
       REM                                                              F1B61830
       ORG GERASE                                                       F1B61840
LAMBDA BSS     LAMBSZ         LAMBDA TABLE.                             F1B61850
CBAR   BSS 1                                                            F1B61860
ABAR   BSS 1                                                            F1B61870
FSTYPE BSS 1                                                            F1B61880
FSBITS BSS 1                                                            F1B61890
FNBITS BSS 1                                                            F1B61900
CHSAVE BSS 1                         WORKING STORAGE USED BY ROYCNV.    F1B61910
DOE    BSS 1                                                            F1B61920
EKE    BSS 1                                                            F1B61930
H      BSS 1                                                            F1B61940
N      BSS 1                                                            F1B61950
ARGREG BSS     RGRGSZ         ARGREG TABLE.                             F1B61960
ALPHA  BSS     ALPHSZ         ALPHA TABLE.                              F1B61970
       SYN     *              END OF STATE B ERASABLE.                  F1B61980
       REM                                                              F1B61990
       REM *************************************************************F1B62000
       REM                                                              F1B62010
       REM     GENERAL ERASABLE AS USED BY STATE C.                     F1B62020
       REM                                                              F1B62030
       ORG     GERASE+LAMBSZ-SCRPSZ                                     F1B62040
SCRIPL BSS     SCRPSZ         OPTIMIZED LAMBDA TABLE.                   F1B62050
BETA   BSS     BETASZ         BETA TABLE.                               F1B62060
CPBETA SYN     BETA                                                     F1B62070
       SYN     *              END OF STATE C ERASABLE.                  F1B62080
       REM                                                              F1B62090
       REM *************************************************************F1B62100
       REM                                                              F1B62110
       REM     GENERAL ERASABLE AS USED BY STATE D.                     F1B62120
       REM                                                              F1B62130
       ORG     SCRIPL-20                                                F1B62140
FNSW   BSS 1                                                            F1B62150
P(CNTR BSS 1                                                            F1B62160
ARGORG BSS 1                                                            F1B62170
XRSAVE BSS 1                                                            F1B62180
CW     BSS 4                                                            F1B62190
TAGWRD BSS 1                                                            F1B62200
OPWORD BSS 1                                                            F1B62210
SYMWRD BSS 1                                                            F1B62220
TAGPRT BSS 1                                                            F1B62230
XCAIND BSS 1                                                            F1B62240
       SYN     *              END OF STATE D ERASABLE.                  F1B62250
       REM                                                              F1B62260
       REM                                                              F1B62270
FORSUB SYN     FRSBBF         FORSUB TABLE ORIGIN CAN ONLY BE DEFINED   F1B62280
       REM                    AT TIME OF ASSEMBLY.                      F1B62290
       REM                                                              F1B62300
       REM                                                              F1B62310
       REM     OTHER TABLES WHICH CAN ONLY BE DEFINED AT ASSEMBLY       F1B62320
       REM     TIME ARE  ....... ALHPA, BETA, LAMBDA, SCRIPL, AND ANY   F1B62330
       REM                       OTHERS NOT DEFINED BY / OR HANDLED     F1B62340
       REM                       BY A GENERALIZED ROUTINE.              F1B62350
       REM                                                              F1B62360
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B62370
       REM                                                              F1B62380
       REM  END OF SECTION ONE.                                         F1B62390
       REM                                                              F1B62400
       REM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *F1B62410
       TCD     -1                                                      $F1B62420
       TTL * SECTION ONE * DIAGNOSTIC * RECORD 9F15 *                   F1C00000
       REM     SECTION ONE DIAGNOSTIC ROUTINE.                          F1C00010
       REM                                                              F1C00020
       REM                                                              F1C00030
       LBL     9F15,THE WORKS                                           F1C00050
       REM                                                              F1C00060
       ORG     SYSCUR                                                  $F1C00070
       BCI     1,9F1500                                                $F1C00080
       ORG     (LODR)                                                  $F1C00090
       TXI     DIAG00,,150             ENTRY POINT,,RECORD NUMBER       F1C00100
       REM                                                              F1C00110
       REM                                                              F1C00120
       REM THIS RECORD IS CALLED IN FROM TAPE ONCE FOR EACH ERROR IN    F1C00130
       REM SECTION ONE AND ONCE AT THE END OF SECTION ONE.              F1C00140
       REM                                                              F1C00150
       ABS                                                              F1C00160
       ORG     GERASE        DIAGNOSTIC OCCUPIES GENERAL ERASABLE.      F1C00170
       REM                                                              F1C00180
DIAG00 LDC     ONLINE,4                                                 F1C00190
       TXH     DIAG06,4,0                                               F1C00200
       REM                                                              F1C00210
       REM     TERMINAL ROUTINE FOR DIAGNOSTIC.                         F1C00220
       REM     ALSO END OF SECTION ONE WHEN THERE HAS BEEN A SOURCE     F1C00230
       REM     PROGRAM ERROR.                                           F1C00240
       AXT     3,1            WRITE END OF DIAGNOSTIC COMMENT,          F1C00250
       TSX     (TAPE),4       AN END-OF-FILE,                           F1C00260
       PZE     DIAGA,1,-1     AND REWIND SCRATCH TAPE.                  F1C00270
       PZE     DLBL,,BUFTAP                                             F1C00280
       TIX     *-3,1,1                                                  F1C00290
       TSX     (TAPE),4       POSITION INPUT TAPE TO END OF             F1C00300
       PZE     BSPCF,,(SKBP)  SOURCE PROGRAM.                           F1C00310
       PZE     ,,INPUTP                                                 F1C00320
       LDI*    (FGBX)         LOAD MONITOR FLAGS.                       F1C00330
       LNT     400000         IS THIS MONITOR MODE.                     F1C00340
       TRA     *+3            NO, SINGLE COMPILE.                       F1C00350
       CAL*    (LNCT)         YES, GET LINE COUNT AND NUMBER OF         F1C00360
       LXD     (PGCT),1       LINES PER PAGE.                           F1C00370
DIAG01 TSX     (TAPE),4       READ A RECORD FROM THE SCRATCH TAPE.      F1C00380
       PZE     RDIAG,,(RBEC)                                            F1C00390
       PZE     DLBL,,BUFTAP                                             F1C00400
       PZE     DIAGER         ERROR RETURN.                             F1C00410
       LXA     (SCHU)+BUFTAP,4 GET RESULT OF SCHX.                      F1C00420
       TXL     DIAG05,4,0    *EOF READ, MESSAGES TRANSFERRED.           F1C00430
       TXI     *+1,4,-DIGBUF  COMPUTE WORD COUNT OF RECORD.             F1C00440
       SXD     DIAG03,4       SET WORD COUNT IN I/O COMMAND.            F1C00450
       SXD     DIAGN3,4                                                $F1C00455
DIAG02 NZT     ONLINE         SHOULD MESSAGE BE PRINTED ON-LINE.        F1C00460
       TRA     *+3           *NO, JUST WRITE ON OUTPUT TAPE.            F1C00470
       TSX     (PRNT),4       YES, PRINT ON-LINE.                       F1C00480
DIAG03 PZE     DIGBUF,,**                                               F1C00490
       LNT     400000         IS THIS MONITOR MODE.                     F1C00500
       TRA     DIAG04        *NO, WRITE ON INPUT TAPE.                  F1C00510
       REM                                                              F1C00520
       NZT     *+2            IS THIS FIRST LINE OF OUTPUT.             F1C00530
       TRA     *+8            NO, DO NOT MODIFY.                        F1C00540
       STZ     *              YES, RESET SWITCH.                        F1C00550
       LDQ     DIGBUF         DELETE PROGRAM CONTROL CHARACTER.         F1C00560
       LGL     6                                                        F1C00570
       CAL     BLANK          REPLACE WITH BLANK.                       F1C00580
       LGR     6                                                        F1C00590
       STQ     DIGBUF         REPLACE FIRST WORD.                       F1C00600
       CAL*    (LNCT)         RESTORE LINE COUNT.                       F1C00610
       TSX     (TAPE),4       YES, WRITE MESSAGES ON MONITOR OUTPUT     F1C00620
       PZE     DIAGN3,,(WDNC) TAPE.                                    $F1C00630
       PZE     ,,MLSTAP                                                 F1C00640
       ADD     L(1)           INCREMENT LINES OUTPUT THIS JOB.          F1C00650
       TIX     DIAG01,1,1     IS THE PAGE FULL.                         F1C00660
       LXD     (PGCT),1       YES, RELOAD NUMBER OF LINES PER PAGE.     F1C00670
       TSX     (TAPE),4       WRITE PAGE EJECT WORD.                    F1C00680
       PZE     EJECT,,(WDNP)                                            F1C00690
       PZE     ,,MLSTAP                                                 F1C00700
       TRA     DIAG01         GET NEXT LINE.                            F1C00710
       REM                                                              F1C00720
DIAG04 LDQ     DIGBUF         REPLACE FIRST CHARACTER WITH BLANK        F1C00730
       LGL     6              BEFORE WRITING LINE ON INPUT TAPE.        F1C00740
       CAL     BLANK                                                    F1C00750
       LGR     6                                                        F1C00760
       STQ     DIGBUF         SET LINE FOR SINGLE SPACE PRINTING.       F1C00770
       TSX     (TAPE),4       WRITE LINE ON INPUT TAPE.                 F1C00780
       PZE     DIAGN3,,(WDNC)                                          $F1C00790
       PZE     ,,INPUTP                                                 F1C00800
       PZE     DIAGER         ERROR RETURN.                             F1C00810
       TRA     DIAG01         GET NEXT LINE.                            F1C00820
       REM                                                              F1C00830
       REM     ENTRY TO TERMINATE DIAGNOSTIC ON MACHINE ERROR.          F1C00840
       REM                                                              F1C00850
DIAGER TSX     (PRNT),4       PRINT APPROPRIATE COMMENT ABOUT           F1C00860
       IOCT    GOOFUP,,11    MACHINE ERROR.                            $F1C00870
       AXT     INPUTP,4       PRESUME SINGLE COMPILE OUTPUT.            F1C00880
       LFT     400000         IS THIS MONITOR MODE.                     F1C00890
       AXT     MLSTAP,4       YES, LOAD MONITOR OUTPUT TAPE ADDRESS.    F1C00900
       SXD     *+3,4          SET TAPE ADDRESS.                         F1C00910
       TSX     (TAPE),4       WRITE COMMENT ON OUTPUT TAPE.             F1C00920
       PZE     GFUPMS,,(WDNP)                                          $F1C00930
       PZE     ,,**                                                     F1C00940
       ADD     L(1)           INCREMENT LINE COUNT.                     F1C00950
       REM                                                              F1C00960
DIAG05 LFT     400000         IS THIS MONITOR MODE.                     F1C00970
       STA*    (LNCT)         YES, SAVE COUNT OF LINES OUTPUT.          F1C00980
       LFT     400000         IS THIS MONITOR MODE.                     F1C00990
       TRA     *+4            YES, NO NEED TO WRITE AN EOF              F1C01000
       TSX     (TAPE),4       AFTER DIAGNOSTIC MESSAGES ON              F1C01010
       PZE     ,,(WEFP)       INPUT TAPE.                               F1C01020
       PZE     ,,INPUTP                                                 F1C01030
       TSX     (TAPE),4       REWIND INPUT TAPE.                        F1C01040
       PZE     REWD,,(SKDP)                                             F1C01050
       PZE     ,,INPUTP                                                 F1C01060
       TRA     (SECL)         GO TO SOURCE PROGRAM ERROR RECORD.        F1C01070
       REM                                                              F1C01080
DIAG06 PXA     ,4             SAVE LOCATION OF CALL TO DIAGNOSTIC.      F1C01090
       STO     OCTNUM                                                   F1C01100
       LGR     15             CONVERT TO BCD FORM FOR PRINTING.         F1C01110
       AXT     5,1            LOAD LOOP COUNT.                          F1C01120
       CAL     BLANK          LEAD OFF WITH A BLANK.                    F1C01130
       ALS     3                                                        F1C01140
       LGL     3                                                        F1C01150
       TIX     *-2,1,1                                                  F1C01160
       SLW     XCOM           BE A PESSIMIST, SAVE IN NOT LISTED MESSAGEF1C01170
       ZET     DGFLAG         IS THIS FIRST CALL TO DIAGNOSTIC.         F1C01180
       TRA     DIAG07        *NO, SKIP HEADING.                         F1C01190
       REM                                                              F1C01200
       REM                                                              F1C01210
       SXA     DGFLAG,4       RESET FIRST CALL FLAG.                    F1C01220
       STZ     DGX1           SET TAPE POSITIONING FLAG.                F1C01230
       TSX     (TAPE),4       REWIND SCRATCH TAPE.                      F1C01231
       PZE     REWD,,(SKBP)                                             F1C01232
       PZE     DLBL,,BUFTAP                                             F1C01233
       AXT     3,1            LOAD PARAMETER MODIFIER.                  F1C01240
       TSX     (TAPE),4       WRITE PAGE EJECT,                         F1C01250
       PZE     DIAGHD,1,(WBNP) BLANKS,                                  F1C01260
       PZE     DLBL,,BUFTAP   AND DIAGNOSTIC HEADING.                   F1C01270
       TIX     *-3,1,1                                                  F1C01280
       REM                                                              F1C01290
       REM     WRITE OUT THE STATEMENT IN ERROR FROM CURRENT F-REGION.  F1C01300
       REM                                                              F1C01310
DIAG07 LXD     DCF,1          LOAD 2S COMPLEMENT OF F-REGION ORIGIN.    F1C01320
       CLA     FIRST5         MOVE FIRST FIVE CHARACTERS OF STATEMENT   F1C01330
       STO     -2,1           (MODE INDICATOR AND EFN - IF ANY).        F1C01340
       CAL     BLANKS         GET A WORD OF BLANKS AND SET FIRST        F1C01350
       STP     -2,1           CHARACTER OF STATEMENT TO A BLANK.        F1C01360
       CLA     BLANKS         SEPARATE FROM REST OF STATEMENT WITH A    F1C01370
       STO     -1,1           WORD OF BLANKS TO MAKE IT LOOK PRETTY.    F1C01380
       SXD     DIAG08,1       SET -ORIGIN FOR WORD COUNT COMPUTATION.   F1C01390
       CAL     ALL1           SEARCH FOR END MARKER.                    F1C01400
       LAS     0,1            LOOK FOR WORD OF ALL BINARY ONES.         F1C01410
       TXI     *-1,1,-1       NOT END OF STATEMENT, CONTINUE SEARCH.    F1C01420
       TXI     *+2,1,-2       END OF STATEMENT FOUND.                   F1C01430
       TXI     *-3,1,-1       SAME AS *-2.                              F1C01440
       PXD     ,1             GET TRUE ADDRESS OF END OF STATEMENT      F1C01450
       PDC     ,1             (INCLUDES COUNT OF 2 ADDITIONAL WORDS).   F1C01460
DIAG08 TXI     *+1,1,**       COMPUTE WORD COUNT OF STATEMENT PLUS      F1C01470
       SXD     STATE,1        FIRST FIVE PLUS WORD OF BLANKS.           F1C01480
       LDC     DCF,4          GET TRUE ORIGIN OF F-REGION.              F1C01490
       TXI     *+1,4,-2       REDUCE TO INCLUDE FIRST 5 CHARACTERS AND  F1C01500
       SXA     STATE,4        WORD OF BLANKS.  SET PARAMETER.           F1C01510
       TSX     (TAPE),4       WRITE A LINE OF BLANKS                    F1C01520
       PZE     LOOKS,,(WBNP)  FOR APPEARANCE.                           F1C01530
       PZE     DLBL,,BUFTAP                                             F1C01540
       REM                                                              F1C01550
       REM                                                              F1C01560
       REM THERE ARE TWO FORTRAN LANGUAGE STATEMENTS..                  F1C01570
       REM                                                              F1C01580
       REM IF(...) N1, N2, N3     AND  CALL NAME(ARG1,...,ARGN)         F1C01590
       REM                                                              F1C01600
       REM WHICH ARE MODIFIED BY SECTION ONE INTO QUASI-ARITHMETIC      F1C01610
       REM STATEMENTS IN ORDER TO PROCESS BY THE ARITHMETIC TRANSLATOR. F1C01620
       REM IT IS NOW NECESSARY TO SCAN THE PRESENT STATEMENT FOR EITHER F1C01630
       REM OF THESE AND IF SO CONVERT IT BACK TO ITS ORIGINAL FORM.     F1C01640
       REM                                                              F1C01650
       TSX     C0190X,4      SET SCAN TO FIRST CHARACTER.               F1C01660
       TSX     C0190,4       MOVE SCAN TO SECOND CHARACTER.             F1C01670
       CAL     LEFT+2        TEST FOR IF OR CALL STATEMENT.             F1C01680
       LGR     24                                                       F1C01690
       CAS     CALLER        IS THIS A CALL STATEMENT.                  F1C01700
       TRA     DIAG11                                                   F1C01710
       TRA     DIAG14        YES, GO TO RECONVERT TO ORIGINAL FORM.     F1C01720
DIAG11 SUB     IFSYM         IS THIS AN IF STATEMENT.                   F1C01730
       TNZ     DIAG16        NEITHER, GO PRINT AS IS.                   F1C01740
       LDQ     L(I)                                                     F1C01750
       TSX     C0390,4       RESTORE I.                                 F1C01760
       LDQ     L(F)                                                     F1C01770
       TSX     C0390,4       RESTORE F.                                 F1C01780
       SUB     EQUAL         TEST THIRD CHAR FOR EQUAL.                 F1C01790
       TNZ     DIAG16        NOT EQUAL, STATEMENT GARBLED, PRINT AS IS. F1C01800
       LDQ     OPEN                                                     F1C01810
       TSX     C0390,4       RESTORE (                                  F1C01820
       TRA     DIAG13                                                   F1C01830
DIAG12 TSX     C0190,4       SEARCH FOR ENDMK CHARACTER AND IF FOUND    F1C01840
DIAG13 SUB     ENDMK         RESTORE TO )   IF NOT FOUND PRINT AS IS.   F1C01850
       TNZ     DIAG12                                                   F1C01860
       LDQ     CLOS                                                     F1C01870
       TRA     DIAG15                                                   F1C01880
       REM                                                              F1C01890
DIAG14 LDQ     L(C)                                                     F1C01900
       TSX     C0390,4       RESTORE C.                                 F1C01910
       LDQ     L(A)                                                     F1C01920
       TSX     C0390,4       RESTORE A.                                 F1C01930
       LDQ     L(L)                                                     F1C01940
       TSX     C0390,4       RESTORE FIRST L.                           F1C01950
       LDQ     L(L)                                                     F1C01960
DIAG15 TSX     C0390,4       RESTORE SECOND L.                          F1C01970
       REM                                                              F1C01980
       REM                                                              F1C01990
DIAG16 TSX     WRDG0,4        WRITE STATEMENT ON SCRATCH TAPE.          F1C02000
STATE  PZE     **,,**                                                   F1C02010
       REM                                                              F1C02020
       AXT     ENDIAG-TABLE,1        SET LOOP SAFETY COUNT.             F1C02030
       AXC     TABLE,2       GET TABLE BEGINNING ADDRESS IN IR2.        F1C02040
DIAG17 CLA     1BAR                                                     F1C02050
       CAS     0,2           TEST FOR END OF TABLE OF MESSAGES.         F1C02060
       TRA     DIAG18                                                   F1C02070
       TRA     DIAG24        YES, EXIT AND PRINT UNLISTED ERROR MESSAGE.F1C02080
DIAG18 ADD     OCTNUM        FORM LABEL OF MESSAGE BEING SEARCHED FOR.  F1C02090
       CAS     0,2                                                      F1C02100
       TXI     DIAG19,2,-1   NO                                         F1C02110
       TXI     DIAG20,1,-1   FOUND, EXIT.                               F1C02120
       TXI     DIAG19,2,-1   NO                                         F1C02130
DIAG19 TIX     DIAG17,1,1    CONTINUE SEARCH IF ANY TABLE REMAINS.      F1C02140
       TRA     DIAG24        TABLE EXHAUSTED, NO END SIGNAL, EXIT.      F1C02150
DIAG20 TXI     *+1,2,1        GET ADDRESS OF MESSAGE MINUS 2 WORDS.     F1C02160
       SXD     DIAG23,2       SET FOR WORD COUNT COMPUTATION.           F1C02170
       LDC     DIAG23,4       GET TRUE ADDRESS.                         F1C02180
       SXA     COMM,4         SET IN I/O COMMAND.                       F1C02190
       CLA     XCOM           GET LOCATION OF CALL.                     F1C02200
       STO     0,2            INSERT AHEAD OF MESSAGE AND SEPARATE      F1C02210
       CLA     BLANKS         FROM MESSAGE WITH BLANKS.                 F1C02220
       STO     1,2                                                      F1C02230
       TXI     *+2,2,-2       RESET INDEX AND SEARCH FOR END OF MESSAGE.F1C02240
DIAG21 TXI     *+1,2,-1       SEARCH FOR END OF MESSAGE.                F1C02250
       CAL     0,2            GET NEXT WORD OF MESSAGE AREA.            F1C02260
       ANA     1BAR           GET DECREMENT FIELD.                      F1C02270
       ERA     1BAR           IS THIS AN END MARK.                      F1C02280
       TZE     *+2           *YES.                                      F1C02290
       TIX     DIAG21,1,1     NO, CONTINUE SEARCH OR QUIT.              F1C02300
       PXD     ,2             GET TRUE ADDRESS OF END OF MESSAGE.       F1C02310
       PDC     ,2                                                       F1C02320
DIAG23 TXI     *+1,2,**       SUBTRACT THE FIRST ADDRESS.               F1C02330
       SXD     COMM,2         SET WORD COUNT OF PARAMETER.              F1C02340
DIAG24 TSX     WRDG0,4        WRITE MESSAGE ON SCRATCH TAPE.            F1C02350
COMM   PZE     XCOM,,XXCOM-XCOM PRESET TO NOT LISTED MESSAGE.           F1C02360
       TSX     (TAPE),4       REPOSITION SYSTEM TAPE IN FRONT OF        F1C02370
       PZE     BKSP,,(SKBP)   DIAGNOSTIC.                               F1C02380
       PZE     ,,SYSTAP                                                 F1C02390
       ZAC                    SET ERROR FLAG FOR                        F1C02400
       SSM                    INPUT ROUTINE.                            F1C02410
       STO     TLABEL                                                   F1C02420
       TRA     PASS1          RETURN TO PASS 1 OR PASS 2.               F1C02430
       REM                                                              F1C02440
WRDG0  SXA     WRDG3,1        SAVE INDEX REGISTERS.                     F1C02450
       SXA     WRDG3+1,2                                                F1C02460
       SXA     WRDG3+2,4                                                F1C02470
       CLA     1,4            GET I/O COMMAND (PARAMETERS).             F1C02480
       PDX     ,1             LOAD WORD COUNT.                          F1C02490
       TXL     WRDG3,1,0      IS WORD COUNT ZERO.                       F1C02500
       TSX     (TAPE),4       NO, WRITE A LINE OF BLANKS                F1C02510
       PZE     LOOKS,,(WBNP)  FOR APPEARANCE.                           F1C02520
       PZE     DLBL,,BUFTAP                                             F1C02530
       PAX     ,2             LOAD FIRST ADDRESS.                       F1C02540
       SXA     WRDG4,2        SET FIRST ADDRESS IN I/O COMMAND.         F1C02550
WRDG1  TXL     WRDG2,1,20     IS IT GREATER THAN A FULL LINE.           F1C02560
       TSX     (TAPE),4       YES, WRITE IT OUT IN 20 WORD SEGMENTS.    F1C02570
       PZE     WRDG4,,(WBNC)                                            F1C02580
       PZE     DLBL,,BUFTAP                                             F1C02590
       TXI     *+1,1,-18      REDUCE WORD COUNT, ALLOW FOR INSERTING    F1C02600
       TXI     *+1,2,18       BLANKS, AND UPDATE ADDRESS.               F1C02610
       SXA     WRDG4,2        SET NEW ADDRESS IN I/O COMMAND.           F1C02620
       CAL     BLANKS         INSERT TWO WORDS OF BLANKS AHEAD OF       F1C02630
       SLW*    WRDG4          THIS SEGMENT.                             F1C02640
       TXI     *+1,2,1        ADD 1 TO NEW FIRST ADDRESS FOR INSERTING  F1C02650
       SXA     *+1,2          SECOND WORD OF BLANKS.                    F1C02660
       SLW     **                                                       F1C02670
       TXI     WRDG1,2,-1     RESET FIRST ADDRESS, TEST FOR FULL LINE.  F1C02680
       REM                                                              F1C02690
WRDG2  SXA     WRDG5,2        SET FIRST ADDRESS OF I/O COMMAND AND      F1C02700
       SXD     WRDG5,1        WORD COUNT FOR FULL OR PARTIAL LINE.      F1C02710
       TSX     (TAPE),4       WRITE REMAINDER ON SCRATCH TAPE.          F1C02720
       PZE     WRDG5,,(WBNC)                                            F1C02730
       PZE     DLBL,,BUFTAP                                             F1C02740
WRDG3  AXT     **,1           RELOAD INDEX REGISTERS.                   F1C02750
       AXT     **,2                                                     F1C02760
       AXT     **,4                                                     F1C02770
       TRA     2,4            RETURN TO CALLER.                         F1C02780
       REM                                                              F1C02790
WRDG4  IORT    **,,20         I/O COMMAND TO WRITE FULL LINE.           F1C02800
WRDG5  IORT    **,,**         I/O COMMAND TO WRITE PARTIAL LINE.        F1C02810
       REM                                                              F1C02820
EJECT  IORT    UPPAGE,,3      I/O COMMAND TO WRITE PAGE EJECT.          F1C02830
LOOKS  IORT    START,,3       I/O COMMAND TO WRITE A BLANK LINE.        F1C02840
       IORT    START,,STOP-START I/O COMMAND TO WRITE DIAGNOSTIC TITLE. F1C02850
DIAGHD SYN     *                                                        F1C02860
       REM                                                              F1C02870
       IOCT    STOPM,,(WBNP)  PARAMETER FOR WRITING END OF DIAGNOSTIC. $F1C02880
       PZE     ,,(WEFP)       PARAMETER FOR WRITING END OF FILE.        F1C02890
       PZE     REWD,,(SKDP)   PARAMETER FOR REWINDING SCRATCH TAPE.     F1C02900
DIAGA  SYN     *                                                        F1C02910
STOPM  IORT    STOP,,XCOM-STOP I/O COMMAND FOR WRITING END DIAGNOSTIC.  F1C02920
       REM                                                              F1C02930
BSPCF  MZE     ,,1            I/O COMMAND TO BACKSPACE ONE FILE.        F1C02940
RDIAG  IORT    DIGBUF,,21     I/O COMMAND TO READ A RECORD (LINE)       F1C02950
       REM                    FROM THE SCRATCH TAPE.                    F1C02960
       REM                                                              F1C02970
OCTNUM PZE     **             LOCATION OF CALLER (TSX) TO DIAGNOSTIC.   F1C02980
DLBL   BCI     1,ERRCOM       DIAGNOSTIC MESSAGE LABEL.                 F1C02981
       REM                                                              F1C02982
UPPAGE BCI     1,1                                                      F1C02990
START  BCI     7,                                                       F1C03000
       BCI     8,709/7090 FORTRAN DIAGNOSTIC PROGRAM RESULTS            F1C03010
STOP   BCI     7,                                                       F1C03020
       BCI     6,END OF DIAGNOSTIC PROGRAM RESULTS.                     F1C03030
       REM                                                              F1C03040
XCOM   BCI     2,                                                       F1C03050
       BCI     9,THIS ERROR IS NOT LISTED IN THE DIAGNOSTIC PROGRAM ERR F1C03060
       BCI     2,OR LIST.                                               F1C03070
XXCOM  SYN     *                                                        F1C03080
       REM                                                              F1C03090
GOOFUP BCI     9,0 DIAGNOSTIC PROGRAM RESULTS DISCONTINUED DUE TO A MAC F1C03100
       BCI     2,HINE ERROR.                                            F1C03110
       REM                                                              F1C03120
DIGBUF BSS     21             INPUT BUFFER FROM SCRATCH TAPE.           F1C03130
       REM                                                              F1C03140
DIAGN3 IOCT    DIGBUF,,**                                              $F1C03141
GFUPMS IOCT    GOOFUP,,11                                              $F1C03142
       SYN     *              BEGINNING OF DIAGNOSTIC PATCH AREA.       F1C03150
       BSS     50             PATCH AREA.                               F1C03160
       SYN     *              END OF DIAGNOSTIC PATCH AREA.             F1C03170
       REM                                                              F1C03180
       REM                                                              F1C03190
       REM TABLE OF DIAGNOSTIC COMMENTS, SECTION ONE OF 709 FORTRAN II. F1C03200
       REM                                                              F1C03210
TABLE  BSS     0                                                        F1C03220
       REM                                                              F1C03230
       PZE 1,,-1                                                        F1C03240
       BCD 4DIM3 TABLE EXCEEDED.                                        F1C03250
       REM                                                              F1C03260
       PZE 2,,-1                                                        F1C03270
       BCD 4DIM2 TABLE EXCEEDED.                                        F1C03280
       REM                                                              F1C03290
       PZE 3,,-1                                                        F1C03300
       BCD 4DIM1 TABLE EXCEEDED.                                        F1C03310
       REM                                                              F1C03320
       PZE 6,,-1                                                        F1C03330
       BCD 4SIGMA TABLE EXCEEDED.                                       F1C03340
       REM                                                              F1C03350
       PZE 7,,-1                                                        F1C03360
       BCD 4TAU3 TABLE EXCEEDED.                                        F1C03370
       REM                                                              F1C03380
       PZE 8,,-1                                                        F1C03390
       BCD 4TAU2 TABLE EXCEEDED.                                        F1C03400
       REM                                                              F1C03410
       PZE 9,,-1                                                        F1C03420
       BCD 4TAU1 TABLE EXCEEDED.                                        F1C03430
       REM                                                              F1C03440
       PZE 10,,-1                                                       F1C03450
       BCD 4FLOCON TABLE EXCEEDED.                                      F1C03460
       REM                                                              F1C03470
       PZE 11,,-1                                                       F1C03480
       BCD 4FIXCON TABLE EXCEEDED.                                      F1C03490
       REM                                                              F1C03500
       PZE ER0001,,-1                                                   F1C03510
       BCD 7MORE THAN SIX CHARACTERS IN SOME SYMBOL.                    F1C03520
       REM                                                              F1C03530
       PZE ER0002,,-1                                                   F1C03540
       BCD 5ILLEGAL USE OF PUNCTUATION.                                 F1C03550
       REM                                                              F1C03560
       PZE ER0004,,-1                                                   F1C03570
       BCD  NON-NUMERIC CHARACTER IN NUMERIC FIELD OR MISSING PUNCTUATIOF1C03580
       BCD 1N.                                                          F1C03590
       REM                                                              F1C03600
       PZE ER0005,,-1                                                   F1C03610
       BCD 7A SUBSCRIPT IS NOT A FIXED POINT VARIABLE.                  F1C03620
       REM                                                              F1C03630
       PZE ER0006,,-1                                                   F1C03640
       BCD 6A SUBSCRIPT HAS A DOUBLE MULTIPLIER.                        F1C03650
       REM                                                              F1C03660
       PZE ER0007,,-1                                                   F1C03670
       BCD 7A SUBSCRIPT MULTIPLIER IS NOT A CONSTANT.                   F1C03680
       REM                                                              F1C03690
       PZE ER0008,,-1                                                   F1C03700
       BCD  MORE THAN SIX CHARACTERS IN A SYMBOL WITHIN A SUBSCRIPT OR MF1C03710
       BCD 4ISSING PUNCTUATION.                                         F1C03720
       REM                                                              F1C03730
       PZE ER0009,,-1                                                   F1C03740
       BCD 8THERE IS AN ILLEGAL CHARACTER IN SOME SUBSCRIPT.            F1C03750
       REM                                                              F1C03760
       PZE ER0010,,-1                                                   F1C03770
       BCD 6A SUBSCRIPT HAS A DOUBLE ADDEND.                            F1C03780
       REM                                                              F1C03790
       PZE ER0011,,-1                                                   F1C03800
       BCD 7A SUBSCRIPT ADDEND IS NOT A CONSTANT.                       F1C03810
       REM                                                              F1C03820
       PZE ER0012,,-1                                                   F1C03830
       BCD 9PARENTHESIS MISSING IN SOME SUBSCRIPT COMBINATION.          F1C03840
       REM                                                              F1C03850
       PZE ER0013,,-1                                                   F1C03860
       BCD  A 3 DIMENSIONAL SUBSCRIPTED VARIABLE DOES NOT HAVE A DIMENSIF1C03870
       BCD 4ON STATEMENT ENTRY.                                         F1C03880
       REM                                                              F1C03890
       PZE ER0014,,-1                                                   F1C03900
       BCD  A 2 DIMENSIONAL SUBSCRIPTED VARIABLE DOES NOT HAVE A DIMENSIF1C03910
       BCD 4ON STATEMENT ENTRY.                                         F1C03920
       REM                                                              F1C03930
       PZE ER0015,,-1                                                   F1C03940
       BCD 7PROGRAM EXPECTS COMMA OR END OF STATEMENT.                  F1C03950
       REM                                                              F1C03960
       PZE ER0016,,-1                                                   F1C03970
       BCD 8PROGRAM EXPECTS COMMA OR RIGHT PARENTHESIS.                 F1C03980
       REM                                                              F1C03990
       PZE ER0017,,-1                                                   F1C04000
       BCD 9PROGRAM EXPECTS LEFT PARENTHESIS OR END OF STATEMENT.       F1C04010
       REM                                                              F1C04020
       PZE ER0019,,-1                                                   F1C04030
       BCD 6PROGRAM EXPECTS END OF STATEMENT.                           F1C04040
       REM                                                              F1C04050
       PZE ER0020,,-1                                                   F1C04060
       BCD 6PROGRAM EXPECTS LEFT PARENTHESIS.                           F1C04070
       REM                                                              F1C04080
       PZE ER0021,,-1                                                   F1C04090
       BCD 6PROGRAM EXPECTS RIGHT PARENTHESIS.                          F1C04100
       REM                                                              F1C04110
       PZE ER0022,,-1                                                   F1C04120
       BCD 4PROGRAM EXPECTS COMMA.                                      F1C04130
       REM                                                              F1C04140
       PZE ER0023,,-1                                                   F1C04150
       BCD  SYMBOL BEGINS NUMERIC WHICH IS ILLEGAL IN THIS CONTEXT.     F1C04160
       REM                                                              F1C04170
       PZE ER0024,,-1                                                   F1C04180
       BCD  SYMBOL BEGINS NON-NUMERIC WHICH IS ILLEGAL IN THIS CONTEXT. F1C04190
       REM                                                              F1C04200
       PZE ER0026,,-1                                                   F1C04210
       BCD  THE CHARACTER $ OCCURS SOMEWHERE OTHER THAN IN HOLLERITH TEXF1C04220
       BCD 1T.                                                          F1C04230
       REM                                                              F1C04240
       PZE ER0027,,-1                                                   F1C04250
       BCD 7ILLEGAL CHARACTER +0  (12-8-2 PUNCH).                       F1C04260
       REM                                                              F1C04270
       PZE ER0028,,-1                                                   F1C04280
       BCD 7ILLEGAL CHARACTER -0  (11-8-2 PUNCH).                       F1C04290
       REM                                                              F1C04300
       PZE ER0029,,-1                                                   F1C04310
       BCD 6ILLEGAL CHARACTER    (0-8-2 PUNCH).                         F1C04320
       REM                                                              F1C04330
       PZE ER0030,,-1                                                   F1C04340
       BCI     6,ILLEGAL CHARACTER '  (8-4 PUNCH).                      F1C04350
       REM                                                              F1C04360
       PZE ER0032,,-1                                                   F1C04370
       BCD 5TOO MANY RIGHT PARENTHESIS.                                 F1C04380
       REM                                                              F1C04390
       PZE ER0033,,-1                                                   F1C04400
       BCD  NON-ARITHMETIC STATEMENT OF A TYPE WHICH IS NOT IN DICTIONARF1C04410
       BCD 1Y.                                                          F1C04420
       REM                                                              F1C04430
       PZE ER0034,,-1                                                   F1C04440
       BCD 5TOO FEW RIGHT PARENTHESIS.                                  F1C04450
       REM                                                              F1C04460
       PZE ER0035,,-1                                                   F1C04470
       BCD 4PROGRAM EXPECTS WORD TO.                                    F1C04480
       REM                                                              F1C04490
       PZE ER0036,,-1                                                   F1C04500
       BCD  A VARIABLE IN THIS LIST APPEARED PREVIOUSLY IN A DIMENSION SF1C04510
       BCD 2TATEMENT.                                                   F1C04520
       REM                                                              F1C04530
       PZE ER0037,,-1                                                   F1C04540
       BCD 9MORE THAN 3 DIMENSIONS OR MISSING RIGHT PARENTHESIS.        F1C04550
       REM                                                              F1C04560
       PZE ER0038,,-1                                                   F1C04570
       BCD  A SUBROUTINE OR FUNCTION STATEMENT APPEARS LATER THAN THE FIF1C04580
       BCD 5RST STATEMENT OF THE PROGRAM.                               F1C04590
       REM                                                              F1C04600
       PZE ER0039,,-1                                                   F1C04610
       BCD  A RETURN STATEMENT HAS OCCURED IN A PROGRAM NOT DEFINED TO  F1C04620
       BCD 7BE A SUBROUTINE OR FUNCTION SUBPROGRAM.                     F1C04630
       REM                                                              F1C04640
       PZE ER0040,,-1                                                   F1C04650
       BCD 7SENSE SWITCH SETTING OTHER THAN 0, 1 OR 2.                  F1C04660
       REM                                                              F1C04670
       PZE ER0041,,-1                                                   F1C04680
       BCD 7MORE THAN SIX CHARACTERS IN SOME SYMBOL.                    F1C04690
       REM                                                              F1C04700
       PZE ER0042,,-1                                                   F1C04710
       BCD 6ILLEGAL CHARACTER IN THIS LIST.                             F1C04720
       REM                                                              F1C04730
       PZE ER0043,,-1                                                   F1C04740
       BCD 7ILLEGAL USE OF CONSTANT IN LIST.                            F1C04750
       REM                                                              F1C04760
       PZE ER0044,,-1                                                   F1C04770
       BCD  MORE THAN THREE LEVELS IN THIS LIST (NESTED PARENTHESIS).   F1C04780
       REM                                                              F1C04790
       PZE ER0045,,-1                                                   F1C04800
       BCD  ATTEMPT TO SPECIFY A SUBSCRIPT RANGE WITHOUT USE OF PARENTHEF1C04810
       BCD 1SIS.                                                        F1C04820
       REM                                                              F1C04830
       PZE ER0046,,-1                                                   F1C04840
       BCD 6MISSING ) IN CONTROL FOR LIST DO.                           F1C04850
       REM                                                              F1C04860
       PZE ER0047,,-1                                                   F1C04870
       BCD 6ILLEGAL CONTROL CHAR IN LIST DO.                            F1C04880
       REM                                                              F1C04890
       PZE ER0048,,-1                                                   F1C04900
       BCD 5TOO MANY ) IN LIST CONTROL.                                 F1C04910
       REM                                                              F1C04920
       PZE ER0049,,-1                                                   F1C04930
       BCD 7ILLEGAL USE OF CONSTANT IN LIST.                            F1C04940
       REM                                                              F1C04950
       PZE ER0050,,-1                                                   F1C04960
       BCD 5TOO MANY ( IN LIST CONTROL.                                 F1C04970
       REM                                                              F1C04980
       PZE ER0051,,-1                                                   F1C04990
       BCD 6ILLEGAL CHARACTER IN THIS STATEMENT.                        F1C05000
       REM                                                              F1C05010
       PZE ER0053,,-1                                                   F1C05020
       BCD 7NO DIMENSION ENTRY FOR VARIABLE FORMAT.                     F1C05030
       REM                                                              F1C05040
       PZE ER0054,,-1                                                   F1C05050
       BCD 3NO FORMAT NUMBER.                                           F1C05060
       REM                                                              F1C05070
       PZE ER0055,,-1                                                   F1C05080
       BCD 7ILLEGAL USE OF FLOATING POINT VARIABLE.                     F1C05090
       REM STATE B.                                                     F1C05100
       REM                                                              F1C05110
       PZE ER0056,,-1                                                   F1C05120
       BCD 5TOO MANY CHARACTERS IN SYMBOL.                              F1C05130
       REM                                                              F1C05140
       PZE ER0072,,-1                                                   F1C05150
       BCD  SUBSCRIPTED VARIABLE ON LEFT OF = NOT DEFINED IN DIMENSION SF1C05160
       BCD 2TATEMENT.                                                   F1C05170
       PZE ER0057,,-1                                                   F1C05180
       BCD 5MULTIPLE FUNCTION DEFINITION.                               F1C05190
       REM                                                              F1C05200
       PZE ER0058,,-1                                                   F1C05210
       BCD 8MORE THAN 50 FUNCTION DEFINITIONS IN PROGRAM.               F1C05220
       REM                                                              F1C05230
       PZE ER0059,,-1                                                   F1C05240
       BCD 7ILLEGAL FORTRAN FUNCTION ARGUMENT NAME.                     F1C05250
       REM                                                              F1C05260
       PZE ER0060,,-1                                                   F1C05270
       BCD 4ARGREG SIZE EXCEEDED.                                       F1C05280
       REM                                                              F1C05290
       PZE ER0061,,-1                                                   F1C05300
       BCD 9FLOATING POINT CONSTANT IN HOLLERITH SPECIFICATION.         F1C05310
       REM                                                              F1C05320
       PZE     ER0062,,-1                                              $F1C05330
       BCD 9PARENTHESES DO NOT BALANCE WITHIN A LEVEL.                 $F1C05340
       REM                                                              F1C05350
       PZE ER0063,,-1                                                   F1C05360
       BCD 4ILLEGAL USE OF = SIGN.                                      F1C05370
       REM                                                              F1C05380
       PZE ER0064,,-1                                                   F1C05390
       BCD 5ILLEGAL USE OF . CHARACTER.                                 F1C05400
       REM                                                              F1C05410
       PZE ER0065,,-1                                                   F1C05420
       BCD  THE NUMERIC CONTROL OF A HOLLERITH TEXT IS LARGER THAN THE NF1C05430
       BCD 6UMBER OF CHARACTERS FOLLOWING THE H.                        F1C05440
       REM                                                              F1C05450
       PZE ER0066,,-1                                                   F1C05460
       BCD 5LAMDA TABLE SIZE EXCEEDED.                                  F1C05470
       REM                                                              F1C05480
       PZE ER0067,,-1                                                   F1C05490
       BCD 5BETA TABLE SIZE EXCEEDED.                                   F1C05500
       REM                                                              F1C05510
       PZE ER0068,,-1                                                   F1C05520
       BCD 9ALPHA TABLE SIZE EXCEEDED OR EXCESS RIGHT PARENTHESIS.      F1C05530
       REM                                                              F1C05540
       PZE ER0069,,-1                                                   F1C05550
       BCD  FLOATING POINT CONSTANT OUTSIDE FLOATING POINT RANGE OF MACHF1C05560
       BCD 1INE.                                                        F1C05570
       REM                                                              F1C05580
       PZE ER0070,,-1                                                   F1C05590
       BCD 3MIXED EXPRESSION.                                           F1C05600
       REM                                                              F1C05610
       PZE ER0071,,-1                                                   F1C05620
       BCD 6SUBSCRIPTED VARIABLE IN FUNCTION.                           F1C05630
       REM                                                              F1C05640
       REM                                                              F1C05650
       PZE     ER1002,,-1                                               F1C05660
       BCD 7FORMAT STATEMENT IS INCORRECTLY WRITTEN.                    F1C05670
       REM                                                              F1C05680
       PZE     ER1003,,-1                                               F1C05690
       BCD 6NON-NUMERICS FOUND IN NUMERIC FIELD.                        F1C05700
       REM                                                              F1C05710
       PZE ER1005,,-1                                                   F1C05720
       BCD 6DECIMAL NUMBER IN AN OCTAL FIELD.                           F1C05730
       REM                                                              F1C05740
       REM                                                              F1C05750
       PZE ER1007,,-1                                                   F1C05760
       BCI     7,STATEMENT HAS TOO MANY CONTINUATION CARDS.             F1C05770
       REM                                                              F1C05780
       PZE ER1008,,-1                                                   F1C05790
       BCD 5END CARD OUT OF SEQUENCE.                                   F1C05800
       REM                                                              F1C05810
       PZE BER001,,-1                                                   F1C05820
       BCD  IMPROPER BOOLEAN STATEMENT.                                 F1C05830
       REM                                                              F1C05840
       PZE DCER,,-1                                                     F1C05850
       BCD  DOUBLE PRECISION CONSTANT LIES OUTSIDE OF RANGE 10**-38     F1C05860
       BCD 2TO 10**+38                                                  F1C05870
       REM                                                              F1C05880
       PZE ICM6,,-1                                                     F1C05890
       BCD 7INCORRECT FORMAT FOR COMPLEX NUMBER                        $F1C05900
       REM                                                              F1C05910
       PZE ICER,,-1                                                     F1C05920
       BCD  COMPLEX CONSTANT LIES OUTSIDE OF RANGE 10**-38 TO 10**+38   F1C05930
       REM                                                              F1C05940
       PZE ER0073,,-1                                                   F1C05950
       BCD  EXPRESSION OR ILLEGAL PUNCTUATION ON LEFT OF EQUAL SIGN.    F1C05960
       REM                                                              F1C05970
       PZE OCTERR,,-1                                                   F1C05980
       BCD 7MORE THAN TWELVE DIGITS IN OCTAL FIELD.                     F1C05990
       REM                                                              F1C06000
       PZE     12,,-1                                                   F1C06010
       BCD  LIST OF DP - CA ARRAYS EXCEEDED.                            F1C06020
       REM                                                              F1C06030
       REM                                                              F1C06040
       PZE     13,,-1                                                   F1C06050
       BCD  LIST OF DP - CA NON-SUBSCRIPTED VARIABLES EXCEEDED.         F1C06060
       REM                                                              F1C06070
       PZE     ERDP02,,-1                                               F1C06080
       BCD  FIXED POINT NAMED FUNCTION IN A DP - CA STATEMENT.          F1C06090
       REM                                                              F1C06100
       PZE     ERDP01,,-1                                               F1C06110
       BCD  SUBSCRIPTED VARIABLE IN DP - CA STATEMENT NOT DEFINED IN DP F1C06120
       BCD  - CA DIMENSION STATEMENT.                                   F1C06130
       REM                                                              F1C06140
       PZE     ES136D,,-1                                               F1C06150
       BCD 7FIXED POINT FUNCTION DEFINITION ILLEGAL                     F1C06160
       REM                                                              F1C06170
       PZE     ERDP03,,-1                                               F1C06180
       BCD 8NAME OF DP-CA FUNCTION EXCEEDS 5 CHARACTERS                 F1C06190
       REM                                                              F1C06200
       PZE     ER2001,,-1                                               F1C06210
       BCI     9,VARIABLE PARAMETER DOES NOT HAVE FIXED POINT NAME.     F1C06220
       REM                                                              F1C06230
       PZE     ER1009,,-1                                               F1C06240
       BCD 4NO STATEMENT NUMBER.                                        F1C06250
       REM                                                              F1C06260
       PZE     NOXEQR,,-1                                               F1C06270
       BCI     9,PROGRAM DOES NOT HAVE ANY EXECUTABLE STATEMENTS.       F1C06280
       REM                                                              F1C06290
       PZE     ER2002,,-1                                               F1C06300
       BCI     7,UNIT DESIGNATION EITHER MISSING OR ZERO.               F1C06310
       REM                                                              F1C06320
       PZE     ER0074,,-1                                               F1C06330
       BCI     5,TOO MANY LEFT PARENTHESIS.                             F1C06340
       REM                                                              F1C06350
       PZE     ER0075,,-1                                               F1C06360
       BCI     9,THE NUMERIC CONTROL OF A HOLLERITH TEXT IS LARGER THAN F1C06370
       BCI     8, THE NUMBER OF CHARACTERS FOLLOWING THE H.             F1C06380
       REM                                                              F1C06381
       PZE     ER2003,,-1                                               F1C06382
       BCI     5, PROGRAM EXPECTS EQUALS SIGN.                          F1C06383
       REM                                                              F1C06384
       REM                                                              F1C06390
       PZE     ER0080,,-1                                              $F1C06400
       BCI     4,ILLEGAL DOUBLE OPERATOR.                              $F1C06410
       REM                                                             $F1C06420
       PZE     ER0081,,-1                                              $F1C06430
       BCI     4,ILLEGAL USE OF OPERATOR                               $F1C06440
       REM                                                             $F1C06450
       PZE     ER0082,,-1                                              $F1C06460
       BCI     5,INVALID DOUBLE EXPONENTIATION.                        $F1C06470
       REM                                                             $F1C06480
       PZE     ER0031,,-1                                           (29)F1C06490
       BCI     8,SUBROUTINE NAME APPEARS IN DIMENSION STATEMENT.    (29)F1C06500
       PZE     ER0018,,-1                                           (30)F1C06510
       BCI     8,SENSE LIGHT NUMBER IN IF STATEMENT IS INVALID.     (30)F1C06520
       PZE     ,,-1          CURRENT END OF TABLE SIGNAL            (30)F1C06530
       BSS     66            SPACE FOR ADDITIONAL DIAGNOSTICS       (30)F1C06540
       REM                                                             $F1C99000
       REM                                                             $F1C99010
       REM                                                             $F1C99020
       REM                                                             $F1C99030
ENDIAG SYN     *              END OF SECTION ONE DIAGNOSTIC.           $F1C99040
       REM                                                             $F1C99050
ENDF12 PZE     ,,-1           END OF TABLE SIGNAL.                     $F1C99060
       REM                                                             $F1C99070
       TCD     -1                                                      $F1C99075
       TTL * SECTION ONE PRIME * RECORD 9F16 *                          F1D00000
       REM                                                              F1D00010
       REM     SECTION ONE PRIME CONSOLIDATES CORE AND TAPE BUFFERS     F1D00020
       REM     LEFT BY SECTION ONE INTO COMPLETE TABLES.                F1D00030
       REM                                                              F1D00040
       REM *************************************************************F1D00050
       REM                                                              F1D00060
       EJECT                                                            F1D00070
       REM                                                              F1D00080
       REM DEFINITIONS OF SECTION 1 PRIME TABLE ASSEMBLY BUFFERS.       F1D00090
       REM                                                              F1D00100
       REM                                                              F1D00110
CCCC   SYN     FRETMX                                                   F1D00120
BBBB   SYN     2*TAU1MX+4*TAU2MX+6*TAU3MX+NONXMX+STOPMX+2               F1D00130
AAAA   SYN     5*DOLPMX+2*TIFGMX+TRADMX+FXCNMX+4+2                      F1D00140
       REM                                                              F1D00150
LWBF1O ORG     TABORG-1-2*EQITMX-1                                      F1D00160
       BSS     1                                                        F1D00170
LWBF1  SYN     *              ASSEMBLY BUFFER ONE.                      F1D00180
       REM                                                              F1D00190
LWBF2O ORG     TABORG-1                                                 F1D00200
       BSS     1                                                        F1D00210
LWBF2  SYN     *              ASSEMBLY BUFFER TWO.                      F1D00220
       REM                                                              F1D00230
       ORG     TOPTAB-AAAA-BBBB-CCCC                                    F1D00240
       BSS     1                                                        F1D00250
LWBF3  SYN     *              ASSEMBLY BUFFER THREE.                    F1D00260
       REM                                                              F1D00270
       REM                                                              F1D00280
       ORG     GERASE-1                                                 F1D00290
       BSS     1                                                        F1D00300
UPBF1  SYN     *              ASSEMBLY BUFFER FOUR.                     F1D00310
       EJECT                                                            F1D00320
       REM                    ASSEMBLY BUFFER ASSIGNMENTS.              F1D00330
       REM                                                              F1D00340
FORVAL SYN     LWBF2                                                    F1D00350
FORMAT SYN     UPBF1                                                    F1D00360
FMTEFN SYN     LWBF1                                                    F1D00370
ENDTAB SYN     LWBF1                                                    F1D00380
SUBDEF SYN     SBDFBF                                                   F1D00390
COMMON SYN     UPBF1                                                    F1D00400
HOLARG SYN     LWBF1                                                    F1D00410
TEIFNO SYN     LWBF2                                                    F1D00420
FORVAR SYN     LWBF1                                                    F1D00430
FORTAG SYN     LWBF2                                                    F1D00440
EQUITT SYN     LWBF1                                                    F1D00450
CALLFN SYN     LWBF1                                                    F1D00460
CLOSUB SYN     LWBF1                                                    F1D00470
       REM                                                              F1D00480
       REM     THE FOLLOWING ARE LEFT IN MEMORY FOR                     F1D00490
       REM     SECTION ONE DOUBLE PRIME AND SECTION TWO.                F1D00500
       REM                                                              F1D00510
       REM                                                              F1D00520
       ORG     LWBF3-1                                                  F1D00530
STOPWC BSS     1                                                        F1D00540
TSTOPS BSS     STOPMX                                                   F1D00550
NONXWC BSS     1                                                        F1D00560
NONEXC BSS     NONXMX                                                   F1D00570
FRETWC BSS     1                                                        F1D00580
FRETTB BSS     FRETMX                                                   F1D00590
TAU1TB BSS     TAU1MX*2                                                 F1D00600
TAU2TB BSS     TAU2MX*4                                                 F1D00610
TAU3TB BSS     TAU3MX*6                                                 F1D00620
FIXCWC BSS     1                                                        F1D00630
FIXCON BSS     FXCNMX                                                   F1D00640
       BSS     2              COMPENSTAING RESERVATION.                 F1D00650
TRADWC BSS     1                                                        F1D00660
TRADTB BSS     TRADMX                                                   F1D00670
TFGOWC BSS     1                                                        F1D00680
TIFGOT BSS     TIFGMX*2                                                 F1D00690
TDOWC  BSS     1                                                        F1D00700
TDOTAB BSS     DOLPMX*5                                                 F1D00710
TIPTOP SYN     *              TOP OF TABLE MERGING AREA FOR 1 PRIME.    F1D00720
       EJECT                                                            F1D00730
       REM                                                              F1D00740
       REM *************************************************************F1D00750
       REM                                                              F1D00760
       REM                                                              F1D00770
       LBL     9F16,THE WORKS                                           F1D00780
       REM                                                              F1D00790
       ORG     SYSCUR                                                  $F1D00800
       BCI     1,9F1600                                                $F1D00810
       ORG     (LODR)                                                  $F1D00820
       TXI     BEGF13,,160             ENTRY POINT,,RECORD NUMBER       F1D00830
       REM                                                              F1D00840
       REM     *********************************************************F1D00850
       REM                                                              F1D00860
       ABS                                                              F1D00870
ORGF13 ORG     PASS1                                                    F1D00880
       REM                                                              F1D00890
       REM     SECTION 1 PRIME DIAGNOSTIC CALLS.                        F1D00900
       REM                                                              F1D00910
1PER1  TXI     (DIAG),,-1    *PROGRAMMER ERROR.  THERE ARE NOT ANY      F1D00920
       REM                    EXECUTABLE STATEMENTS IN THE SOURCE       F1D00930
       REM                    PROGRAM.                                  F1D00940
       REM                                                              F1D00950
1PER2  TXI     (DIAG),,0     *MACHINE ERROR.  THE NAME OF A DP-CA ARRAY F1D00960
       REM                    CANNOT BE FOUND IN THE SIZ TABLE.         F1D00970
       REM                    SIMULTANEOUS ENTRIES OF THE NAME ARE      F1D00980
       REM                    MADE IN DLSIT1 AND THE APPROPRIATE DIM    F1D00990
       REM                    TABLE IN PASS1 OF SECTION I WHEN          F1D01000
       REM                    PROCESSING DIMENSION STATEMENTS.          F1D01010
       REM                                                              F1D01020
1PER3  TXI     (DIAG),,-2    *PROGRAMMER ERROR.  NONE OF THE SOURCE     F1D01030
       REM                    PROGRAM STATEMENTS HAVE BEEN ASSIGNED     F1D01040
       REM                    STATEMENT NUMBERS (EFNS).  AT LEAST ONE   F1D01050
       REM                    EFN IS REQUIRED DUE TO THE EXISTENCE OF A F1D01060
       REM                    DO, IF, GO TO, OR FREQUENCY STATEMENT.    F1D01070
       REM                                                              F1D01080
1PER4  TXI     (DIAG),,0     *MACHINE ERROR.  THE TIFGO TABLE HAS A     F1D01090
       REM                    ONE WORD ENTRY AS THE LAST ONE IN THE     F1D01100
       REM                    TABLE.  TIFGO IS A TWO WORD ENTRY.        F1D01110
       REM                                                              F1D01120
1PER5  TXI     (DIAG),,0     *MACHINE ERROR.  FREQUENCY TABLE HAS BEEN  F1D01130
       REM                    EXHAUSTED IN THE MIDDLE OF AN ENTRY.      F1D01140
       REM                                                              F1D01150
1PER6  TXI     (DIAG),,-3    *PROGRAMMER ERROR.  A FREQUENCY STATEMENT  F1D01160
       REM                    DOES NOT CONTAIN ANY FREQUENCIES.         F1D01170
       REM               NOTE-THERE IS A POSSIBILITY OF MACHINE ERROR.  F1D01180
       REM                                                              F1D01190
1PER7  TXI     (DIAG),,-4    *PROGRAMMER ERROR.  A TABLE HAS OVERFLOWED.F1D01200
TABNM  BCI     1,             THE NAME OF THE TABLE APPEARS IN THE      F1D01210
       REM                    LOCATION - TABNM.                         F1D01220
       REM                                                              F1D01230
1PER8  TXI     (DIAG),,-5    *PROGRAMMER ERROR.  MORE THAN ONE          F1D01240
STATN  PZE     **             FREQUENCY STATEMENT HAS BEEN MADE         F1D01250
       REM                    FOR THE STATEMENT NUMBER IN STATN.        F1D01260
       REM                                                              F1D01270
1PER9  TXI     (DIAG),,       NOT PRESENTLY USED.                       F1D01280
       REM                                                              F1D01290
       REM *************************************************************F1D01300
       REM                                                              F1D01310
       REM     TAP - TABLE ASSEMBLY PROGRAM.  ASSEMBLES TABLES FROM     F1D01320
       REM           TAPE RECORDS AND CORE BUFFERS.                     F1D01330
       REM                                                              F1D01340
TAP00  SXA     TAPJ0,1        SAVE CONTENTS OF INDEX REGISTERS.         F1D01350
       SXA     TAPJ1,2                                                  F1D01360
       SXA     TAPJ2,4                                                  F1D01370
       LDQ     1,1            GET THE IDENTIFICATION NUMBER OF THE      F1D01380
       STQ     TABLN          TABLE TO BE ASSEMBLED AND SAVE.           F1D01390
       MPY     (6)L           COMPUTE INTET INDEX VALUE.                F1D01400
       XCA                    MOVE TO AC.                               F1D01410
       PAC     ,1             LOAD INTET REFERENCE.                     F1D01420
       CAL     INTETX+3,1     GET TABLE ORIGIN AND MAXIMUM LENGTH.      F1D01430
       STA     TAPIO+1        SET ASSEMBLY ORIGIN IN I/O COMMAND.       F1D01440
       STD     TAPAA          SET TABLE OVERFLOW TEST.              (34)F1D01450
       CAL     INTETX,1       GET CORE BUFFER WORD COUNT            (34)F1D01460
       PDX     ,2             AND SAVE IT                           (34)F1D01465
       SXA     TAPF0,2        FOR LATER USE WHEN MERGING.           (34)F1D01470
       PXD     ,2           SAVE DECREMENT ONLY (WORD COUNT)        (35)F1D01475
       ADD     INTETX+4,1    ADD TAPE RECORD AND WORD COUNT         (35)F1D01480
       PDX     ,4            GET ASSEMBLED TABLE WORD COUNT.        (35)F1D01485
TAPAA  TXL     TAPG0,4,**   *WILL TABLE OVERFLOW,NO.                (35)F1D01490
       CAL     INTETX+5,1    YES,GET THE TABLE NAME AND             (35)F1D01495
       SLW     TABNM         SAVE IT FOR THE GENERAL DIAGNOSTIC.    (35)F1D01496
       TSX     1PER7,4      *GO TO DIAGNOSTIC.                      (35)F1D01497
TAPG0  PAX     ,2            GET COUNT OF RECORDS ON TAPE.          (35)F1D01500
       PXD     ,4            PUT ASSEMBLED TABLE WORD COUNT ALONE   (35)F1D01505
       STO     INTETX+4,1    BACK INTO CONTROL BLOCK AND AT THE     (35)F1D01510
       AXT     1,4           TABLE ORIGON MINUS ONE FOR             (35)F1D01512
       STO*    INTETX+3,1    SECTION TWOS USE,IF ANY.               (35)F1D01514
       TXL     TAPF0,2,0    *NOTHING ON TAPE                        (35)F1D01516
       SXD     TAPD0,2       SET COUNT OF RECORDS TO READ.          (35)F1D01518
       CAL     INTETX+2,1     GET RECORD LENGTH AND TAPE ADDRESS.       F1D01520
       STD     TAPC0          SET TAPE ADDRESS IN CALLING SEQUENCES.    F1D01530
       STD     TAPE0                                                    F1D01540
       PAX     ,4             LOAD RECORD LENGTH.                       F1D01550
       SXD     TAPIO+1,4      SET IN I/O COMMAND.                       F1D01560
       AXT     1,2            INITIALIZE RECORD NUMBER.                 F1D01570
TAPA0  SXD     TABLN,2        SET RECORD NUMBER IN TABLE IDENTIFICATION.F1D01580
TAPB0  TSX     (TAPE),4       READ A RECORD FROM TAPE.                  F1D01590
       PZE     TAPIO,,(RBNC)                                            F1D01600
TAPC0  MZE     INTETX+5,1,**                                            F1D01610
       CAL     RECID          GET LABEL READ.                           F1D01620
       ERA     TABLN          IS THIS THE RECORD BEING SEARCHED FOR.    F1D01630
       TNZ     TAPB0         *NO, TRY AGAIN.                            F1D01640
       LDC     TAPC0,4        YES, LOAD 2S COMPLIMENT OF LIGICAL TAPE   F1D01650
       CAL     (SCHU),4       NUMBER AND GET THE CONTENTS OF THE SCHX.  F1D01660
       STA     TAPIO+1        SET NEW LOAD ADDRESS FOR BUILDING TABLE.  F1D01670
       TXI     *+1,2,1        INCREMENT RECORD COUNT.                   F1D01680
TAPD0  TXL     TAPA0,2,**    *HAVE RECORDS BEEN FOUND, NO CONTINUE.     F1D01690
       TSX     (TAPE),4       YES, REWIND DUMP TAPE.                    F1D01700
       PZE     REWND,,(SKBP)                                            F1D01710
TAPE0  PZE     ,,**                                                     F1D01720
       REM                                                              F1D01730
       REM                    ALL TAPE BUFFERS HAVE BEEN MERGED INTO    F1D01740
       REM                    CONSECUTINE LOCATIONS.  NOW PICK UP ANY   F1D01750
       REM                    TABLE ENTRIES IN THE CORE BUFFER AND      F1D01760
       REM                    MERGE THEN AT THE END.                    F1D01770
       REM                                                              F1D01780
TAPF0  AXT     **,2          GET COUNT OF WORDS LEFT IN CORE BUFFER (35)F1D01900
       TXL     TAPJ0,2,0     *ANYTHING IN THE CORE BUFFER, NO.          F1D01910
       PXA     ,2             YES, COMPUTE LAST ADDRESS PLUS ONE        F1D01920
       ADD     INTETX,1       OF CORE BUFFER.                           F1D01930
       STA     TAPI0          INITIALIZE MOVING LOOP.                   F1D01940
       PXA     ,2             COMPUTE LAST ADDRESS PLUS ONE OF          F1D01950
       ADD     TAPIO+1        TABLE IN ASSEMBLY AREA.                   F1D01960
       STA     TAPI1          INITIALIZE MOVEING LOOP                   F1D01970
TAPI0  CAL     **,2           GET A WORD FROM THE CORE BUFFER.          F1D01980
TAPI1  SLW     **,2           STORE IT IN THE TABLE.                    F1D01990
       TIX     TAPI0,2,1     *ALL CORE ENTRIES MOVED, NO CONTINUE.      F1D02000
       REM                                                              F1D02010
       REM                    THE TABLE (IF ANY) HAS BEEN ASSEMBLED.    F1D02020
       REM                                                              F1D02030
TAPJ0  AXT     **,1           RESTORE THE CONTENTS OF THE               F1D02040
TAPJ1  AXT     **,2           INDEX REGISTERS.                          F1D02050
TAPJ2  AXT     **,4                                                     F1D02060
       TRA     2,1           *RETURN TO CALLER.                         F1D02070
       REM                                                              F1D02080
       REM                                                              F1D02090
       REM               CONSTANTS, ERASABLE AND I/O COMMANDS.          F1D02100
       REM                                                              F1D02110
(6)L   DEC     6              CONSTANT FOR COMPUTING INTET INDEX.       F1D02120
       AXT     0,0            ( NOT USED )                          (34)F1D02130
RECID  PZE     **,,**         RECORD LABEL READ FROM TAPE.              F1D02140
TABLN  PZE     **,,**         RECORD LABEL BEING SEARCHED FOR.          F1D02150
       REM                                                              F1D02160
REWND  PZE     ,,-1           I/O COMMAND TO REWIND THE DUMP TAPE.      F1D02170
BSR    MZE     1,,0           BACKSPACE COUNT.                          F1D02180
       REM                                                              F1D02190
TAPIO  IOCP    RECID,,1       I/O COMMAND TO READ RECORD LABEL.         F1D02200
       IORT    **,,**         I/O COMMAND TO READ TAPE BUFFER.          F1D02210
       REM                                                              F1D02220
       REM                    END OF TAP ROUTINE.                       F1D02230
       REM                                                              F1D02240
       REM *************************************************************F1D02250
       REM                                                              F1D02260
       REM                                                              F1D02270
       REM     WAT - WRITE ASSEMBLED TABLE PROGRAM.                     F1D02280
       REM           WRITE AN ASSEMBLED TABLE ON THE TABLE TAPE         F1D02290
       REM           PRECEDED BY ITS IDENTIFICATION AND WORD COUNT.     F1D02300
       REM                                                              F1D02310
WAT00  SXA     WAT01,1        SAVE CONTENTS OF INDEX REGISTERS.         F1D02320
       SXA     WAT02,4                                                  F1D02330
       SXA     WAT03,2                                                  F1D02340
       AXC     2,2            LOAD FLIP-FLOP SWITCH.                    F1D02350
       SXA     *-1,2          RESET IT FOR NEXT TIME THROUGH.           F1D02360
       LDQ     1,1            GET TABLE IDENTIFICATION NUMBER.          F1D02370
       STQ     WATA0,2        SAVE TABLE IDENTIFICATION NUMBER.         F1D02380
       MPY     (6)L           COMPUTE INTETX INDEX.                     F1D02390
       XCA                    MOVE TO AC.                               F1D02400
       PAC     ,1             LOAD INTETX INDEX.                        F1D02410
       CAL     INTETX+3,1     GET ORIGIN OF TABLE TO BE WRITTEN.        F1D02420
       STA     WATB2,2        SET TABLE ORIGIN IN I/O COMMAND.          F1D02430
       CAL     INTETX+4,1     GET TABLE WORD COUNT.                     F1D02440
       STD     WATA1,2        SAVE TABLE WORD COUNT FOR WRITING ON TAPE.F1D02450
       STD     WATB2,2        SET IN I/O COMMAND FOR WRITING TABLE.     F1D02460
       TSX     (TAPE),4       WRITE TABLE.                              F1D02470
       PZE     WATB0,2,(WBNP)                                           F1D02480
       PZE     INTETX+5,1,TABTAP                                        F1D02490
WAT01  AXT     **,1           RESTORE INDEX REGISTERS.                  F1D02500
WAT02  AXT     **,4                                                     F1D02510
WAT03  AXT     **,2                                                     F1D02520
       TRA     2,1           *RETURN TO CALLER.                         F1D02530
       REM                                                              F1D02540
       REM                                                              F1D02550
       REM               CONSTANTS, ERASABLE AND I/O COMMANDS.          F1D02560
       REM                                                              F1D02570
       PZE     **,,0          FLIP TABLE IDENTIFICATION.                F1D02580
       PZE     ,,**           FLIP TABLE WORD COUNT.                    F1D02590
       REM                                                              F1D02600
WATA0  IOCP    *-2,,2         FLIP ID AND WORD COUNT I/O COMMAND.       F1D02610
WATA1  IOCT    **,,**        FLIP TABLE I/O COMMAND.                   $F1D02620
       REM                                                              F1D02630
WATB0  PZE     **,,0          FLOP TABLE IDENTIFICATION.                F1D02640
WATB2  PZE     ,,**           FLOP TABLE WORD COUNT.                    F1D02650
       REM                                                              F1D02660
       IOCP    *-2,,2         FLOP ID AND WORD COUNT I/O COMMAND.       F1D02670
       IOCT    **,,**        FLOP TABLE I/O COMMAND.                   $F1D02680
       REM                                                              F1D02690
       REM                    END OF WAT ROUTINE.                       F1D02700
       REM                                                              F1D02710
       REM *************************************************************F1D02720
       EJECT                                                            F1D02730
       REM                                                              F1D02740
BEGF13 AXT     4,4            SET ERROR FLAG FOR MONITOR ERROR RECORDS. F1D02750
       SXA     (MSLN),4                                                 F1D02760
       SLF                    TURN OFF SENSE LITES.                     F1D02770
       DCT                    TURN OFF DIVIDE CHECK                     F1D02780
       NOP                    AND                                       F1D02790
       TQO     *+1            MQ OVERFLOW TRIGGERS.                     F1D02800
       REM                                                              F1D02810
       REM                                                              F1D02820
       REM     ROUTINE TO WRITE FORSUB AS RECORD AS RECORD 1 OF FILE 3. F1D02830
       REM                                                              F1D02840
       TSX     (TAPE),4       WRITE END-OF-FILE AFTER COMPAIL RECORDS.  F1D02850
       PZE     ,,(WEFP)                                                 F1D02860
       PZE     2NDEOF,,CITTAP FIRST FILE IS THE SOURCE PROGRAM.         F1D02870
       REM                                                              F1D02880
       NZT     CITCNT         WERE ANY CITS COMPILED.                   F1D02890
       TSX     1PER1,4        NO, SOURCE PROGRAM IS NOT EXECUTABLE.     F1D02900
       SXD     CITCNT,0       SET CIT WORD COUNT TO ZERO, SAVE RECORD CTF1D02910
       LDC     BK,4           GET TRUE VALUE OF FORSUB WORD COUNT.      F1D02920
       SXD     IOCM2,4        SET IN I/O COMMAND.                       F1D02930
       TSX     (TAPE),4       WRITE CIT RECORD COUNT AND FORSUB TABLE,  F1D02940
       PZE     IOCM1,,(WBNP)  (IF ANY).                                 F1D02950
       PZE     LABL1,,TABTAP                                            F1D02960
       REM                                                              F1D02970
       TSX     (TAPE),4       WRITE AN END-OF-FILE AFTER LAST RECORD.   F1D02980
       PZE     ,,(WEFP)                                                 F1D02990
       PZE     3RDEOF,,TABTAP                                           F1D03000
       REM                                                              F1D03010
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D03020
       REM                                                              F1D03030
       REM     ROUTINE TO WRITE FLOCON AS RECORD 1 OF FILE 4.           F1D03040
       REM                                                              F1D03050
       LXD     FLCNIX-2,4     GET FLOCON WORD COUNT.                    F1D03060
       SXA     FLOCNT,4       SAVE IN ZERO WORD.                        F1D03070
       SXD     FLOCOM+1,4     SET IN I/O COMMAND.                       F1D03080
       CLA     FLCNIX-1       GET ADDRESS OF FLOCON TABLE               F1D03090
       STA     FLOCOM+1       AND SET IN I/O COMMAND.                   F1D03100
       TSX     (TAPE),4       WRITE FLOCON WORD COUNT AND FLOCON        F1D03110
       PZE     FLOCOM,,(WBNP) TABLE (IF ANY).                           F1D03120
       PZE     LABL2,,TABTAP                                            F1D03130
       REM                                                              F1D03140
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D03150
       REM                                                              F1D03160
       TSX     TAP00,1        ASSEMBLE TABLE OF FORMAT STATEMENTS.      F1D03170
       PZE     10                                                       F1D03180
       REM                                                              F1D03190
       TSX     WAT00,1        WRITE FORMAT TABLE AS RECORD 2 OF FILE 4. F1D03200
       PZE     10                                                       F1D03210
       REM                                                              F1D03220
       REM                                                              F1D03230
       REM     ROUTINE TO CHECK FOR MISSING FORMAT STATEMENTS.          F1D03240
       REM                                                              F1D03250
       LAC     INTETR,2       LOAD 2S COMPLEMENT OF FMTEFN TABLE ORIGIN.F1D03260
       TXI     *+1,2,-1       ALLOW FOR WORD COUNT FROM TAP00.          F1D03270
       SXD     FRCKE,2        SET ORIGIN IN WORD COUNT COMPUTATION.     F1D03280
       LAC     INTETK,1       LOAD 2S COMPLEMENT OF FORMAT TABLE ORIGIN.F1D03290
       LDC     INTETK+1,4     LOAD 2S COMPLEMENT OF WORD COUNT.         F1D03300
       TXL     FRCKF,4,0     *SKIP SCAN FOR FORMULA NUMBERS IF NO TABLE.F1D03310
       SXD     *+1,4          SET 2S COMPLEMENT OF                      F1D03320
       TXI     *+1,1,**       LAST ADDRESS OF TABLE                     F1D03330
       SXD     FRCKB,1        TO STOP SEARCH.                           F1D03340
       SXD     FRCKC,1                                                  F1D03350
       LAC     INTETK,1       RESTORE IR1.                              F1D03360
       CLS     FRCON          GET END OF ENTRY (STATEMENT) FLAG.        F1D03370
       TRA     FRCKC+1        MOVE FIRST WORD OF TABLE.                 F1D03380
FRCKA  CAS     0,1            IS THIS AN END OF ENTRY MARKER.           F1D03390
       TXI     *+3,1,-1       NO, LOOK AT NEXT WORD.                    F1D03400
       TXI     FRCKC,1,-1                                               F1D03410
       TXI     *+1,1,-1       NO, LOOK AT NEXT WORD.                    F1D03420
FRCKB  TXH     FRCKA,1,**     IS THIS THE END OF THE FORMAT TABLE.      F1D03430
       TRA     FRCKD         *YES.                                      F1D03440
       REM                                                              F1D03450
FRCKC  TXL     FRCKD,1,**    *IS THIS THE END OF THE FORMAT TABLE, YES. F1D03460
       LDQ     0,1            SAVE FORMULA NUMBER OF FORMAT STATEMENT   F1D03470
       STQ     0,2            IN CONDENSED TABLE.                       F1D03480
       TXI     FRCKA,2,-1     INCREMENT CONDENSED INDEX, CONTINUE SCAN. F1D03490
       REM                                                              F1D03500
FRCKD  PXA     ,2             GET TRUE VALUE OF LAST ADDRESS PLUS ONE   F1D03510
       PAC     ,2             OF CONDENSED FORMAT TABLE (ONLY FORMULA   F1D03520
       SXA     FRCKH,2        NUMBERS) AND SET IN COMPARE LOOP.         F1D03530
       SXA     FRCKL,2        SET IN MASKING LOOP.                      F1D03540
       TXI     *+1,2,1        ALLOW FOR WORD COUNT FROM TAP00.          F1D03550
       SXA     INTETR,2       SET NEW ORIGIN FOR FMTEFN TABLE.          F1D03560
FRCKE  TXI     *+1,2,**       COMPUTE WORD COUNT OF TABLE.              F1D03570
       SXA     FRCKG,2        SAVE WORD COUNT.                          F1D03580
       CAL     ADMSK          LOAD AC WITH ADDRESS MASK.                F1D03590
FRCKL  ANS     **,2           CLEAR HASH FROM CONDENSED FORMAT TABLE.   F1D03600
       TIX     *-1,2,1                                                  F1D03610
       REM                                                              F1D03620
FRCKF  TSX     TAP00,1        ASSEMBLE FMTEFN TABLE, TABLE OF FORMAT    F1D03630
       PZE     17             REFERENCES.                               F1D03640
       REM                                                              F1D03650
       STZ     ELSEBF         INITIALIZE ERROR CELL TO ZERO.            F1D03660
       LXD     INTETR+1,4     LOAD WORD COUNT OF FMTEFN TABLE.          F1D03670
       TXL     FRCKK+1,4,0   *NO REFERENCES TO FORMAT STATEMENTS.       F1D03680
       PXA     ,4             PLACE WORD COUNT IN AC.                   F1D03690
       PAX     ,1             LOAD FMTEFN WORD COUNT.                   F1D03700
       ADD     INTETR         COMPUTE LAST ADDRESS PLUS ONE OF FMTEFN.  F1D03710
       STA     FRCKG+1        SET ADDRESS FOR TIX LOOP.                 F1D03720
       STA     *+2            SET IN MASKING LOOP.                      F1D03730
       CAL     ADMSK          LOAD ADDRESS MASK.                        F1D03740
       ANS     **,1           CLEAR HASH FROM FMTEFN TABLE.             F1D03750
       TIX     *-1,1,1                                                  F1D03760
       AXT     0,1            INITIALIZE ERROR COUNTER.                 F1D03770
FRCKG  AXT     **,2           LOAD FORMAT WORD COUNT.                   F1D03780
       CAL     **,4           GET A REFERENCE TO A FORMAT STATEMENT.    F1D03790
FRCKH  LAS     **,2           DOES THIS FORMAT STATEMENT EXIST.         F1D03800
       TRA     *+2            NO.                                       F1D03810
       TRA     FRCKJ          YES, GET NEXT REFERENCE OR QUIT.          F1D03820
       TIX     FRCKH,2,1     *NO, CONTINUE SEARCH.                      F1D03830
       STZ     ELSEBF-1,1     SAVE EXTERNAL FORMULA NUMBER IN ERROR     F1D03840
       STA     ELSEBF-1,1     LIST FOR 1 DOUBLE PRIME.                  F1D03850
       TXI     *+1,1,1        INCREMENT ERROR LIST INDEX.               F1D03860
       REM                                                              F1D03870
FRCKJ  TIX     FRCKG,4,1     *CONTINUE, OR QUIT IF AT END OF REFERENCE  F1D03880
       REM                                                              F1D03890
       TXL     FRCKK,1,0     *NO ERRORS.                                F1D03900
       PXA     ,1             SOME ERROR, PLACE COUNT IN AC.            F1D03910
       ORA     FRTSG          ADD THE MISSING FORMAT STATEMENT FLAG.    F1D03920
       SLW     ELSEBF         STORE AT TOP OF ERROR LIST.               F1D03930
       TXI     *+1,1,1        ADD FLAG TO COUNT OF WORDS IN ERROR LIST. F1D03940
FRCKK  SXD     GOOFCT,1       SAVE ERROR LIST WORD COUNT.               F1D03950
       REM                                                              F1D03960
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D03970
       REM                                                              F1D03980
       REM     ROUTINE TO ELIMINATE DUPLICATE ENTRIES FROM THE CLOSUB   F1D03990
       REM     TABLE AND THE NAMES OF DUMMY FUNCTION NAMES.  DUMMY      F1D04000
       REM     NAMES APPEAR IN THE ARGUMENT LISTS OF FUNCTION AND/OR    F1D04010
       REM     SUBROUTINE STATEMENTS, THAT IS IN THE SUBDEF TABLE.      F1D04020
       REM                                                              F1D04030
       TSX     TAP00,1        ASSEMBLE SUBDEF TABLE FOR USE WITH CLOSUB.F1D04040
       PZE     11                                                       F1D04050
       REM                                                              F1D04060
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D04070
       REM                                                              F1D04080
       TSX     TAP00,1        ASSEMBLE CLOSUB TABLE.                    F1D04090
       PZE     9                                                        F1D04100
       REM                                                              F1D04110
       LXD     INTETJ+1,4     LOAD WORD COUNT OF CLOSUB TABLE.          F1D04120
       TXL     DMSZA,4,0     *CLOSUB TABLE IS EMPTY.                    F1D04130
       PXA     ,4             SOME TABLE, PLACE WORD COUNT IN AC.       F1D04140
       ADD     INTETJ         COMPUTE LAST ADDRESS PLUS ONE.            F1D04150
       STA     MCLSB          INITIALIZE ADDRESSES IN ROUTINE.          F1D04160
       STA     MCLSC                                                    F1D04170
       CLA     INTETJ         INITIALIZE ADDRESSES IN ROUTINE TO        F1D04180
       STA     MCLSD          ORIGIN OF CLOSUB TABLE.                   F1D04190
       STA     MCLSJ                                                    F1D04200
       STA     MCLSH                                                    F1D04210
       LXD     INTETL+1,1     LOAD WORD COUNT OF SUBDEF TABLE.          F1D04220
       PXA     ,1             PLACE WORD COUNT IN AC AND                F1D04230
       ADD     INTETL         COMPUTE LAST ADDRESS PLUS ONE             F1D04240
       STA     MCLSG          OF SUBDEF TABLE.                          F1D04250
       TNX     MCLSA,1,1      SKIP FIRST NAME IN SUBDEF, MAY BE THE     F1D04260
       SXA     MCLSF,1        NAME OF THE SUBPROGRAM BEING COMPILED.    F1D04270
       REM                                                              F1D04280
MCLSA  AXT     0,2            INITIALIZE SORTED CLOSUB INDEX.           F1D04290
MCLSB  CAL     **,4           GET A CLOSUB ENTRY.                       F1D04300
MCLSC  STZ     **,4           RESET VACATED CELL.                       F1D04310
MCLSD  NZT     **,2           IS THIS THE END OF THE SORTED CLOSUB TABLEF1D04320
MCLSE  TXI     MCLSF,,**     *YES, NAME IS NOT A DUPLICATE.             F1D04330
MCLSJ  LAS     **,2           NO, IS THIS NAME ALREADY IN THE SORTED    F1D04340
       TXI     MCLSD,2,-1     CLOSUB.  MAY BE, CONTINUE SCAN.           F1D04350
       TRA     MCLSI         *YES, DELETE IT.                           F1D04360
       TXI     MCLSD,2,-1     MAY BE, CONTINUE SCAN.                    F1D04370
MCLSF  AXT     **,1           LOAD WORD COUNT OF SUBDEF TABLE.          F1D04380
       TXL     MCLSH,1,0     *NO TABLE.                                 F1D04390
MCLSG  LAS     **,1           IS THIS NAME IN SUBDEF.                   F1D04400
       TRA     *+2                                                      F1D04410
       TRA     MCLSI         *YES, DO NOT ENTER IN SORTED CLOSUB.       F1D04420
       TIX     MCLSG,1,1     *COULD BE, CONTINUE SCAN.                  F1D04430
MCLSH  SLW     **,2           IS REAL, UNIQUE SUBPROGRAM NAME, ENTER    F1D04440
       SXD     MCLSE,2        IN SORTED CLOSUB AND SAVE COUNTER.        F1D04450
       REM                                                              F1D04460
MCLSI  TIX     MCLSA,4,1     *IS UNSORTED CLOSUB EXHAUSTED, NO CONTINUE.F1D04470
       REM                                                              F1D04480
       LXD     MCLSE,6        CLOSUB HAS BEEN PROCESSED, ARE THERE ANY  F1D04490
       TXH     MCLSK,2,0     *ENTRIES LEFT.  YES.                       F1D04500
       NZT*    MCLSH          A SINGLE ENTRY WILL NOT SHOW IN COUNTER.  F1D04510
       TRA     MCLSL         *NOTHING AT ALL.                           F1D04520
MCLSK  LDC     MCLSE,4        AT LEAST ONE ENTRY, LOAD TRUE COUNTER.    F1D04530
       TXI     *+1,4,1        ADD THE COUNT OF ONE THAT GOT LOST.       F1D04540
MCLSL  SXD     INTETJ+1,4     SAVE NEW WORD COUNT.                      F1D04550
       TXL     DMSZA,4,0     *SKIP REST OF ROUTINE, NO CLOSUB LEFT.     F1D04560
       SXD     CLSIO,4        SET WORD COUNT IN I/O COMMAND.            F1D04570
       CLA     INTETJ         SET ADDRESS IN I/O COMMAND.               F1D04580
       STA     CLSIO                                                    F1D04590
       PXA     ,4             COMPUTE LAST ADDRESS PLUS ONE OF SORTED   F1D04600
       ADD     INTETJ         CLOSUB TABLE FOR THE DIM TO SIZ ROUTINE   F1D04610
       STA     DMSZN          AND INITIALIZE ADDRESS.                   F1D04620
       TSX     (TAPE),4       WRITE SORTED CLOSUB TABLE ON SCRATCH TAPE.F1D04630
       PZE     CLSIO,,(WBNP)                                            F1D04640
       PZE     TCLOS,,EXEQTP                                            F1D04650
       REM                                                              F1D04660
       REM     THE CLOSUB TABLE HAS BEEN MODIFIED, AND IF ANY TABLE     F1D04670
       REM     REMAINED IT HAS BEEN WRITTEN AS THE FIRST RECORD ON      F1D04680
       REM     A SCRATCH TAPE.                                          F1D04690
       REM                                                              F1D04700
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D04710
       REM                                                              F1D04720
       REM     ROUTINE FOR CONVERTING THE DIMENSION TABLES              F1D04730
       REM     (DIM1, DIM2, DIM3, DLST1, AND DLST2) TO THE SIZ TABLE.   F1D04740
       REM                                                              F1D04750
DMSZA  LAC     ORGDM1-1,1     LOAD 2S COMPLIMENT OF NEXT ENTRY ADDRESS  F1D04760
       TXI     DMSZB,1,2      IN DIM1 AND REDUCE TO NEXT CORE ADDRESS.  F1D04770
       REM                                                              F1D04780
DMSZB  LXD     ORGDM2-1,4     LOAD COUNT OF ENTRIES IN DIM2.            F1D04790
       TXL     DMSZD,4,0     *NO ENTRIES IN DIM2 TABLE.                 F1D04800
       LAC     ORGDM2,2       LOAD 2S COMPLIMENT OF ORIGIN OF DIM2.     F1D04810
DMSZC  CAL     0,2            MOVE VARIABLE NAME FROM DIM2 BEHIND       F1D04820
       SLW     0,1            DIM1 TABLE (PACK DIM2 TABLE BEHIND DIM1). F1D04830
       CLA     1,2            GET DIMENSIONS OF THIS VARIABLE.          F1D04840
       STA     ERASA1         SAVE SECOND DIMENSION.                    F1D04850
       LRS     53             SHIFT FIRST DIMENSION INTO RIGHT MOST     F1D04860
       MPY     ERASA1         PART OF MQ AND MULTIPLY BY SECOND.        F1D04870
       STQ     1,1            SAVE PRODUCT (LINEAR DIMENSION OF THIS    F1D04880
       TXI     *+1,1,-2       ARRAY) IN PACKED TABLE.                   F1D04890
       TXI     *+1,2,-2       UPDATE INDICES.                           F1D04900
       TIX     DMSZC,4,1     *IS DIM2 EXHAUSTED, NO CONTINUE.           F1D04910
       REM                                                              F1D04920
       REM                    COMPUTE THE LINEAR LENGTH OF THE VARIABLESF1D04930
       REM                    IN THE DIM3 TABLE AND PACK BEHIND DIM2    F1D04940
       REM                    IN THE COMBINED DIM1-DIM2 TABLE (SIZ).    F1D04950
       REM                                                              F1D04960
DMSZD  LXD     DIM3IX-2,4     LOAD COUNT OF ENTRIES IN DIM3 TABLE.      F1D04970
       TXL     DMSZF,4,0     *DIM3 TABLE EMPTY.                         F1D04980
       LAC     DIM3IX-1,2     LOAD 2S COMPLIMENT OF DIM3 ORIGIN.        F1D04990
DMSZE  CAL     0,2            GET VARIABLE NAME FROM DIM3 AND PACK      F1D05000
       SLW     0,1            BEHIND SIZ TABLE.                         F1D05010
       CLA     1,2            GET DIMENSIONS.                           F1D05020
       STA     ERASA1         SAVE SECOND DIMENSION.                    F1D05030
       LRS     53             SHIFT FIRST DIMENSION INTO ADDRESS OF MQ. F1D05040
       MPY     ERASA1         MULTIPLY BY SECOND DIMENSION.             F1D05050
       MPY     2,2            MULTIPLY PRODUCT OF D1*D2 BY THIRD        F1D05060
       STQ     1,1            DIMENSION AND SAVE PRODUCT(LINEAR DIM.).  F1D05070
       TXI     *+1,1,-2       UPDATE INDICES.                           F1D05080
       TXI     *+1,2,-3                                                 F1D05090
       TIX     DMSZE,4,1     *IS DIM3 TABLE EXHAUSTED, NO CONTINUE.     F1D05100
       REM                                                              F1D05110
       REM                    THIS PART OF THE DIM TO SIZ ROUTINE       F1D05120
       REM                    DOUBLES THE STORAGE ASSIGNMENT FOR DP     F1D05130
       REM                    AND CA ARRAYS.  NAMES OF ARRAYS ARE       F1D05140
       REM                    ENTERED IN DLST1 WHEN THEY APPEAR IN A    F1D05150
       REM                    DIMESION STATEMENT HAVING A D OR I IN     F1D05160
       REM                    CARD COLUMN ONE.                          F1D05170
       REM                                                              F1D05180
DMSZF  LXD     DLIST1-2,4     LOAD COUNT OF ENTRIES IN DLIST1 TABLE.    F1D05190
       TXL     DMSZK,4,0     *TABLE EMPTY.                              F1D05200
       SXD     DMSZI,1        SAVE SIZ TABLE INDEX IN TEST INSTRUCTION. F1D05210
       LAC     DLIST1-1,2     LOAD 2S COMPLIMENT OF DLST1 TABLE ORIGIN. F1D05220
DMSZG  LAC     ORGDM1,1       LOAD 2S COMPLIMENT OF SIZ TABLE ORIGIN.   F1D05230
       CAL     0,2            GET AN ARRAY NAME FROM DLST1 AND          F1D05240
DMSZH  LAS     0,1            SEARCH FOR IT IN SIZ.                     F1D05250
       TXI     DMSZI,1,-2     NOT FOUND YET, INCREMENT SIZ INDEX.       F1D05260
       TXI     DMSZJ,2,-2     NAME FOUND IN SIZ, UPDATE DLST1 INDEX.    F1D05270
       TXI     DMSZI,1,-2     NOT FOUND YET, INCREMENT SIZ INDEX.       F1D05280
DMSZI  TXH     DMSZH,1,**    *IS SIZ TABLE EXHAUSTED, NO CONTINUE.      F1D05290
       TSX     1PER2,4        YES, WE HAVE A MACHINE ERROR.             F1D05300
DMSZJ  CAL     1,1            GET DIMENSION OF ARRAY IN SIZ AND         F1D05310
       ALS     1              MULTIPLY BY 2.                            F1D05320
       SLW     1,1            THEN, STORE BACK IN SIZ.                  F1D05330
       TIX     DMSZG,4,1     *IS DLST1 TABLE EXHAUSTED, NO CONTINUE.    F1D05340
       LXD     DMSZI,1        YES, RESTORE SIZ INDEX.                   F1D05350
       REM                                                              F1D05360
       REM                    THIS PART OF THE DIM TO SIZ ROUTINE       F1D05370
       REM                    ASSIGNS 2 WORDS OF STORAGE FOR NON-       F1D05380
       REM                    SUBSCRIPTED VARIABLES APPEARING IN DP     F1D05390
       REM                    AND CA ARITHMETIC, IF AND CALL STATEMENTS.F1D05400
       REM                                                              F1D05410
DMSZK  LXD     DLIST2-2,4     LOAD COUNT OF ENTRIES IN DLST2 TABLE.     F1D05420
       TXL     DMSZR,4,0     *TABLE EMPTY.                              F1D05430
       PXA     ,4             PLACE COUNT OF ENTRIES (DLST2 IS A 1 WORD F1D05440
       ADD     DLIST2-1       ENTRY) IN AC AND COMPUTE LAST ADDRESS     F1D05450
       STA     DMSZM          PLUS ONE OF TABLE.                        F1D05460
       LDQ     (2)L           LOAD A DIMENSION OF TWO INTO MQ.          F1D05470
DMSZL  LXD     INTETJ+1,2     LOAD WORD COUNT OF CLOSUB TABLE.          F1D05480
DMSZM  CAL     **,4           GET AN ENTRY FROM DLST2 AND SEARCH FOR    F1D05490
       TXL     DMSZP,2,0     *THAT NAME IN CLOSUB.  NO CLOSUB TABLE.    F1D05500
DMSZN  LAS     **,2           IF THE NAME APPEARS IN CLOSUB, THEN       F1D05510
       TRA     *+2            SECTION ONE HAS MISTAKENLY THOUGHT IT TO  F1D05520
       TRA     DMSZQ          BE A NON-SUBSCRIPTED VARIABLE NAME IN THE F1D05530
       TIX     DMSZN,2,1      ARGUMENT LIST OF A CALL STATEMENT.        F1D05540
DMSZP  SLW     0,1            SYMBOL NOT IN CLOSUB, IS REAL NON-        F1D05550
       STQ     1,1            SUBSCRIPTED VARIABLE NAME, ASSIGN A       F1D05560
       TXI     *+1,1,-2       DIMENSION OF TWO.                         F1D05570
DMSZQ  TIX     DMSZL,4,1     *IS DLST2 EXHAUSTED, NO CONTINUE.          F1D05580
       REM                                                              F1D05590
       REM               THE SIZ TABLE CONSISTING OF TWO WORD ENTRIES   F1D05600
       REM               IS NOW COMPLETE.  THE DIM1, DIM2, DIM3, DLST1, F1D05610
       REM               AND DLST2 TABLES ARE DEAD.                     F1D05620
       REM                                                              F1D05630
DMSZR  PXD     ,1             GET TRU LAST ADDRESS                      F1D05640
       PDC     ,1             OF SIZ TABLE.                             F1D05650
       LAC     ORGDM1,4       LOAD 2S COMPLIMENT OF SIZ TABLE ORIGIN    F1D05660
       SXD     *+1,4          AND SET IN INSTRUCTION TO COMPUTE         F1D05670
       TXI     *+1,1,**       WORD COUNT OF SIZ TABLE.                  F1D05680
       SXD     DMIO3,1        SET WORD COUNT IN I/O COMMAND.            F1D05690
       SXA     ERASA1,1       SAVE WORD COUNT TO BE WRITTEN ON TAPE.    F1D05700
       TSX     (TAPE),4       WRITE SIZ TABLE AS RECORD 3 OF FILE 4.    F1D05710
       PZE     DMIO1,,(WBNP)  THE SIZ TABLE (IF ANY) IS PRECEDED BY     F1D05720
       PZE     LABL3,,TABTAP  EIFNO (LAST IFN IN PROGRAM) AND THE       F1D05730
       REM                                                              F1D05740
       TSX     (TAPE),4       SIZ WORD COUNT. WRITE AN END-OF-FILE      F1D05750
       PZE     ,,(WEFP)       AFTER THE SIZ TABLE.                      F1D05760
       PZE     4THEOF,,TABTAP                                           F1D05770
       REM                                                              F1D05780
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D05790
       REM                                                              F1D05800
       NZT     INTETJ+1       WAS CLOSUB WRITTEN ON SCRATCH TAPE.       F1D05810
       TRA     FXASM          NO, THERE IS NO ANY CLOSUB TABLE.         F1D05820
       TSX     (TAPE),4       BACKSPACE SCRATCH TAPE TO BEGINNING OF    F1D05830
       PZE     BSR,,(SKBP)    CLOSUB TABLE.                             F1D05840
       PZE     TCLOS,,EXEQTP                                            F1D05850
       REM                                                              F1D05860
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D05870
       REM                                                              F1D05880
FXASM  LXD     FXCNIX-2,4     PLACE FIXCON TABLE WORD COUNT IN LOCATION F1D05890
       PXA     ,4             PRECEDING THE TABLE FOR SECTION TWO.      F1D05900
       STO     FXCNWC                                                   F1D05910
       REM                                                              F1D05920
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D05930
       REM                                                              F1D05940
       REM     ASSEMBLE ENDI TABLE (IF NONE, FABRICATE ONE).            F1D05950
       REM                                                              F1D05960
ENDIA  LXD     INTETT,1       LOAD ENDI TABLE MAXIMUM LENGTH.           F1D05970
       PXA     ,1             PLACE MAXIMUM LENGTH IN AC.               F1D05980
       ADD     INTETT         COMPUTE LAST ADDRESS PLUS ONE OF ASSEMBLY F1D05990
       STA     ENDIB          BUFFER AND INITIALIZE ADDRESS.            F1D06000
       CAL     (2)L           SET ENTIRE                                F1D06010
ENDIB  SLW     **,1           TABLE TO 2S.                              F1D06020
       TIX     ENDIB,1,1                                                F1D06030
       REM                                                              F1D06040
       TSX     TAP00,1        ASSEMBLE ENDI TABLE OVER PRE-SET BUFFER.  F1D06050
       PZE     19                                                       F1D06060
       REM                                                              F1D06070
       AXT     6,1            LOAD SENSE SWITCH COUNT OF SIX.           F1D06080
       PXA     ,1             PLACE IN AC.                              F1D06090
       ADD     INTETT         COMPUTE ADDRESS OF LAST PHYSICAL SENSE    F1D06100
       STA     ENDIC          SWITCH AND INITIALIZE ADDRESS.            F1D06110
ENDIC  CAL     **,1           GET A SETTING FROM THE ASSEMBLED TABLE.   F1D06120
       SUB     (2)L           IS IT A SETTING OF TWO.                   F1D06130
       TMI     ENDID         *NO, 0 OR 1, LEAVE ALONE.                  F1D06140
       ZAC                    SENSE SWITCH UP, RESET SETTING.           F1D06170
       SLW*    ENDIC          SAVE NEW SETTING FOR THIS SENSE SWITCH.   F1D06180
ENDID  TIX     ENDIC,1,1     *ALL TESTED, NO CONTINUE.                  F1D06190
       REM                                                              F1D06200
       REM                    THE ENDI TABLE NOW CONTAINS AT LEAST      F1D06210
       REM                    SIX ENTRIES.                              F1D06220
       LXD     INTETT+1,4     GET ENDI WORD COUNT.  WERE THERE ANY      F1D06230
       TXL     *+2,4,6       *SETTINGS IN THE END CARD.  NO.            F1D06240
       SXD     ENDIO,4        YES, MORE THAN SIX, RESET I/O COMMAND.    F1D06250
       CLA     INTETT         GET ORIGIN OF TABLE.                      F1D06260
       STA     ENDIO          SET IN I/O COMMAND.                       F1D06270
       TSX     (TAPE),4       WRITE ENDI TABLE AS RECORD 1 OF FILE 5.   F1D06280
       PZE     ENDIO,,(WBNP)                                            F1D06290
       PZE     INTETT+2,,TABTAP                                         F1D06300
       REM                                                              F1D06310
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D06320
       REM                                                              F1D06330
       REM     SUBDEF TABLE IS NO LONGER NEEDED, WRITE IT OUT.          F1D06340
       REM                                                              F1D06350
       TSX     WAT00,1        NO MODIFICATION, WRITE IT AS RECORD 2     F1D06360
       PZE     11             OF FILE 5.                                F1D06370
       REM                                                              F1D06380
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D06390
       REM                                                              F1D06400
       TSX     TAP00,1        ASSEMBLE COMMON TABLE.                    F1D06410
       PZE     12                                                       F1D06420
       REM                                                              F1D06430
       TSX     WAT00,1        NO MODIFICATION, WRITE AS RECORD 3        F1D06440
       PZE     12             OF FILE 5.                                F1D06450
       REM                                                              F1D06460
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D06470
       REM                                                              F1D06480
       TSX     TAP00,1        ASSEMBLE TABLE OF HOLLERITH ARGUMENTS.    F1D06490
       PZE     13                                                       F1D06500
       REM                                                              F1D06510
       TSX     WAT00,1        NO MODIFICATION, WRITE AS RECORD 4        F1D06520
       PZE     13             OF FILE 5.                                F1D06530
       REM                                                              F1D06540
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D06550
       REM                                                              F1D06560
       TSX     TAP00,1        ASSEMBLY TABLE OF EFNS/IFNS - TEIFNO.     F1D06570
       PZE     0                                                        F1D06580
       LXD     INTETA+1,4     LOAD TEIFNO WORD COUNT.                   F1D06590
       TXL     TEIFG,4,0     *NO TABLE, EXIT.                           F1D06600
       PXA     ,4             PLACE WORD COUNT IN AC.                   F1D06610
       ADD     INTETA         ADD ORIGIN OF TEIFNO TABLE.               F1D06620
       STA     TEIFA          SET ADDRESSES IN SEARCH ROUTINE.          F1D06630
       STA     TEIFC                                                    F1D06640
       LXD     GOOFCT,1       LOAD ERROR COUNT.                         F1D06650
       STA     EIFLOC         INITIALIZE CELL FOR 1 DOUBLE PRIME.       F1D06660
       SXD     EIFLOC,4                                                 F1D06670
TEIFA  CLA     **,4           GET A TEIFNO ENTRY.                       F1D06680
       TPL     TEIFB         *CHECK FOR DUPLICATE EFN.                  F1D06690
       SLW*    TEIFA          SET ENTRY PLUS, MINUS IS FLAG SET BY      F1D06700
       TIX     TEIFA,4,1      SECTION I, IS TABLE EXHAUSTED.            F1D06710
       TRA     TEIFF          YES, EXIT.                                F1D06720
       REM                                                              F1D06730
TEIFB  STA     ERASA1         SAVE EFN. FROM ENTRY.                     F1D06740
       TNX     TEIFF,4,1      IS TABLE EXHAUSTED, NO BUMP TO GET NEXT.  F1D06750
       PXA     ,4             NO, SHIFT CURRENT TEIFNO INCREMENT        F1D06760
       PAX     ,2             (DECREMENT) TO IR2 FOR SCAN.              F1D06770
TEIFC  CLA     **,2           GET SUCCEEDING TEIFNO ENTRY.              F1D06780
       TMI     TEIFD          IS THIS A SPECIAL ENTRY.                  F1D06790
       ANA     ADMSK          NO, GET ADDRESS FIELD - EFN.              F1D06800
       LAS     ERASA1         DO THESE TWO EFN MATCH.                   F1D06810
       TRA     *+2            NO.                                       F1D06820
       TRA     TEIFE          YES, WE HAVE FOUND AN ERROR.              F1D06830
TEIFD  TIX     TEIFC,2,1      AT LEAST NOT YET, BUT LETS CONTINUE.      F1D06840
       TRA     TEIFA          IS ALL RIGHT ON THIS ENTRY, GET NEXT.     F1D06850
       REM                                                              F1D06860
TEIFE  CLS*    TEIFC          SET THIS ENTRY MINUS SO THAT IT WILL BE   F1D06870
       STO*    TEIFC          IGNORED WHEN WE GET TO IT LATER.          F1D06880
       TXI     *+1,1,1        INCREMENT ERROR LIST INDEX.               F1D06890
       STO     ELSEBF,1       SAVE DUPLICATE EFN.                       F1D06900
       CLA     GOOFCT         INCREMENT COUNT OF EFN DUPLICATES.        F1D06910
       ADD     (1)L                                                     F1D06920
       STA     GOOFCT         SAVE COUNT.                               F1D06930
       TRA     TEIFA          CONTINUE SEARCH.                          F1D06940
       REM                                                              F1D06950
TEIFF  LXA     GOOFCT,4       LOAD COUNT OF DUPLICATE EFNS.             F1D06960
       TXL     TEIFG,4,0     *NONE, WRITE TABLE.                        F1D06970
       PXA     ,4             PLACE ERROR COUNT IN AC.                  F1D06980
       TXI     *+1,1,1        INCREMENT ERROR LIST INDEX FOR 1 DP.      F1D06990
       LXD     GOOFCT,2       LOAD OLD ERROR INDEX.                     F1D07000
       SXD     GOOFCT,1       SAVE NEW ONE.                             F1D07010
       ORA     EIFSG          ADD EFN ERROR FLAG.                       F1D07020
       SLW     ELSEBF,2       SAVE IN ERROR LIST.                       F1D07030
       REM                                                              F1D07040
TEIFG  TSX     WAT00,1        WRITE TEIFNO TABLE AS RECORD 5 OF FILE 5. F1D07050
       PZE     0                                                        F1D07060
       REM                                                              F1D07070
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D07080
       REM                                                              F1D07090
       REM     ROUTINE TO REPLACE EFNS IN THE TIFGO TABLE WITH IFNS     F1D07100
       REM     FROM THE TEIFNO TABLE.                                   F1D07110
       REM                                                              F1D07120
       TSX     TAP00,1        ASSEMBLE TABLE OF IFS AND GO TOS (TIFGO). F1D07130
       PZE     2                                                        F1D07140
       REM                                                              F1D07150
       REM               THE MODIFICATION OF TIFGO, TRAD, TDO AND FRET  F1D07160
       REM               REQUIRE THE EXISTENCE OF A TEIFNO TABLE.       F1D07170
       REM               A CHECK IS THEREFORE MADE AT THIS POINT FOR    F1D07180
       REM               THE NECESSITY OF A TEIFNO TABLE.               F1D07190
       REM                                                              F1D07200
       CAL     INTETH-3       LOAD FRET BUFFER WORD COUNT.              F1D07240
       ADD     INTETC+1       ADD TIFGO TABLE WORD COUNT.               F1D07250
       ADD     INTETH+1       ADD FRET DUMP WORD COUNT.                 F1D07260
       ANA     DCMSK          GET ACCUMULATED COUNT.                    F1D07270
       LXD     EIFLOC,4       LOAD TEIFNO WORD COUNT.                   F1D07280
       TZE     NOTIF+1       *NO TABLES, NO NEED FOR TEIFNO.            F1D07290
       TXH     *+2,4,0        IS THERE A TEIFNO TABLE.                  F1D07300
NOTIF  TSX     1PER3,4       *NO, PROGRAMMER ERROR.                     F1D07310
       SXA     FEIFA,4        YES, SAVE WORD COUNT IN SEARCH ROUTINE.   F1D07320
       CLA     EIFLOC         GET LAST ADDRESS PLUS ONE OF TEIFNO       F1D07330
       STA     FEIFB          AND INITIALIZE TEIFNO SEARCH ROUTINE.     F1D07340
       STA     FEIFC                                                    F1D07350
       STA     MTDOD          INITIALIZE TDO TEST ROUTINE.              F1D07360
       STA     MTDOE                                                    F1D07370
       REM                                                              F1D07380
MTIF0  LXD     INTETC+1,2     LOAD WORD COUNT OF TIFGO TABLE.           F1D07390
       PXA     ,2             PLACE WORD COUNT IN AC.                   F1D07400
       ADD     INTETC         COMPUTE LAST ADDRESS PLUS ONE OF TIFGO.   F1D07410
       STA     TIFLOC         INITIALIZE CELLS FOR 1 DOUBLE PRIME.      F1D07420
       SXD     TIFLOC,2                                                 F1D07430
       TXL     MTIFF,2,0     *NO TIFGO TABLE, SKIP THE REST OF THIS     F1D07440
       STA     MTIFA          INITIALIZATION JAZZ.                      F1D07450
       STA     MTIFG                                                    F1D07460
       STA     MTIFC                                                    F1D07470
       STA     MTIFH                                                    F1D07480
       STA     MTIFD                                                    F1D07490
       STA     MTIFI                                                    F1D07500
       STA     IFRTB                                                    F1D07510
       REM                                                              F1D07520
       REM                                                              F1D07530
       REM     ROUTINE TO REPLACE EFNS IN TIFGO BY IFNS FROM TEIFNO.    F1D07540
       REM                                                              F1D07550
MTIFA  CLA     **,2           GET FIRST WORD OF ENTRY.                  F1D07560
       TMI     MTIFB         *MINUS TIFGO TYPE.                         F1D07570
       PAX     ,1             PLACE TYPE NUMBER IN INDEX REGISTER.      F1D07580
       TXL     *+2,1,6        IS TYPE NUMBER GREATER THAN 6.            F1D07590
       AXT     7,1            YES, ONE DOUBLE PRIME WILL NOTE ERROR.    F1D07600
       XEC     TIFTR,1        BRANCH ON TYPE NUMBER TO PROPER ENTRY.    F1D07610
       TSX     1PER4,4        TABLE EXHAUSTED, IMPOSSIBLE.              F1D07620
       REM                                                              F1D07630
       TIX     MTIFE,2,1      N = 7, NO MODIFICATION.                   F1D07640
       TIX     MTIFD,2,1      N = 6                                     F1D07650
       TIX     MTIFC,2,1      N = 5                                     F1D07660
       TIX     MTIFC,2,1      N = 4                                     F1D07670
       TIX     MTIFC,2,1      N = 3                                     F1D07680
       TIX     MTIFE,2,1      N = 2, NO MODIFICATION.                   F1D07690
       TIX     MTIFE,2,1      N = 1, NO MODIFICATION.                   F1D07700
TIFTR  TIX     MTIFD,2,1      N = 0                                     F1D07710
       REM                                                              F1D07720
       REM     GENERAL PROCESSOR FOR TIFGO TABLE, FOUR ENTRY POINTS.    F1D07730
       REM                                                              F1D07740
MTIFB  STA     ERASA1         SAVE ADDRESS OF FIRST WORD OF ENTRY.      F1D07750
       TSX     FEIFA,1        SEARCH TEIFNO FOR CORRESPONDING           F1D07760
       ARS     18             IFN AND INSERT IN PLACE OF EFN            F1D07770
MTIFG  STA     **,2           IN TABLE.                                 F1D07780
       TNX     1PER4,2,1     *TABLE EXHAUSTED, IMPOSSIBLE.              F1D07790
MTIFC  CAL     **,2           GET BETA1 (BETA2 IF MINUS TYPE) FROM      F1D07800
       ARS     18             DECREMENT FIELD OF SECOND WORD OF ENTRY.  F1D07810
       STA     ERASA1         SAVE FOR TEIFNO SEARCH.                   F1D07820
       TSX     FEIFA,1        SEARCH TEIFNO.                            F1D07830
MTIFH  STD     **,2           REPLACE EFN WITH CORRESPONDING IFN.       F1D07840
MTIFD  CAL     **,2           GET BETA2 (BETA3 IF MINUS TYPE) FROM      F1D07850
       STA     ERASA1         ADDRESS FIELD OF SECOND WORD OF ENTRY.    F1D07860
       TSX     FEIFA,1        SEARCH TEIFNO.                            F1D07870
       ARS     18             SHIFT IFN INTO ADDRESS FIELD AND INSERT   F1D07880
MTIFI  STA     **,2           INTO TIFGO IN PLACE OF EFN.               F1D07890
       REM                                                              F1D07900
MTIFE  TIX     MTIFA,2,1     *HAS ALL OF TIFGO BEEN PROCESSED, NO.      F1D07910
       REM                                                              F1D07920
MTIFF  TSX     WAT00,1        YES, WRITE MODIFIED TIFGO AS RECORD 6     F1D07930
       PZE     2              OF FILE 5.                                F1D07940
       REM                                                              F1D07950
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D07960
       REM                                                              F1D07970
       REM     ROUTINE TO REPLACE EFNS IN TRAD WITH IFNS FROM TEIFNO.   F1D07980
       REM                                                              F1D07990
       TSX     TAP00,1        ASSEMBLE TRAD TABLE.                      F1D08000
       PZE     3                                                        F1D08010
       REM                                                              F1D08020
       LXD     INTETD+1,2     LOAD TRAD WORD COUNT.                     F1D08030
       TXL     MTRDC,2,0     *EMPTY TABLE.                              F1D08040
       PXA     ,2             PLACE WORD COUNT IN AC.                   F1D08050
       ADD     INTETD         ADD ORIGIN OF TABLE.                      F1D08060
       STA     TRDLOC         INITIALIZE ADDRESSES.                     F1D08070
       STA     MTRDA                                                    F1D08080
       STA     MTRDB                                                    F1D08090
       SXD     TRDLOC,2       SAVE WORD COUNT FOR 1 DOUBLE PRIME.       F1D08100
MTRDA  CAL     **,2           GET AN EFN FROM TRAD.                     F1D08110
       STA     ERASA1         SAVE FOR SEARCH ROUTINE.                  F1D08120
       TSX     FEIFA,1        SEARCH TEIFNO FOR CORRESPONDING IFN.      F1D08130
       ARS     18             MOVE IFN TO ADDRESS FIELD.                F1D08140
MTRDB  STA     **,2           REPLACE EFN IN TRAD BY IFN.               F1D08150
       TIX     MTRDA,2,1     *IS TRAD EXHAUSTED, NO CONTINUE.           F1D08160
       REM                                                              F1D08170
MTRDC  TSX     WAT00,1        WRITE TRAD AS RECORD 7 OF FILE 5.         F1D08180
       PZE     3                                                        F1D08190
       REM                                                              F1D08200
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D08210
       REM                                                              F1D08220
       REM     ROUTINE TO REPLACE EFNS IN TDO WITH IFNS FROM TEIFNO.    F1D08230
       REM                                                              F1D08240
       TSX     TAP00,1        ASSEMBLE TDO TABLE.                       F1D08250
       PZE     1                                                        F1D08260
       REM                                                              F1D08270
       LXD     INTETB+1,2     LOAD WORD COUNT OF TABLE.                 F1D08280
       TXL     MTDOH,2,0     *NO ENTRIES IN TDO, EXIT.                  F1D08290
       PXA     ,2             PLACE WORD COUNT IN AC.                   F1D08300
       ADD     INTETB         ADD TABLE ORIGIN TO FORM LAST ADDRESS+1.  F1D08310
       STA     MTDOA          INITIALIZE                                F1D08320
       STA     MTDOB          ADDRESSES IN                              F1D08330
       STA     MTDOF          MODIFICATION ROUTINE.                     F1D08340
       STA     TDOLOC         SET INFORMATION FOR SUCCEEDING RECORDS.   F1D08350
       SXD     TDOLOC,2                                                 F1D08360
       REM                                                              F1D08370
MTDOA  CLA     **,2           GET FIRST WORD OF A TDO ENTRY.            F1D08380
       TPL     MTDOC         *NORMAL DO LOOP.                           F1D08390
MTDOB  SLW     **,2           MINUS SIGNIFIES A TDO ENTRY GENERATED BY  F1D08400
       TRA     MTDOG          I/O TRANSLATOR, SET PLUS AND CONTINUE.    F1D08410
       REM                                                              F1D08420
MTDOC  STA     ERASA1         SAVE BETA OF DO FOR TEIFNO SEARCH ROUTINE.F1D08430
       TSX     FEIFA,1        SEARCH FOR BETA IN TEIFNO.                F1D08440
       TXL     NOTIF,4,0     *IS THERE A TEIFNO TABLE, NO.              F1D08441
       TZE     MTDOF         *NOT FOUND IN TEIFNO.                      F1D08450
       TNX     MTDOE+1,4,1   *NO MORE ENTRIES IN TEIFNO.                F1D08460
MTDOD  CAL     **,4           GET NEXT TEIFNO ENTRY.                    F1D08470
       ANA     ADMSK          GET EFN.                                  F1D08480
       SUB     ERASA1         IS IT THE SAME AS BETA.                   F1D08490
       TZE     MTDOE         *YES.                                      F1D08500
       TXI     *+1,4,1        NO, BACK UP TEIFNO INDEX BY ONE.          F1D08510
MTDOE  CAL     **,4           GET TEIFNO ENTRY (BETA).                  F1D08520
       ARS     18             MOVE IFN TO ADDRESS FIELD.                F1D08530
MTDOF  STA     **,2           REPLACE EFN IN TDO BY IFN FROM TEIFNO.    F1D08540
       REM                                                              F1D08550
MTDOG  TIX     MTDOA,2,5     *IS TDO EXHAUSTED, NO CONTINUE.            F1D08560
       REM                                                              F1D08570
MTDOH  TSX     WAT00,1        YES, WRITE MODIFIED TDO TABLE AS          F1D08580
       PZE     1              RECORD 8 OF FILE 5.                       F1D08590
       REM                                                              F1D08600
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D08610
       REM                                                              F1D08620
       REM     ROUTINE TO REPLACE EFNS IN FRET WITH IFNS FROM TEIFNO.   F1D08630
       REM     THE TABLE IS ALSO SORTED ON THE IFNS AND THOSE           F1D08640
       REM     FREQUENCIES REFERING TO COMPUTED GO TO S AND IF          F1D08650
       REM     STATEMENTS ARE PERMUTED.                                 F1D08660
       REM                                                              F1D08670
       REM                                                              F1D08680
       TSX     TAP00,1        ASSEMBLE FRET TABLE.                      F1D08690
       PZE     7                                                        F1D08700
       REM                                                              F1D08710
       LXD     INTETH+1,2     LOAD FRET WORD COUNT.                     F1D08720
       TXL     WRFRT,2,0     *NO TABLE, EXIT.                           F1D08730
       PXA     ,2             SOME TABLE, PLACE WORD COUNT IN AC.       F1D08740
       ADD     INTETH         COMPUTE LAST ADDRESS PLUS ONE.            F1D08750
       SXD     FRTLOC,2       SAVE WORD COUNT FOR 1 DOUBLE PRIME.       F1D08760
       STA     FRTLOC         SAVE LAST+1 FOR SAME.                     F1D08770
       STA     MFRTA          INITIALIZE ADDRESSES IN FRET PROCESSOR.   F1D08780
       STA     MFRTB          ..                                        F1D08790
       STA     SFRTA          ..                                        F1D08800
       STA     SFRTC          ..                                        F1D08810
       STA     SFRTE          ..                                        F1D08820
       STA     SFRTH          ..                                        F1D08830
       STA     SFRTI          ..                                        F1D08840
       STA     SFRTL          ..                                        F1D08850
       STA     IFRTD          ..                                        F1D08860
       STA     IFRTG          ..                                        F1D08870
       STA     IFRTL          ..                                        F1D08880
       REM                                                              F1D08890
       REM     REPLACE EFNS IN FRET WITH IFNS FROM TEIFNO.              F1D08900
       REM                                                              F1D08910
MFRTA  CLA     **,2           GET AN ENTRY FROM FRET                    F1D08920
       TPL     MFRTC         *NOT WORD CONTAINING EFN.                  F1D08930
       STA     ERASA1         SAVE EFN FOR TEIFNO SEARCH.               F1D08940
       TSX     FEIFA,1        SEARCH TEIFNO FOR CORRESPONDING IFN.      F1D08950
       ARS     18             MOVE IFN TO ADDRESS FIELD.                F1D08960
MFRTB  STA     **,2           REPLACE EFN WITH IFN.                     F1D08970
       ANA     ADMSK          MASK OUT ALL BUT ADDRESS FIELD.           F1D0897A
       TNZ     MFRTC         *IS THERE AN IFN, YES.                     F1D0897B
       CLA     ERASA1         NO. RETRIEVE EFN.                         F1D0897C
       ORA     MFRTE          ADD NON-EXIST FLAG.                       F1D0897D
       LXD     GOOFCT,4       LOAD ERROR LIST INDEX.                    F1D0897E
       SLW     ELSEBF,4       SAVE FOR DIAGNOSTIC.                      F1D0897F
       TXI     *+1,4,1        UPDATE ERROR LIST INDEX.                  F1D0897G
       SXD     GOOFCT,4       SAVE ERROR COUNT FOR DIAGNOSTIC.          F1D0897H
       PXD     ,4             PLACE ERROR INDEX IN AC AND               F1D0897I
       ADD     ADMSK          ADD AN ADDRESS OF ALL ONES SO THAT        F1D0897J
       SSM                    ANY COMPARISONS WILL FAIL.                F1D0897K
       STO*    MFRTA          STORE DUMMY ENTRY IN FRET.                F1D0897L
MFRTC  TIX     MFRTA,2,1     *ALL EFNS REPLACED, NO CONTINUE.           F1D08980
       REM                                                              F1D08990
       REM     SORT FRET ON THE IFNS.                                   F1D09000
       REM                                                              F1D09010
SFRTQ  LXD     FRTLOC,2       LOAD FRET WORD COUNT.                     F1D09020
SFRTA  CLA     **,2           GET A WORD FRET.                          F1D09030
       TMI     SFRTB         *IS THIS FIRST WORD OF ENTRY, YES.         F1D09040
       TIX     SFRTA,2,1      NO, GET NEXT WORD OF TABLE.               F1D09050
       TRA     SFRTP          TABLE EXHAUSTED.                          F1D09060
SFRTB  SXA     SFRTD,2        SAVE POSITION OF THIS ENTRY.              F1D09070
       TNX     SFRTP,2,1      DECREMENT INDEX AND SEARCH FOR NEXT       F1D09080
SFRTC  LDQ     **,2           ENTRY IN FRET.                            F1D09090
       TQP     *-2           *KEEP LOOKING FOR FIRST WORD OF NEXT ENTRY.F1D09100
       TLQ     SFRTA         *NEXT ENTRY, IS 2ND ENTRY IFN LOWER        F1D09110
       REM                    THAN 1ST ENTRY IFN.  NO, 2ND IS HIGHER.   F1D09120
       REM                                                              F1D09130
       REM               THE IFN OF ENTRY 1 IS HIGHER THAN THE IFN OF   F1D09140
       REM               ENTRY 2, INTERCHANGE THE TWO ENTRIES.          F1D09150
       REM                                                              F1D09160
       STQ     STATN          SAVE 2ND IFN FOR COMPARE.                 F1D09170
       CAS     STATN          ARE THE TWO IFNS EQUAL.                   F1D09180
       TRA     SFRTD          NO.                                       F1D09190
       TSX     1PER8,4       *YES, PROGRAMMER ERROR.                    F1D09200
SFRTD  AXT     **,1           LOAD POSITION OF ENTRY 1.                 F1D09210
       AXT     0,4            INITIALIZE INDEX OF TEMPORARY BUFFER.     F1D09220
       TRA     SFRTF          STORE FIRST WORD OF ENTRY 1.              F1D09230
SFRTE  CLA     **,1           GET NEXT WORD OF ENTRY 1.                 F1D09240
       TMI     SFRTG         *IS THIS THE FIRST WORD OF ENTRY 2, YES.   F1D09250
SFRTF  STO     LWBF2,4        NO, SAVE IN TEMPORARY BUFFER.             F1D09260
       TNX     1PER5X,1,1    *ERROR IF TABLE IS EXHAUSTED.              F1D09270
       TXI     SFRTE,4,-1     UPDATE STORING INDEX AND GET NEXT WORD.   F1D09280
       REM                                                              F1D09290
SFRTG  LXA     SFRTD,1        LOAD POSITION VACATED BY ENTRY 1.         F1D09300
       XCA                    MOVE FIRST WORD OF 2ND ENTRY TO AC.       F1D09310
       TRA     SFRTI          STORE FIRST WORD OF ENTRY 2.              F1D09320
SFRTH  CLA     **,2           GET NEXT WORD FROM TABLE.                 F1D09330
       TMI     SFRTJ         *IS THIS THE FIRST WORD OF NEXT ENTRY, YES.F1D09340
SFRTI  STO     **,1           NO, MOVE TO SPACE VACATED BY ENTRY 1.     F1D09350
       TNX     1PER5X,1,1    *MACHINE ERROR IF WORD COUNT IS EXHAUSTED. F1D09360
       TIX     SFRTH,2,1     *END OF TABLE, NO CONTINUE MOVING WORDS.   F1D09370
       REM                                                              F1D09380
SFRTJ  SXD     SFRTM,4        SAVE TEMPORARY BUFFER INCREMENT.          F1D09390
       SXA     SFRTN,1        SAVE POSITION OF NEW SECOND ENTRY.        F1D09400
       AXT     0,4            INITIALIZE TEMPORARY BUFFER INDEX.        F1D09410
SFRTK  CAL     LWBF2,4        GET A WORD OF THE OLD ENTRY 1 AND STORE   F1D09420
SFRTL  SLW     **,1           AS ENTRY 2 IN FRET TABLE.                 F1D09430
       TXI     *+1,1,-1       UPDATE STORING INDEX.                     F1D09440
       TXI     *+1,4,-1       UPDATE LOADING INDEX.                     F1D09450
SFRTM  TXH     SFRTK,4,**    *HAVE ALL OWRDS BEEN MOVED FROM TEM, NO.   F1D09460
SFRTN  AXT     **,2           YES, LOAD POSITION OF FIRST WORD OF NEW   F1D09470
       TRA     SFRTA          ENTRY 2 AND CONTINUE SORT FROM THERE.     F1D09480
       REM                                                              F1D09490
1PER5X TSX     1PER5,4       *MACHINE ERROR, TABLE CAN NOT BE EXHAUSTED.F1D09500
       REM                                                              F1D09510
SFRTP  LXD     SFRTM,4        LOAD COUNT OF WORDS MOVED DURING SORT.    F1D09520
       ZSD     SFRTM          RESET OUT OF SORT FLAG.                   F1D09530
       TXH     SFRTQ,4,0     *WERE ANY ENTRIES OUT OF ORDER, YES.       F1D09540
       REM                    NO, FRET TABLE IS SORTED.                 F1D09550
       REM                                                              F1D09560
       REM                    NOW INVERT THOSE FREQUENCIES REFERING     F1D09570
       REM                    TO COMPUTED GO TOS AND ARITHMETIC IF      F1D09580
       REM                    STATEMENTS.                               F1D09590
       REM                                                              F1D09600
IFRTA  LXD     TIFLOC,2       LOAD TIFGO WORD COUNT.                    F1D09610
       TXL     WRFRT,2,0     *TRANSFER IF NO TIFGO TABLE EXISTS.        F1D09620
       REM                                                              F1D09630
IFRTB  CLA     **,2           GET AN ENTRY FROM TIFGO.                  F1D09640
       PDX     ,4             SAVE IFN OF STATEMENT.                    F1D09650
       TMI     IFRTC         *ARITHMETIC IF, TRANSFER.                  F1D09660
       ANA     ADMSK          IS THIS A COMPUTED GO TO                  F1D09670
       SUB     (2)L                                                     F1D09680
       TNZ     IFRTM         *NO, CONTINUE SCAN.                        F1D09690
IFRTC  LXD     FRTLOC,1       YES, LOAD FRET WORD COUNT.                F1D09700
       SXA     ERASA1,4       SAVE IFN OF TIFGO STATEMENT.              F1D09710
IFRTD  CLS     **,1           GET A WORD FROM FRET.                     F1D09720
       TMI     IFRTE         *IS THIS FIRST WORD OF FRET, NO CONTINUE.  F1D09730
       SUB     ERASA1         YES, DO IFNS FROM TIFGO AND FRET MATCH.   F1D09740
       TZE     IFRTF         *YES, INVERT THE FREQUENCIES.              F1D09750
IFRTE  TIX     IFRTD,1,1     *IS FRET EXHAUSTED, NO CONTINUE SEARCH.    F1D09760
       TIX     IFRTB,2,2     *YES. IS TIFGO EXHAUSTED, NO CONTINUE.     F1D09770
       TRA     WRFRT         *YES, JOB IS ALL DONE.                     F1D09780
       REM                                                              F1D09790
IFRTF  TNX     1PER5X,1,1     POSITION INDEX AT FIRST FREQUENCY OF      F1D09800
       SXA     IFRTJ,1        THIS ENTRY AND SAVE POSITION.             F1D09810
       AXT     0,4            INITIALIZE TEMPORARY BUFFER INDEX.        F1D09820
IFRTG  CLA     **,1           MOVE A FREQUENCY TO TEMPORARY BUFFER.     F1D09830
       TMI     IFRTH         *IS THIS THE BEGINNING OF THE NEXT ENTRY.  F1D09840
       TXI     *+1,4,1        NO, UPDATE BUFFER INDEX (COUNTER).        F1D09850
       STO     LWBF2,4        STORE FREQUENCY IN TEMPORARY BUFFER.      F1D09860
       TIX     IFRTG,1,1     *IS FRET EXHAUSTED, NO CONTINUE.           F1D09870
IFRTH  TXH     *+2,4,0        YES, IS THERE AT LEAST ONE FREQUENCY.     F1D09880
       TSX     1PER6,4       *NO, EITHER PROGRAMMER OR MACHINE GOOFED.  F1D09890
IFRTJ  AXT     **,1           RELOAD POSITION OF THIS FREQUENCY ENTRY.  F1D09900
IFRTK  CAL     LWBF2,4        MOVE THE ENTRY FROM THE TEMPORARY BUFFER  F1D09910
IFRTL  SLW     **,1           BACK INTO THE FRET TABLE INVERTED.        F1D09920
       TXI     *+1,1,-1       UPDAT FRET INDEX.                         F1D09930
       TIX     IFRTK,4,1     *HAVE ALL WORDS BEEN MOVED, NO CONTINUE.   F1D09940
       REM                                                              F1D09950
IFRTM  TIX     IFRTB,2,2     *IS TIFGO EXHAUSTED, NO CONTINUE.          F1D09960
       REM                                                              F1D09970
WRFRT  SYN     *              FRET TABLE HAS BEEN PROCESSED.            F1D09980
       REM                                                              F1D09990
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D10000
       REM                                                              F1D10010
       REM     ROUTINE TO MODIFY THE FORVAL TABLE.                      F1D10020
       REM                                                              F1D10030
       TSX     TAP00,1        ASSEMBLE THE FORVAL TABLE (TABLE OF       F1D10040
       PZE     6              NON- SUBSCRIPTED FIXED POINT VARIABLES    F1D10050
       REM                    ON THE LEFT OF EQUALS SIGN).              F1D10060
       REM                                                              F1D10070
       LXD     INTETG+1,2     LOAD FORVAL WORD COUNT.                   F1D10080
       TXL     MFVLG,2,0     *NO TABLE, NO POSSIBLE MODIFICATION.       F1D10090
       REM                                                              F1D10100
       TSX     TAP00,1        FORVAL EXISTS, ASSEMBLE CALLFN TABLE.     F1D10110
       PZE     16                                                       F1D10120
       REM                                                              F1D10130
       LXD     INTETQ+1,4     LOAD CALLFN WORD COUNT.                   F1D10140
       TXL     MFVLG,4,0     *NO CALLFN, THEREFORE NO MODIFICATION      F1D10150
       REM                    TO FORVAL.                                F1D10160
       REM                                                              F1D10170
       REM               THERE ARE ENTRIES IN BOTH FORVAL AND CALL      F1D10180
       REM               NUMBER (CALLFN) TABLES. THEREFORE, THERE       F1D10190
       REM               MAY BE SOME IFN IN FORVAL WHICH MUST BE        F1D10200
       REM               REPLACED WITH THE LAST IFN RELATED TO A CALL   F1D10210
       REM               STATEMENT.  CALLFN CONTAINS THE FIRST AND      F1D10220
       REM               LAST IFNS OF CALL STATEMENTS.  THE ROUTINE TO  F1D10230
       REM               SEARCH AND REPLACE IS BASED UPON THE TWO TABLESF1D10240
       REM               BEING ORDERED BY MAGNITUDE OF INTERNAL FORMULA F1D10250
       REM               NUMBERS (IFNS).  THE TWO TABLES ARE BUILT BY   F1D10260
       REM               MAGNITUEDE OF IFNS IN SECTION ONE DURING       F1D10270
       REM               PROCESSING.  THIS PERMITS A SINGLE PASS        F1D10280
       REM               OVER BOTH TABLES.                              F1D10290
       REM                                                              F1D10300
       PXA     ,2             PLACE FORVAL WORD COUNT IN AC.            F1D10310
       ADD     INTETG         COMPUTE LAST ADDRESS PLUS ONE.            F1D10320
       STA     MFVLC          INITIALIZE ADDRESSES.                     F1D10330
       STA     MFVLE                                                    F1D10340
       PXA     ,4             PLACE CALLFN WORD COUNT IN AC.            F1D10350
       ADD     INTETQ         COMPUTE LAST ADDRESS PLUS ONE.            F1D10360
       STA     MFVLA          INITIALIZE ADDRESSES.                     F1D10370
       STA     MFVLD                                                    F1D10380
       REM                                                              F1D10390
MFVLA  CLA     **,4           GET AN ENTRY FROM CALLFN.                 F1D10400
       PAX     ,1             MOVE FIRST IFN TO DECREMENT FIELD OF AC.  F1D10410
MFVLB  PXD     ,1             RE-ENTRY FOR ANOTHER LOOK AT FORVAL.      F1D10420
MFVLC  LAS     **,2           COMPARE IFN FROM CALLFN TO FORVAL IFN.    F1D10430
       TRA     MFVLF         *CALLFN IFN GREATER THAN FORVAL IFN.       F1D10440
       TRA     MFVLD         *CALLFN AND FORVAL IFNS EQUAL.             F1D10450
       TIX     MFVLA,4,1      CALLFN IFN LESS THAN FORVAL IFN.  GET NEXTF1D10460
       TRA     MFVLG          IFN FROM CALLFN, IF EXHAUSTED, ALL DONE.  F1D10470
       REM                                                              F1D10480
MFVLD  CAL     **,4           GET ENTRY FROM CALLFN TABLE AND REPLACE   F1D10490
MFVLE  STD     **,2           IFN IN FORVAL BY LAST IFN FROM CALLFN.    F1D10500
MFVLF  TIX     MFVLB,2,2     *IS FORVAL EXHAUSTED, NO CONTINUE.         F1D10510
       REM                                                              F1D10520
MFVLG  TSX     WAT00,1        WRITE FORVAL AS RECORD 9 OF FILE 5.       F1D10530
       PZE     6                                                        F1D10540
       REM                                                              F1D10550
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D10560
       REM                                                              F1D10570
       TSX     TAP00,1        ASSEMBLE TABLE OF NON-SUBSCRIPTED FIXED   F1D10580
       PZE     5              POINT VARIABLES ON RIGHT OF EQUALS SIGN   F1D10590
       REM                    (FORVAR TABLE)                            F1D10600
       REM                                                              F1D10610
       TSX     WAT00,1        WRITE FORVAR AS RECORD 10 OF FILE 5.      F1D10620
       PZE     5                                                        F1D10630
       REM                                                              F1D10640
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D10650
       REM                                                              F1D10660
       TSX     TAP00,1        ASSEMBLE TABLE OF TAU USAGES (FORTAG).    F1D10670
       PZE     4                                                        F1D10680
       REM                                                              F1D10690
       TSX     WAT00,1        WRITE FORTAG AS RECORD 11 OF FILE 5.      F1D10700
       PZE     4                                                        F1D10710
       REM                                                              F1D10720
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D10730
       REM                                                              F1D10740
       TSX     WAT00,1        WRITE FRET AS RECORD 12 OF FILE 5.        F1D10750
       PZE     7                                                        F1D10760
       REM                                                              F1D10770
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D10780
       REM                                                              F1D10790
       TSX  TAP00,1          ASSEMBLE TABLE OF EQIVALENCE STATEMENTS    F1D10800
       PZE  8                (EQIT) FROM TAPE    AND CORES.             F1D10810
       REM                                                              F1D10820
       LXD     INTETI+1,3     LOAD WORD COUNT OF EQUIT TABLE.           F1D10830
       TXL     CLEQF1,2,0    *NO TABLE, EXIT.                           F1D10840
       REM                                                              F1D10850
       REM  THERE IS SOME EQUIT TABLE PRESENT, SO PROCESS IT...         F1D10860
       REM INITIALIZATION                                               F1D10870
MEQUIT LAC     L(FEQ),4       SET ERROR COUNT.                          F1D10880
       PXA     ,2             COMPUTE LAST ADDRESS PLUS ONE.            F1D10890
       ADD     L(FEQ)         LOCATION OF FINAL EQUIT TABLE.            F1D10900
       STA     *+1                                                      F1D10910
       STZ **,2                                                         F1D10920
       TIX *-1,2,1                                                      F1D10930
       PXA     ,1             PLACE WORD COUNT IN AC.                   F1D10940
       ADD     L(OEQ)         COMPUTE LAST ADDRESS PLUS ONE.            F1D10950
       PAC     ,1             GET 2S COMPLIMENT OF END OF TABLE.        F1D10960
       SXD     CLEQA0,1       INITIALIZE END TESTS.                     F1D10970
       SXD     CLEQB2+1,1                                               F1D10980
       LXD XCOUNT,2     GET COPY COUNT OF FIRST SYMBOL FIRST SENTENCE   F1D10990
       LXD OCOUNT,1                                                     F1D11000
       REM              (LOC OF LAST SUBSCRIPT COPIED IN ORDER FROM OEQ)F1D11010
OCOUNT TXI CLEQA0+1,,-LWBF1                                             F1D11020
       REM                                                              F1D11030
       REM FIND NEXT SENTENCE IN OEQ TO BE COPIED IN ORDER              F1D11040
CLEQA0 TXL CLEQF0,1,**  WAS FINAL SENTENCE IN OEQ PROCESSED             F1D11050
       CLA OEQ,1        NO, HAS SENTENCE IN OEQ BEEN COPIED OUT OF ORDERF1D11060
       TNZ CLEQA1+1     NO, SKIP TO COPY SENTENCE                       F1D11070
       TXI *+1,1,-1     YES, BUMP OEQ COUNT TO NEXT SUBSCRIPT           F1D11080
       CLA OEQ,1                                                        F1D11090
       TMI *+2          IS THIS FINAL SUBSCRIPT IN SENTENCE             F1D11100
       TXI *-2,1,-2     NO, BUMP OEQ COUNT TO NEXT SUBSCRIPT THIS SET   F1D11110
       TXI CLEQA0,1,-1  YES, BUMP OEQ COUNT TO FIRST SYMBOL NEXT SET    F1D11120
       REM                                                              F1D11130
       REM COPY ONE EQUIVALENCE SENTENCE FROM OEQ TO FEQ                F1D11140
CLEQA1 CLA OEQ,1        MOVE NEXT SYMBOL FROM OEQ                       F1D11150
       STO FEQ,2        TO FEQ                                          F1D11160
       TXI *+1,1,-1     BUMP COUNTS TO NEXT SUBSCRIPT                   F1D11170
       TXI *+1,2,-1                                                     F1D11180
       CLA OEQ,1        GET NEXT SUBSCRIPT                              F1D11190
       STA FEQ,2        COPY SUBSCRIPT IN FEQ                           F1D11200
       TMI *+3          IS THIS FINAL SUBSCRIPT IN SENTENCE             F1D11210
       TXI *+1,1,-1     NO, BUMP COUNTS TO NEXT SYMBOL                  F1D11220
       TXI CLEQA1,2,-1  AND GO COPY NEXT SYMBOL                         F1D11230
       REM                                                              F1D11240
       REM SCAN FEQ AND OEQ FOR SYMBOLS MATCHING ANY SYMBOL IN THIS SET F1D11250
       SXD OCOUNT,1     SAVE COUNT OF LAST SUBSCRIPT COPIED IN ORDER    F1D11260
       SXD XCOUNT,2     FROM OEQ TO FEQ                                 F1D11270
       LXD YCOUNT,2     GET FIXED COUNT OF NEXT SYMBOL IN FEQ           F1D11280
       REM                                                              F1D11290
       REM ONE SENTENCE HAS BEEN COPIED IN ORDER FROM OEQ TO FEQ.       F1D11300
       REM NOW THIS SENTENCE MUST BE SCANNED TO SEE IF ANY SYMBOLS ARE  F1D11310
       REM REPEATED WITHIN THIS SENTENCE. IF ANY SUCH SYMBOLS ARE       F1D11320
       REM REPEATED, THEY ARE EXAMINED FOR REDUNDANCY OR INCONSISTENCY. F1D11330
       REM IN CASE OF REDUNDANCY, THE REDUNDANT SYMBOL IS ERASED.       F1D11340
       REM IN CASE OF INCONSISTENCY, AN ERROR SITUATION IS CREATED.     F1D11350
       REM AFTER SCANNING WITHIN THE SENTENCE FOR REDUNDANCIES OR       F1D11360
       REM INCONSISTENCIES, THE REMAINING SENTENCES IN OEQ WHICH HAVE   F1D11370
       REM NOT YET BEEN COPIED ARE SCANNED TO SEE IF ANY MATCHING SYMBOLF1D11380
       REM EXISTS. IF NO SYMBOL IS FOUND IN THE REMAINDER OF OEQ WHICH  F1D11390
       REM MATCHES THE SYMBOL SCANNED FOR, REENTRY IS MADE AT THIS POINTF1D11400
       REM TO SCAN WITHIN THE SENTENCE AND THEN THE REST OF OEQ FOR THE F1D11410
       REM NEXT SYMBOL.                                                 F1D11420
       REM                                                              F1D11430
CLEQA2 LXD YCOUNT,1     GET FLOATING COUNT IN FEQ                       F1D11440
       TXI *+1,1,-2     BUMP FLOATING COUNT TO NEXT SYMBOL              F1D11450
       REM                                                              F1D11460
       REM LATER, ADDITIONS TO THIS SENTENCE MAY BE COPIED. IN THIS CASEF1D11470
       REM REENTRY IS MADE AT THIS POINT TO SCAN WITHIN THOSE PORTIONS  F1D11480
       REM OF THE ADDED SENTENCE FOR REDUNDANCY OR INCONSISTENCY.       F1D11490
       REM                                                              F1D11500
CLEQA3 CLA XCOUNT       SET END OF SENTENCE TESTS TO COUNT OF LAST      F1D11510
       STD CLEQA4       SUBSCRIPT COPIED INTO FEQ                       F1D11520
       STD *+1                                                          F1D11530
       TXL CLEQB1,1,**  IS THIS LAST FLOATING SYMBOL IN FEQ             F1D11540
       CLA FEQ,1        NO, GET FLOATING SYMBOL                         F1D11550
       CAS FEQ,2        IS THIS SYMBOL IDENTICAL TO FIXED SYMBOL        F1D11560
       TXI *-3,1,-2     NO, BUMP FLOATING COUNT TO NEXT SYMBOL          F1D11570
       TXI *+2,1,-1     YES, BUMP FLOATING COUNT TO ITS SUBSCRIPT       F1D11580
       TXI *-5,1,-2     NO, BUMP FLOATING COUNT TO NEXT SYMBOL          F1D11590
       REM                                                              F1D11600
       REM MATCHING SYMBOL FOUND                                        F1D11610
       TXI *+1,2,-1     BUMP FIXED COUNT TO SUBSCRIPT                   F1D11620
       SXD E4,1         SAVE FLOATING COUNT OF SUBSCRIPTS OF MATCHING   F1D11630
       REM              SYMBOL                                          F1D11640
       CLA FEQ,1        GET FLOATING SUBSCRIPT                          F1D11650
       SUB FEQ,2                                                        F1D11660
       TXI *+1,1,1      BUMP COUNTS BACK TO MATCHING SYMBOL             F1D11670
       TXI *+1,2,1                                                      F1D11680
       TNZ CLEQA5       ARE SUBSCRIPTS IDENTICAL                        F1D11690
       REM                                                              F1D11700
       REM REDUNDANCY                                                   F1D11710
       CLA FEQ+2,1      YES, ERASE REDUNDANT SYMBOL                     F1D11720
       STO FEQ,1        AND MOVE ALL FOLLOWING WORDS UP TWO             F1D11730
       TXI *+1,1,-1     BUMP COPY COUNT TO NEXT WORD                    F1D11740
CLEQA4 TXH *-3,1,**     IS THIS LAST WORD IN FEQ                        F1D11750
       TXI *+1,1,2      YES, BUMP END COUNT BACK TWO WORDS              F1D11760
       SXD XCOUNT,1     AND SAVE NEW COPY COUNT OF END OF SENTENCE      F1D11770
       LXD E4,1         RESUME SCAN WITH SAME FIXED SYMBOL              F1D11780
       TXI CLEQA3,1,1   BUT WITH FLOATING SYMBOL WHICH REPLACED         F1D11790
       REM              REDUNDANT SYMBOL                                F1D11800
       REM                                                              F1D11810
       REM INCONSISTENCY                                                F1D11820
CLEQA5 CLA FRCON        REPLACE FIRST WORD IN FEQ WITH WORD OF ALL      F1D11830
       STO*    L(FEQ)         SET ERROR FLAG.                           F1D11840
       REM              ERROR EXISTS.                                   F1D11850
       CLA FEQ,2        MOVE SYMBOL                                     F1D11860
       STO FEQ+1,4      TO ERROR LIST                                   F1D11870
       TXI CLEQB4,4,-1  BUMP ERROR COUNT AND GO CHECK FOR END OF SET    F1D11880
       REM                                                              F1D11890
       REM SEARCH REMAINDER OF OEQ FOR SYMBOLS MATCHING ANY SYMBOL IN   F1D11900
       REM THIS SENTENCE. IF FOUND, COPY SENTENCE OUT OF ORDER FROM OEQ F1D11910
       REM AND ADD IT TO THE SENTENCE NOW BEING SCANNED IN FEQ. THEN    F1D11920
       REM NORMALIZE THE SUBSCRIPTS, AND CONTINUE SCANNING.             F1D11930
       REM                                                              F1D11940
CLEQB1 LXD OCOUNT,1     START SEARCH WITH FIRST SYMBOL FOLLOWING        F1D11950
       REM              SENTENCE LAST COPIED IN ORDER FROM OEQ          F1D11960
       CLS WCOUNT       IS THIS A SCAN SUBSEQUENT TO COPYING A SENTENCE F1D11970
       REM              OUT OF ORDER                                    F1D11980
       TMI CLEQB2       NO, SKIP TO START SEARCH WITH NO CHANGE TO      F1D11990
       REM              COUNT OF FLOATING SYMBOL                        F1D12000
       LXD QCOUNT,1     YES, START SEARCH WITH FLOATING SYMBOL FOLLOWINGF1D12010
       REM              SENTENCE COPIED OUT OF ORDER FROM OEQ           F1D12020
       STO WCOUNT       RESET SWITCH                                    F1D12030
       REM                                                              F1D12040
       REM FIND NEXT SENTENCE IN OEQ THAT IS NOT YET COPIED OUT OF ORDERF1D12050
CLEQB2 TXI *+1,1,-1     BUMP COUNT TO SYMBOL                            F1D12060
       TXL CLEQB4,1,**  WAS THAT FINAL SENTENCE IN OEQ                  F1D12070
       SXD PCOUNT,1     NO, SAVE COUNT OF FIRST SYMBOL NEXT SENTENCE    F1D12080
       REM              WHICH MAY BE COPIED OUT OF ORDER FROM OEQ       F1D12090
       CLA OEQ,1        HAS THIS SENTENCE BEEN COPIED OUT OF ORDER      F1D12100
       TNZ CLEQB3+1     NO, SKIP TO CHECK SENTENCE                      F1D12110
       TXI *+1,1,-1     YES, BUMP OEQ COUNT TO NEXT SUBSCRIPT           F1D12120
       CLA OEQ,1                                                        F1D12130
       TMI CLEQB2       IS THIS FINAL SUBSCRIPT IN SENTENCE             F1D12140
       TXI *-2,1,-2     NO, BUMP OEQ COUNT TO NEXT SUBSCRIPT            F1D12150
       REM                                                              F1D12160
       REM SCAN THIS SENTENCE FOR ANY SYMBOL MATCHING FIXED SYMBOL      F1D12170
CLEQB3 CLA OEQ,1        GET FLOATING SYMBOL IN OEQ                      F1D12180
       SUB FEQ,2        IS OEQ SYMBOL IDENTICAL TO FEQ SYMBOL           F1D12190
       TZE CLEQC0       YES, GO ADD SENTENCE IN WHICH THIS SYMBOL       F1D12200
       REM              APPEARS TO SENTENCE ALREADY COPIED IN FEQ       F1D12210
       TXI *+1,1,-1     NO, BUMP OEQ COUNT TO NEXT SUBSCRIPT            F1D12220
       CLA OEQ,1        GET NEXT SUBSCRIPT                              F1D12230
       TMI CLEQB2       IS THIS FINAL SUBSCRIPT IN SENTENCE             F1D12240
       TXI CLEQB3,1,-1  NO, GO CHECK NEXT SYMBOL IN OEQ                 F1D12250
       REM                                                              F1D12260
       REM THIS FIXED SYMBOL WAS NOT MATCHED IN THE REMAINDER OF OEQ    F1D12270
       REM OR AN INCONSISTENT MATCH WAS FOUND WITHIN THE FEQ SENTENCE   F1D12280
CLEQB4 TXI *+1,2,-2     BUMP FIXED COUNT TO NEXT SYMBOL IN FEQ          F1D12290
       SXD YCOUNT,2     SAVE SCAN COUNT OF NEW FIXED SYMBOL             F1D12300
       REM              WAS THIS END OF SENTENCE IN FEQ BEING SEARCHED  F1D12310
XCOUNT TXH CLEQA2,2,-LWBF2                                              F1D12320
       REM              (LOC OF LAST SUBSCRIPT COPIED INTO FEQ)         F1D12330
       REM                                                              F1D12340
       REM NO MATCHING SYMBOL FOUND IN REMAINDER OF OEQ TABLE           F1D12350
       LXD XCOUNT,2     YES, GET COUNT OF LAST SUBSCRIPT COPIED INTO FEQF1D12360
       CLS FEQ,2        SET END OF SENTENCE MARKER IN LAST SUBSCRIPT    F1D12370
       STO FEQ,2        COPIED INTO FEQ                                 F1D12380
       TXI *+1,2,-1     BUMP FEQ COUNT TO FIRST SYMBOL OF NEXT SENTENCE F1D12390
       SXD YCOUNT,2     SET BEGINNING OF SCAN TO COUNT OF FIRST SYMBOL  F1D12400
       REM              NEXT SENTENCE                                   F1D12410
       SXD ZCOUNT,2     SET BEGINNING OF NORMALIZATION COUNT TO FIRST   F1D12420
       REM              SYMBOL NEXT SENTENCE                            F1D12430
       LXD OCOUNT,1     GET COUNT OF LAST SUBSCRIPT COPIED IN ORDER FROMF1D12440
       TXI CLEQA0,1,-1  FEQ, BUMP TO NEXT SYMBOL, AND GO COPY SENTENCE  F1D12450
       REM                                                              F1D12460
       REM OEQ SYMBOL FOUND MATCHING SYMBOL IN LAST SENTENCE COPIED     F1D12470
       REM                                                              F1D12480
CLEQC0 SXD CLEQC3,1     SET END OF COPY LOOP TO OEQ COUNT OF MATCHING   F1D12490
       REM              SYMBOL                                          F1D12500
       SXD YCOUNT,2     SET RESUMPTION OF SCAN TO MATCHING SYMBOL       F1D12510
       TXI *+1,1,-1     BUMP COUNTS TO SUBSCRIPT OF MATCHING SYMBOL     F1D12520
       TXI *+1,2,-1                                                     F1D12530
       CLA FEQ,2                                                        F1D12540
       SBM OEQ,1                                                        F1D12550
       STO E4           COMPUTE DIFFERENCE BETWEEN SUBSCRIPTS AND SAVE  F1D12560
       LXD XCOUNT,2     GET COUNT OF LAST SUBSCRIPT COPIED INTO FEQ     F1D12570
       SXD WCOUNT,2     SET RESUMPTION OF SCAN TO FIRST SYMBOL COPIED   F1D12580
       REM              OUT OF ORDER INTO FEQ                           F1D12590
       SXD CLEQD4,2     SET END OF NORMALIZATION LOOP FOR PRECEEDING    F1D12600
       REM              SENTENCE TO SUBSCRIPT PRECEDING MATCHING SYMBOL F1D12610
       REM                                                              F1D12620
       REM COPY OUT OF ORDER THAT PORTION OF SENTENCE IN OEQ IN WHICH   F1D12630
       REM MATCHED SYMBOL APPEARS FROM SYMBOL FOLLOWING MATCHED SYMBOL  F1D12640
       REM TO END OF SENTENCE AND ADD IT TO SENTENCE IN FEQ CURRENTLY   F1D12650
       REM BEING SCANNED.                                               F1D12660
       REM                                                              F1D12670
       CLA OEQ,1        GET SUBSCRIPT OF MATCHING SYMBOL IN OEQ         F1D12680
       TMI CLEQC2       IS THIS FINAL SUBSCRIPT IN SENTENCE             F1D12690
CLEQC1 TXI *+1,1,-1     NO, COPY REMAINDER OF SENTENCE INTO FEQ         F1D12700
       TXI *+1,2,-1     BUMP COUNTS TO NEXT SYMBOL                      F1D12710
       CLA OEQ,1        MOVE SYMBOL FROM OEQ                            F1D12720
       STO FEQ,2        TO FEQ                                          F1D12730
       TXI *+1,1,-1     BUMP COUNTS TO NEXT SUBSCRIPT                   F1D12740
       TXI *+1,2,-1                                                     F1D12750
       CLA OEQ,1        MOVE SUBSCRIPT FROM OEQ                         F1D12760
       STA FEQ,2        TO FEQ                                          F1D12770
       TPL CLEQC1       IS THIS FINAL SUBSCRIPT IN SENTENCE             F1D12780
       REM                                                              F1D12790
       REM SENTENCE IN OEQ IN WHICH MATCHING SYMBOL APPEARED HAS BEEN   F1D12800
       REM ADDED TO SENTENCE IN FEQ FROM SYMBOL FOLLOWING MATCHING      F1D12810
       REM SUBSCRIPT TO END.  NOW ADD REMAINDER OF SENTENCE, FROM       F1D12820
       REM BEGINNING TO SUBSCRIPT PRECEDING MATCHING SYMBOL.  MATCHING  F1D12830
       REM SYMBOL IS NOT COPIED.                                        F1D12840
       REM                                                              F1D12850
CLEQC2 SXD QCOUNT,1     SET RESUMPTION OF SCAN COUNT TO FINAL SUBSCRIPT F1D12860
       REM              IN SENTENCE COPIED OUT OF ORDER FROM OEQ        F1D12870
       LXD PCOUNT,1     SET BEGINNING OF OUT-OF-ORDER COPY LOOP COUNT   F1D12880
       REM              TO FIRST SYMBOL THIS SENTENCE                   F1D12890
CLEQC3 TXL CLEQC4,1,**  IS THIS MATCHED SYMBOL                          F1D12900
       TXI *+1,2,-1     NO, BUMP FEQ COUNT TO NEXT WORD                 F1D12910
       CLA OEQ,1        MOVE WORD FROM OEQ                              F1D12920
       STO FEQ,2        TO FEQ                                          F1D12930
       TXI CLEQC3,1,-1  BUMP OEQ COUNT TO NEXT WORD AND GO CHECK COUNT  F1D12940
CLEQC4 SXD XCOUNT,2     SAVE COUNT OF LAST SUBSCRIPT COPIED INTO FEQ    F1D12950
       LXD PCOUNT,1     SET INDICATOR THAT THIS SENTENCE HAS BEEN COPIEDF1D12960
       STZ OEQ,1        OUT OF ORDER                                    F1D12970
       REM                                                              F1D12980
       REM NORMALIZATION OF SUBSCRIPTS IN SENTENCE AND ITS ADDITIONS    F1D12990
       REM IF SUBSCRIPT IN OEQ WAS LARGER THAN THAT IN FEQ              F1D13000
       REM NORMALIZE THE SUBSCRIPTS BY ADDING THE DIFFERENCE TO THE     F1D13010
       REM WORDS ORIGINALLY IN FEQ, IE, FROM THE BEGINNING TO THE       F1D13020
       REM LAST SUBSCRIPT BEFORE THE PORTION FROM OEQ WAS ADDED.        F1D13030
       REM IF SUBSCRIPT IN FEQ WAS LARGER THAN THAT IN OEQ              F1D13040
       REM ADD THE DIFFERENCE TO THE WORDS IN THE ADDED PORTION OF      F1D13050
       REM THE SENTENCE JUST WRITTEN IN FEQ                             F1D13060
       REM                                                              F1D13070
       CLA E4           GET DIFFERENCE BETWEEN SUBSCRIPTS               F1D13080
       TZE CLEQD5       IF ZERO, NO NORMALIZATION IS NECESSARY          F1D13090
       TMI CLEQD3       IF MINUS, SUBSCRIPT IN OEQ WAS GREATER THAN FEQ F1D13100
       REM                                                              F1D13110
       REM FEQ SUBSCRIPT GREATER THAN OEQ SUBSCRIPT                     F1D13120
       LXD CLEQD4,2     START NORMALIZATION FIRST SS IN ADDED PORTION   F1D13130
       CLA XCOUNT       END NORMALIZATION LAST SS ADDED PORTION         F1D13140
       STD CLEQD4                                                       F1D13150
       TXI CLEQD3+2,2,-2                                                F1D13160
       REM                                                              F1D13170
       REM OEQ SUBSCRIPT GREATER THAN FEQ SUBSCRIPT                     F1D13180
CLEQD3 LXD ZCOUNT,2     START NORMALIZATION FIRST SS ORIGINAL PORTION   F1D13190
       TXI *+1,2,-1                                                     F1D13200
       CLA FEQ,2        GET SUBSCRIPT                                   F1D13210
       ADM E4           NORMALIZE TO SAME SCALE AS IN OTHER             F1D13220
       STA FEQ,2        PORTION OF SENTENCE                             F1D13230
CLEQD4 TXL CLEQD5,2,**  WAS THIS LAST SUBSCRIPT TO BE NORMALIZED        F1D13240
       TXI *-4,2,-2     NO, BUMP FEQ COUNT TO NEXT SUBSCRIPT            F1D13250
CLEQD5 LXD YCOUNT,2     YES, RESUME SCAN WITH SAME FIXED SYMBOL IN FEQ  F1D13260
       LXD WCOUNT,1     BUT WITH FLOATING COUNT, FIRST SYMBOL JUST      F1D13270
       CLS WCOUNT       COPIED OUT OF ORDER INTO FEQ                    F1D13280
       STO WCOUNT       SET SWITCH TO SKIP OVER PORTION OF OEQ PRECEDINGF1D13290
       TXI CLEQA3,1,-1  SENTENCE JUST COPIED OUT OF ORDER               F1D13300
       REM                                                              F1D13310
       REM TABLE IS NOW COMPLETELY PROCESSED. WE CAN NOW GO HOME.       F1D13320
CLEQF0 TXH *+3,4,-LWBF2-1     WERE THERE ANY ERRORS.                    F1D13330
       CLA FRCON        YES, ADD WORD OF ALL ONES                       F1D13340
       STO FEQ+1,4      TO END OF ERROR LIST                            F1D13350
       PXD     ,2             COMPUTE NUMBER OF WORDS IN FEQ.           F1D13360
       PDC     ,2             GET TRUE LAST ADDRESS PLUS ONE.           F1D13370
       TIX     *+1,2,LWBF2    COMPUTE WORD COUNT OF SORTED EQUIT TABLE. F1D13380
CLEQF1 CLA     L(FEQ)         UPDATE INTET ORIGIN OF EQUIT TABLE.       F1D13390
       STA     INTETI                                                   F1D13400
       PXD     ,2                                                       F1D13410
       STO     INTETI+1       SAVE WORD COUNT IN INTETI ENTRY.          F1D13420
       AXT     1,4            LOAD INDEX FOR INDIRECT ADDRESSING.       F1D13430
       STO*    INTETI         SAVE WORD COUNT AHEAD OF TABLE.           F1D13440
       SXD     EQTLOC,2       SAVE EQUIT WORD COUNT FOR ONE DOUBLE PRIMEF1D13450
       PXA     ,2             COMPUTE LAST ADDRESS PLUS ONE.            F1D13460
       ADD     L(FEQ)                                                   F1D13470
       STA     EQTLOC         SAVE LAST ADDRESS PLUS ONE .              F1D13480
       REM                                                              F1D13490
       REM                                                              F1D13500
       TSX WAT00,1     *WRITE OUT EQUIT TABLE ASSEMBLED IN FEQ ON TAPE  F1D13510
       PZE 8               AS RECORD 13 OF FILE 5.                      F1D13520
       REM                                                              F1D13530
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D13540
       REM                                                              F1D13550
       NZT     INTETJ+1       IS THERE A CLOSUB TABLE.                  F1D13560
       TRA     WRCLS         *NO, DO NOT ATTEMPT TO READ IT BACK.       F1D13570
       REM                                                              F1D13580
       TSX     (TAPE),4       READ CLOSUB FROM SCRATCH TAPE.            F1D13590
       PZE     CLSIO,,(RBNC)                                            F1D13600
       PZE     TCLOS,,EXEQTP                                            F1D13610
       REM                                                              F1D13620
WRCLS  TSX     WAT00,1        WRITE CLOSUB AS RECORD 14 OF FILE 5.      F1D13630
       PZE     9                                                        F1D13640
       TSX     (TAPE),4       REWIND SCRATCH TAPE.                      F1D13650
       PZE     REWND,,(SKBP)                                            F1D13660
       PZE     ,,EXEQTP                                                 F1D13670
       REM                                                              F1D13680
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D13690
       REM                                                              F1D13700
       AXT     0,4            INITIALIZE IR4 FOR INDIRECT ADDRESSING.   F1D13710
       STZ*    INTETP         SET FIRST LOCATION OF TSTOPS TO ZERO.     F1D13720
       REM                                                              F1D13730
       TSX     TAP00,1        ASSEMBLE TABLE OF STOP AND RETURN         F1D13740
       PZE     15             STATEMENTS (TSTOPS).                      F1D13750
       REM                                                              F1D13760
       LXD     INTETP+1,1     LOAD WORD COUNT OF TSTOPS.                F1D13770
       PXA     ,1             PLACE WORD COUNT IN AC.                   F1D13780
       ADD     INTETP         COMPUTE LAST ADDRESS PLUS ONE.            F1D13790
       STA     STPLOC         SAVE LAST ADDRESS PLUS ONE AND            F1D13800
       SXD     STPLOC,1       WORD COUNT FOR SECTION ONE DOUBLE PRIME.  F1D13810
       REM                                                              F1D13820
       STZ*    INTETO         SET FIRST WORD OF NONEXC TO ZERO.         F1D13830
       REM                                                              F1D13840
       TSX     TAP00,1        ASSEMBLE TABLE OF NON-EXECUTABLE          F1D13850
       PZE     14             STATEMENTS (NONEXC).                      F1D13860
       REM                                                              F1D13870
       LXD     INTETO+1,1     LOAD NONEXC WORD COUNT.                   F1D13880
       PXA     ,1             PLACE WORD COUNT IN AC.                   F1D13890
       ADD     INTETO         COMPUTE LAST ADDRESS PLUS ONE.            F1D13900
       STA     NXCLOC         SAVE LAST ADDRESS PLUS ONE AND            F1D13910
       SXD     NXCLOC,1       WORD COUNT FOR SECTION ONE DOUBLE PRIME.  F1D13920
       REM                                                              F1D13930
       TSX     (TAPE),4       WRITE 5TH END-OF-FILE ON TABLE TAPE.      F1D13940
       PZE     ,,(WEFP)                                                 F1D13950
       PZE     5THEOF,,TABTAP                                           F1D13960
       REM                                                              F1D13970
       LXD     EIFNO,4        LOAD LAST IFN ASSIGNED.                   F1D13980
       TXI     *+1,4,1        INCREMENT BY ONE.                         F1D13990
       PXD     ,4                                                       F1D14000
       STO     EIFNO          SAVE FOR ONE DOUBLE PRIME FLOW ANALYSIS.  F1D14010
       TSX     (LOAD),4       GO GET ONE DOUBLE PRIME.                  F1D14020
       PZE                                                              F1D14030
       REM                                                              F1D14040
       REM                                                              F1D14050
       REM *************************************************************F1D14060
       REM                                                              F1D14070
       REM     ROUTINE TO SEARCH TEIFNO FOR AN IFN THAT CORRESPONDS     F1D14080
       REM     TO AN EFN STORED IN LOCATION ERASA1.  WHEN A MATCH IS    F1D14090
       REM     FOUND, IT RETURNS TO THE CALLER WITH THE TEIFNO ENTRY    F1D14100
       REM     IN THE AC. IF NO MATCH IS FOUND, IT RETURNS WITH A       F1D14110
       REM     ZERO AC.  ZERO IS AN IMPOSSIBLE IFN, AND THEREFORE,      F1D14120
       REM     IS AN ERROR SIGNAL.                                      F1D14130
       REM                                                              F1D14140
FEIFA  AXT     **,4           LOAD TEIFNO WORD COUNT.                   F1D14150
FEIFB  CAL     **,4           GET A TEIFNO ENTRY.                       F1D14160
       ANA     ADMSK          GET ADDRESS FIELD, EFN.                   F1D14170
       SUB     ERASA1         IS IT THE REQUESTED ONE.                  F1D14180
       TZE     FEIFC         *YES.                                      F1D14190
       TIX     FEIFB,4,1     *NO.  IS TEIFNO EXHAUSTED, NO CONTINUE.    F1D14200
       ZAC                    YES. IFN DOES NOT EXIST, SET ERROR FLAG.  F1D14210
       TRA     1,1           *RETURN TO CALLER.                         F1D14220
       REM                                                              F1D14230
FEIFC  CAL     **,4           GET TEIFNO ENTRY - EFN.                   F1D14240
       TRA     1,1           *RETURN TO CALLER.                         F1D14250
       REM                                                              F1D14260
       REM *************************************************************F1D14270
       REM                                                              F1D14280
       REM                                                              F1D14290
       REM     I/O COMMANDS FOR SPECIAL READ-WRITE ROUTINES.            F1D14300
       REM                    USED TO-                                  F1D14310
IOCM1  IOCP    CITCNT,,1      WRITE COMPAIL RECORD COUNT AND            F1D14320
IOCM2  IOCT    FRSBBF,,**    SUBDEF TABLE.                             $F1D14330
       REM                                                              F1D14340
FLOCOM IOCP    FLOCNT,,1      WRITE FLOCON TABLE WORD COUNT AND         F1D14350
       IOCT    FLCNBF,,**    THE FLOCON TABLE.                         $F1D14360
       REM                                                              F1D14370
DMIO1  IOCP    EIFNO,,1       WRITE LAST IFN ASSIGNED IN PROGRAM,       F1D14380
DMIO2  IOCP    ERASA1,,1      THE SIZ TABLE WORD COUNT,                 F1D14390
DMIO3  IOCT    DIM1BF,,**    AND THE SIZ TABLE.                        $F1D14400
       REM                                                              F1D14410
CLSIO  IORT    **,,**         WRITE CLOSUB ON A SCRATCH TAPE.           F1D14420
       REM                    ALSO USED TO READ IT BACK.                F1D14430
       REM                                                              F1D14440
ENDIO  IORT    **,,6          WRITE THE END TABLE.                      F1D14450
       REM                                                              F1D14460
       REM *************************************************************F1D14470
       REM                                                              F1D14480
       REM     CONSTANTS AND ERASABLE STORAGE.                          F1D14490
       REM                                                              F1D14500
LABL1  BCI     1,FORSUB       FORSUB LABEL.                             F1D14510
LABL2  BCI     1,FLOCON       FLOCON LABEL.                             F1D14520
LABL3  BCI     1,SIZ          SIZ LABEL.                                F1D14530
TCLOS  BCI     1,TMPCLS       INTERMEDIATE CLOSUB LABEL.                F1D14540
FRTSG  PZE     ,,49           FORMAT STATEMENT ERROR FLAG.              F1D14550
EIFSG  PZE     ,,50           TEIFNO ERROR FLAG.                        F1D14560
MFRTE  PZE     ,,51           FRET ERROR FLAG, NON-EXISTENT EFN.        F1D14561
GOOFCT SYN     DGFLAG         DECREMENT HAS COUNT OF WORDS IN ERROR LISTF1D14570
FLOCNT PZE     **             FLOCON TABLE WORD COUNT.                  F1D14580
(1)L   DEC     1              CONSTANT.                                 F1D14590
(2)L   DEC     2              CONSTANT.                                 F1D14600
ERASA1 PZE     **,,0          ADDRESS ERASABLE.                         F1D14610
ADMSK  PZE     -1             ADDRESS MASK.                             F1D14620
DCMSK  PZE     ,,-1           DECREMENT MASK.                           F1D14630
2NDEOF BCI     1,2NDEOF       END-OF-FILE LABEL.                        F1D14640
3RDEOF BCI     1,3RDEOF       DITTO.                                    F1D14650
4THEOF BCI     1,4THEOF       DITTO.                                    F1D14660
5THEOF BCI     1,5THEOF       DITTO.                                    F1D14670
       REM                                                              F1D14680
       REM * . * . * . * . * . * . * . * . * . * . * . * . * . * . * . *F1D14690
       REM                                                              F1D14700
       REM               THE FOLLOWING ARE USED BY THE                  F1D14710
       REM               EQUIVALENCE PROCESSOR.                         F1D14720
       REM                                                              F1D14730
FRCON  PTH     -1,7,-1        EQUIVALENCE ERROR FLAG.                   F1D14740
L(FEQ) PZE     LWBF2          ORIGIN OF FINAL EQUIVALENCE TABLE.        F1D14750
FEQ    SYN     0              SAME.                                     F1D14760
L(OEQ) PZE     LWBF1          LOCATION OF ORIGINAL EQUIT TABLE.         F1D14770
OEQ    SYN     0              ORIGIN OF ASSEMBLED EQUIVALENCE TABLE.    F1D14780
E4     PZE                                                              F1D14790
PCOUNT PZE ,,-LWBF1     (LOC OF FIRST SYMBOL OEQ SENTENCE BEING SCANNED)F1D14800
QCOUNT PZE ,,-LWBF1     (LOC FINAL SUBSCRIPT OF SENTENCE COPIED OUT OF  F1D14810
       REM              ORDER FROM OEQ)                                 F1D14820
WCOUNT PZE ,,-LWBF2     (LOC OF LAST SUBSCRIPT COPIED INTO FEQ BEFORE   F1D14830
       REM              THIS PORTION OF SENTENCE WAS ADDED OUT OF ORDER)F1D14840
       REM              (IF SWITCH IS - A PORTION OF OEQ WAS SCANNED    F1D14850
       REM              BEFORE THIS PORTION OF SENTENCE WAS ADDED. SKIP F1D14860
       REM              THIS PORTION OF OEQ WHEN RESUMING SCAN)         F1D14870
YCOUNT PZE ,,-LWBF2     (LOC FIXED SYMBOL IN FEQ SCANNED FOR MATCH)     F1D14880
ZCOUNT PZE ,,-LWBF2     (LOC OF FIRST SYMBOL IN FEQ SET BEING SCANNED)  F1D14890
       REM                                                              F1D14900
       REM *************************************************************F1D14910
       REM                                                              F1D14920
       SYN     *         BEGINNING OF -                                 F1D14930
       REM               SECTION ONE PRIME PATCHING SPACE.              F1D14940
ENDF13 BES     200       END OF -                                       F1D14950
       REM                                                              F1D14960
       REM *************************************************************F1D14970
       TCD     -1                                                      $F1D14980
       TTL * SECTION ONE DOUBLE PRIME * RECORD 9F17 *                   F1E00000
       REM                                                              F1E00070
       REM     SECTION ONE DOUBLE PRIME SCANS VARIOUS TABLES            F1E00080
       REM     COMPRISING THE FIFTH FILE OF THE TABLE TAPE.             F1E00090
       REM     IT DOES NOT ADD ANY NEW INFORMATION TO WHAT              F1E00100
       REM     ALREADY EXISTS.  ITS ONLY TASK IS TO FIND                F1E00110
       REM     SOURCE PROGRAM ERRORS.                                   F1E00120
       REM                                                              F1E00130
       REM *************************************************************F1E00140
       REM                                                              F1E00150
       REM     **** DEFINITIONS AND PARAMETERS ****                     F1E00160
       REM                                                              F1E00170
       REM                                                              F1E00180
PEIFNO SYN     EIFNO          DEFINE EIFNO FOR HEADED BLOCK.            F1E00190
       HEAD    P              HEAD SECTION ONE DOUBLE PRIME WITH P.     F1E00200
LIST   SYN     BOTIOP-1       ORIGIN OF ERROR LIST FOR GENERAL DIAG.    F1E00210
       REM                                                              F1E00220
       EJECT                                                            F1E00490
       REM                                                              F1E00500
       LBL     9F17,THE WORKS                                           F1E00510
       REM                                                              F1E00520
       REM                                                              F1E00540
       ORG     SYSCUR                                                  $F1E00550
       BCI     1,9F1700                                                $F1E00560
       REM                                                              F1E00570
       ORG     (LODR)                                                  $F1E00580
       TXI     BEGF14,,170             ENTRY POINT,,RECORD NUMBER       F1E00590
       REM                                                              F1E00600
       ABS                                                              F1E00610
       ORG     BOTMEM+15                                                F1E00620
       REM                                                              F1E00630
SOURCE TXI     (DIAG),,-1     SOURCE PROGRAM ERROR, GET DIAGNOSTIC.     F1E00640
       PZE     LIST,,**       LOCATION OF ERROR LIST,,WORD COUNT.       F1E00650
       REM                                                              F1E00660
1DPER0 TXI     (DIAG),,0     *MACHINE ERROR.  GO TO DIAGNOSTIC          F1E00670
       REM                    FAILURE OF TIX INSTRUCTION TO TRANSFER.   F1E00680
       REM                    INDEX SHOULD REDUCE BY ONE TO POSITION    F1E00690
       REM                    AT SECOND WORD OF A TWO WORD TIFGO ENTRY. F1E00700
       REM                                                              F1E00710
1DPER1 TXI     (DIAG),,0     *MACHINE ERROR.  GO TO DIAGNOSTIC.         F1E00720
       REM                    SIMILAR CONDITION TO 1DPER0.  HOWEVER,    F1E00730
       REM                    INSTRUCTION IS A TNX WHICH SHOULD NOT     F1E00740
       REM                    HAVE TRANSFERRED, BUT IT DID.             F1E00750
       REM                                                              F1E00760
       REM *************************************************************F1E00770
       REM                                                              F1E00780
BEGF14 RIR     777777                                                   F1E00790
       TSX     (TAPE),4       POSITION TAPE AT FORVAL FOR SECTION TWO.  F1E00800
       PZE     BKSPX,,(SKBP)                                            F1E00801
       PZE     FORVL,,TABTAP                                            F1E00802
       REM                                                              F1E00810
       LXD     NXCLOC,4       LOAD WORD COUNT OF NONEXC TABLE.          F1E00820
       SXA     SRNXA,4                                                  F1E00830
       TXL     STPPA,4,0     *NO TABLE, EXIT.                           F1E00840
       REM                                                              F1E00850
       CAL     NXCLOC         INITIALIZE LAST ADDRESS PLUS ONE.         F1E00860
       STA     NXCPA                                                    F1E00870
       STA     NXCPB                                                    F1E00880
       STA     SRNXB          SET NONEXC SEARCH ROUTINE.                F1E00890
NXCPA  CAL     **,4           MOVE IFNS FROM DECREMENT                  F1E00900
       PDX     ,1             FIELD TO ADDRESS FIELD.                   F1E00910
       PXA     ,1                                                       F1E00920
NXCPB  SLW     **,4           STORE BACK IN TABLE.                      F1E00930
       TIX     NXCPA,4,1     *IS TABLE EXHAUSTED, NO CONTINUE.          F1E00940
       REM                                                              F1E00950
       REM *************************************************************F1E00960
       REM                                                              F1E00970
STPPA  LXD     STPLOC,4       LOAD WORD COUNT OF TSTOPS TABLE.          F1E00980
       CLA     STPLOC         GET BASE ADDRESS OF TSTOPS.               F1E00990
       STA     TIFD                                                     F1E01000
       STA     FLOWB                                                    F1E01010
       TXL     EQITA,4,0     *NO TABLE, EXIT.                           F1E01020
       REM                                                              F1E01030
       STA     STPPB          SET LAST ADDRESS OF TSTOPS PLUS ONE       F1E01040
       STA     STPPC          IN VARIOUS ROUTINES.                      F1E01050
       REM                                                              F1E01060
STPPB  CAL     **,4           MOVE IFNS FROM DECREMENT                  F1E01070
       PDX     ,2             FIELD TO ADDRESS FIELD.                   F1E01080
       PXA     ,2                                                       F1E01090
STPPC  SLW     **,4           STORE BACK IN TABLE.                      F1E01100
       TIX     STPPB,4,1     *IS TABLE EXHAUSTED, NO CONTINUE.          F1E01110
       REM                                                              F1E01120
       REM *************************************************************F1E01130
       REM                                                              F1E01140
       REM               EQUIVALENCE STATEMENT ERROR ROUTINE.           F1E01150
       REM                                                              F1E01160
EQITA  LXD     EQTLOC,2       LOAD EQUIVALENCE WORD COUNT.              F1E01170
       TXL     TIFGO,2,0     *NO TABLE, EXIT.                           F1E01180
       CLS     ALL1S          SOME TABLE,                               F1E01190
       ERA*    EQTLOC         IS THE FIRST WORD AN ERROR FLAG.          F1E01200
       TNZ     TIFGO         *NO, TABLE IS ALL RIGHT.                   F1E01210
       TXI     EQITC,2,-1     YES, ALL ENTRIES ARE ERRORS.              F1E01220
EQITB  CLS     ALL1S          LOAD TERMINAL FLAG.                       F1E01230
       ERA*    EQTLOC         IS THIS ENTRY DIE ENDEN FLAG.             F1E01240
       TZE     TIFGO         *YES, ALL DONE.                            F1E01250
EQITC  LDQ*    EQTLOC         LOAD MQ WITH VARIABLE NAME.               F1E01260
       TSX     ERROR,4        GO TO ERROR ENTRY SUBROUTINE.             F1E01270
       OCT     1234           ERROR FLAG.                               F1E01280
       TIX     EQITB,2,1     *IS TABLE EXHAUSTED, NO CONTINUE.          F1E01290
       REM                                                              F1E01300
       REM *************************************************************F1E01310
       REM                                                              F1E01320
       REM               ROUTINE TO PROCESS TIFGO.                      F1E01330
       REM               CHECKS FOR THE EXISTENCE OF THE BETAS          F1E01340
       REM               AND THAT THE BETAS ARE EXECUTABLE.             F1E01350
       REM                                                              F1E01360
TIFGO  LXD     TIFLOC,2       LOAD TIFGO WORD COUNT.                    F1E01370
       TXL     FLOWA,2,0     *NO TABLE, EXIT.                           F1E01380
       LXD     TRDLOC,4       INITIALIZE TRAD ADDRESS                   F1E01390
       SXA     ERASA,4        IN COMPUTED AND ASSIGNED                  F1E01400
       CAL     TRDLOC         GO TO ROUTINES.                           F1E01410
       SUB     ERASA                                                    F1E01420
       ADD     TRADL          ADD MAXIMUM LENGTH OF TRAD TABLE.         F1E01430
       STA     TIF1B          INITIALIZE TO LAST TRAD ADDRESS.          F1E01440
       STA     TIF2B          (TRAD+TRADMX)                             F1E01450
       REM                                                              F1E01460
TIFA   CLA*    TIFLOC         GET FIRST WORD OF A TIFGO ENTRY.          F1E01470
       PDX     ,4             MOVE THE ALPHA TO THE ADDRESS             F1E01480
       SXA     ALPHA,4        FIELD AND SAVE IT.                        F1E01490
       REM                                                              F1E01500
       REM                    BRANCH TO PROPER SUBROUTINE TO PROCESS.   F1E01510
       TMI     TIFMA         *MINUS TYPE - ARITMETIC IF.                F1E01520
       PAX     ,1             PLACE TYPE NUMBER IN INDEX.               F1E01530
       TXL     TIFB,1,6      *IS IT LEGITIMATE, YES.                    F1E01540
       LDQ*    TIFLOC         NO, IS UNKNOWN TYPE.                      F1E01550
       TSX     ERROR,4        GO TO ERROR ENTRY SUBROUTINE.             F1E01560
       OCT     471                                                      F1E01570
       TRA     TIFC           CONTINUE WITH NEXT ENTRY.                 F1E01580
TIFB   XEC     TIFTR,1        BRANCH ON TYPE NUMBER.                    F1E01590
       TSX     1DPER0,4      *TIX DID NOT TIX, MACHINE ERROR.           F1E01600
       REM                                                              F1E01610
       TIX     TIF6A,2,1      TYPE 6 - ASSIGN.                          F1E01620
       TIX     TIF5A,2,1      TYPE 5 - AC/MQ OVERFLOW IF.               F1E01630
       TIX     TIF4A,2,1      TYPE 4 - DIVIDE CHECK IF.                 F1E01640
       TIX     TIF3A,2,1      TYPE 3 - SENSE LIGHT/SWITCH IF.           F1E01650
       TIX     TIF2A,2,1      TYPE 2 - COMPUTED GO TO.                  F1E01660
       TIX     TIF1A,2,1      TYPE 1 - ASSIGNED GO TO.                  F1E01670
TIFTR  TIX     TIF0A,2,1      TYPE 0 - JUST PLAIN GO TO ....            F1E01680
       REM                                                              F1E01690
       REM                                                              F1E01700
TIFC   LXD     STPLOC,4       LOAD TSTOPS WORD COUNT.                   F1E01710
       TXI     *+1,4,1        INCREMENT COUNT AND                       F1E01720
       SXD     STPLOC,4       SAVE.                                     F1E01730
       CLA     ALPHA          ENTER THIS ALPHA IN TSTOPS (ALPHA) TABLE  F1E01740
TIFD   STO     **,4           FOR FLOW ANALYSIS.                        F1E01750
TIFE   TIX     TIFA,2,1      *IS TIFGO EXHAUSTED, NO CONTINUE.          F1E01760
       REM                                                              F1E01770
       TRA     FLOWA          YES, GO TO FLOW ANAYSIS.                  F1E01790
       REM                                                              F1E01800
       REM     . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E01810
       REM                                                              F1E01820
       REM                    IF (E) BETA1, BETA2, BETA3                F1E01830
       REM                                                              F1E01840
       REM                    -ALPHA,,BETA1                             F1E01850
       REM                     BETA2,,BETA3                             F1E01860
       REM                                                              F1E01870
TIFMA  ANA     ADMSK          GET BETA1.                                F1E01880
       TNZ     TIFMB         *DOES IT EXIST, YES.                       F1E01890
       TSX     NOBETA,4       NO, SAVE FOR DIAGNOSTIC.                  F1E01900
       OCT     506            ERROR FLAG.                               F1E01910
       TRA     TIFMC         *CONTINUE WITH BETA2.                      F1E01920
TIFMB  TSX     SRNONX,4       SEARCH FOR BETA1 IN THE NONEXC TABLE.     F1E01930
       OCT     510            ERROR FLAG.                               F1E01940
       REM                                                              F1E01950
TIFMC  TNX     1DPERA,2,1     REDUCE TIFGO INDEX TO GET SECOND WORD.    F1E01960
       CAL*    TIFLOC         GET SECOND WORD OF TIFGO ENTRY.           F1E01970
       PDX     ,4             MOVE BETA2 TO ADDRESS FIELD.              F1E01980
       PXA     ,4                                                       F1E01990
       TNZ     TIFMD         *DOES IT EXIST, YES.                       F1E02000
       TSX     NOBETA,4       NO, GO DIAGNOSTIC SUBROUTINE.             F1E02010
       OCT     517            ERROR FLAG.                               F1E02020
       TRA     TIFME         *CONTINUE WITH BETA3.                      F1E02030
TIFMD  TSX     SRNONX,4       SEARCH FOR BETA2 IN THE NONEXC TABLE.     F1E02040
       OCT     521            ERROR FLAG.                               F1E02050
       REM                                                              F1E02060
TIFME  CAL*    TIFLOC         GET SECOND WORD OF TIFGO ENTRY.           F1E02070
       ANA     ADMSK          GET BETA3.                                F1E02080
       TNZ     TIFMF         *DOES IT EXIST, YES.                       F1E02090
       TSX     NOBETA,4       NO, GO TO DIAGNOSTIC SUBROUTINE.          F1E02100
       OCT     527            ERROR FLAG.                               F1E02110
       TRA     TIFMG         *GO TO SET BRANCH COUNT.                   F1E02120
TIFMF  TSX     SRNONX,4       SEACH FOR BETA3 IN THE NONEXC TABLE.      F1E02130
       OCT     531            ERROR FLAG.                               F1E02140
       REM                                                              F1E02150
TIFMG  AXT     3,1            SET NUMBER OF BRANCHES FOR THIS           F1E02160
       SXD     ALPHA,1        TYPE OF TIFGO.                            F1E02170
       TRA     TIFC          *RETURN TO MAIN ROUTINE.                   F1E02180
       REM                                                              F1E02190
1DPERA TSX     1DPER1,4      *MACHINE ERROR.                            F1E02200
       REM                                                              F1E02210
       REM     . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E02220
       REM                                                              F1E02230
       REM                    GO TO BETA                                F1E02240
       REM                                                              F1E02250
       REM                    ALPHA,,ZERO                               F1E02260
       REM                         ,,BETA                               F1E02270
       REM                                                              F1E02280
TIF0A  CAL*    TIFLOC         GET SECOND WORD OF THIS TIFGO ENTRY.      F1E02290
       PAX     ,4             PLACE BETA IN AN INDEX REGISTER.          F1E02300
       TXH     TIF0B,4,0     *DOES BETA EXIST, YES.                     F1E02310
       TSX     NOBETA,4       NO, GO TO DIAGNOSTIC SUBROUTINE.          F1E02320
       OCT     547            ERROR FLAG.                               F1E02330
       TRA     TIF0C         *SET NUMBER OF BRANCHES.                   F1E02340
TIF0B  PXA     ,4             PLACE BETA IN THE AC.                     F1E02350
       TSX     SRNONX,4       SEARCH FOR BETA IN THE NONEXC TABLE.      F1E02360
       OCT     551            ERROR FLAG.                               F1E02370
TIF0C  AXT     1,1            SET NUMBER OF BRANCHES FOR THIS           F1E02380
       SXD     ALPHA,1        TYPE OF TIFGO.                            F1E02390
       TRA     TIFC          *RETURN TO MAIN ROUTINE.                   F1E02400
       REM                                                              F1E02410
       REM     . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E02420
       REM                                                              F1E02430
       REM                    GO TO N,(BETA1,BETA2,....,BETAX)          F1E02440
       REM                                                              F1E02450
       REM                    ALPHA,,ONE                                F1E02460
       REM                    TRADI,,TRADU                              F1E02470
       REM                                                              F1E02480
TIF1A  SLF                    MAKE SURE NON-EXECUTABLE FLAG IS OFF.     F1E02490
       SIR     1              SET FLAG TO PREVENT ENTRY IN BETA TABLE.  F1E02500
       ZSD     ALPHA          SET BRANCH COUNT TO ZERO.                 F1E02510
       CAL*    TIFLOC         GET SECOND WORD OF TIFGO ENTRY.           F1E02520
       PAX     ,4             GET LAST TRAD REFERENCE AND               F1E02530
       SXD     TIF1E,4        SET END OF ENTRY TEST.                    F1E02540
       PDX     ,1             LOAD FIRST TRAD REFERENCE.                F1E02550
TIF1B  CAL     **,1           GET A TRAD ENTRY.                         F1E02560
TRA1   TRA     PATC1         GO TO PATCH.                              $F1E02570
       TSX     NOBETA,4       NO, GO TO DIAGNOSTIC SUBROUTINE.          F1E02580
       OCT     571            ERROR FLAG.                               F1E02590
       TRA     TIF1D         *UPDATE BRANCH COUNT ANYHOW.               F1E02600
TIF1C  TSX     SRNONX,4       SEARCH FOR THIS BETA IN THE NONEXC TABLE. F1E02610
       OCT     573            ERROR FLAG.                               F1E02620
TIF1D  CLA     ALPHA          GET ALPHA AND                             F1E02630
       ADD     L(D1)          UPDATE THE                                F1E02640
       STO     ALPHA          BRANCH COUNT.                             F1E02650
       SLT     4              WAS BETA EXECUTABLE.                      F1E02660
       TRA     *+2           *YES.                                      F1E02670
       STD*    TIF1B          NO, CLOBBER THIS TRAD ENTRY.              F1E02680
       TXI     *+1,1,-1       UPDATE TRAD INDEX.                        F1E02690
TIF1E  TXH     TIF1B,1,**    *HAVE ALL BETAS BEEN CHECKED, NO CONTINUE. F1E02700
       RIR     1              YES, RESET BETA TABLE FLAG.               F1E02710
       TRA     TIFC          *RETURN TO MAIN ROUTINE.                   F1E02720
       REM                                                              F1E02730
       REM     . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E02740
       REM                                                              F1E02750
       REM                    GO TO (BETA1,BETA2,....,BETAX), N         F1E02760
       REM                                                              F1E02770
       REM                    ALPHA,,TWO                                F1E02780
       REM                    TRADI,,TRADU                              F1E02790
       REM                                                              F1E02800
TIF2A  SLF                    MAKE SURE NON-EXECUTABLE FLAG IS OFF.     F1E02810
       SIR     1              SET FLAG TO PREVENT ENTRY IN BETA TABLE.  F1E02820
       SXD     ALPHA,0        SET BRANCH COUNT TO ZERO.                 F1E02830
       CAL*    TIFLOC         GET SECOND WORD OF TIFGO ENTRY.           F1E02840
       PAX     ,4             GET LAST TRAD REFERENCE AND               F1E02850
       SXD     TIF2E,4        SET END OF ENTRY TEST.                    F1E02860
       PDX     ,1             LOAD FIRST TRAD REFERENCE.                F1E02870
TIF2B  CAL     **,1           GET A TRAD REFERENCE.                     F1E02880
TRA2   TRA     PATC2         GO TO PATCH.                              $F1E02890
       TSX     NOBETA,4       NO, GO TO DIAGNOSTIC SUBROUTINE.          F1E02900
       OCT     622            ERROR FLAG.                               F1E02910
       TRA     TIF2D         *UPDATE BRANCH COUNT ANYHOW.               F1E02920
TIF2C  TSX     SRNONX,4       SEARCH FOR BETA IN THE NONEXC TABLE.      F1E02930
       OCT     624            ERROR FLAG.                               F1E02940
TIF2D  CLA     ALPHA          GET ALPHA AND                             F1E02950
       ADD     L(D1)          UPDATE THE                                F1E02960
       STO     ALPHA          BRANCH COUNT.                             F1E02970
       SLT     4              WAS BETA EXECUTABLE.                      F1E02980
       TRA     *+2           *YES.                                      F1E02990
       STD*    TIF2B          NO, CLOBBER THIS TRAD ENTRY.              F1E03000
       TXI     *+1,1,-1       UPDATE TRAD INDEX.                        F1E03010
TIF2E  TXH     TIF2B,1,**    *HAVE ALL BETAS BEEN CHECKED, NO CONTINUE. F1E03020
       RIR     1              YES, RESET BETA TABLE FLAG.               F1E03030
       TRA     TIFC          *RETURN TO MAIN ROUTINE.                   F1E03040
       REM                                                              F1E03050
       REM     . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E03060
       REM                                                              F1E03070
       REM                    IF (SENSE SWITCH/LIGHT I) BETA1, BETA2    F1E03080
       REM                                                              F1E03090
       REM                    ALPHA,,THREE                              F1E03100
       REM                    BETA1,,BETA2                              F1E03110
       REM                                                              F1E03120
TIF3A  CAL*    TIFLOC         GET SECOND WORD OF TIFGO ENTRY.           F1E03130
       PDX     ,4             MOVE BETA1 FROM DECREMENT                 F1E03140
       PXA     ,4             FIELD TO ADDRESS FIELD.                   F1E03150
       TNZ     TIF3B         *DOES BETA1 EXIST, YES.                    F1E03160
       TSX     NOBETA,4       NO, GO TO DIAGNOSTIC SUBROUTINE.          F1E03170
       OCT     647            ERROR FLAG.                               F1E03180
       TRA     TIF3C         *CONTINUE WITH BETA2.                      F1E03190
TIF3B  TSX     SRNONX,4       SEARCH FOR BETA1 IN THE NONEXC TABLE.     F1E03200
       OCT     651            ERROR FLAG.                               F1E03210
TIF3C  CAL*    TIFLOC         GET SECOND WORD OF TIFGO ENTRY AGAIN.     F1E03220
       ANA     ADMSK          GET BETA2.                                F1E03230
       TNZ     TIF3D         *DOES BETA2 EXIST, YES.                    F1E03240
       TSX     NOBETA,4       NO, GO TO DIAGNOSTIC SUBROUTINE.          F1E03250
       OCT     657            ERROR FLAG.                               F1E03260
       TRA     TIF3E         *CONTINUE WITH BRANCH COUNT.               F1E03270
TIF3D  TSX     SRNONX,4       SEARCH FOR BETA2 IN THE NONEXC TABLE.     F1E03280
       OCT     661            ERROR FLAG.                               F1E03290
TIF3E  AXT     2,1            SET BRANCH COUNT FOR THIS                 F1E03300
       SXD     ALPHA,1        TYPE OF TIFGO.                            F1E03310
       TRA     TIFC          *RETURN TO MAIN ROUTINE.                   F1E03320
       REM                                                              F1E03330
       REM     . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E03340
       REM                                                              F1E03350
       REM                    IF DIVIDE CHECK  BETA1, BETA2             F1E03360
       REM                                                              F1E03370
       REM                    ALPHA,,FOUR                               F1E03380
       REM                    BETA1,,BETA2                              F1E03390
       REM                                                              F1E03400
TIF4A  CAL*    TIFLOC         GET SECOND WORD OF THIS TIFGO ENTRY.      F1E03410
       PDX     ,4             MOVE BETA1 FROM DECREMENT                 F1E03420
       PXA     ,4             FIELD TO ADDRESS FIELD.                   F1E03430
       TNZ     TIF4B         *DOES BETA1 EXIST, YES.                    F1E03440
       TSX     NOBETA,4       NO, GO TO DIAGNOSTIC SUBROUTINE.          F1E03450
       OCT     676            ERROR FLAG.                               F1E03460
       TRA     TIF4C         *CONTINUE WITH BETA2.                      F1E03470
TIF4B  TSX     SRNONX,4       SEARCH FOR BETA1 IN THE NONEXC TABLE.     F1E03480
       OCT     700            ERROR FLAG.                               F1E03490
TIF4C  CAL*    TIFLOC         GET SECOND WORD OF TIFGO ENTRY AGAIN.     F1E03500
       ANA     ADMSK          GET BETA2.                                F1E03510
       TNZ     TIF4D         *DOES BETA2 EXIST, YES.                    F1E03520
       TSX     NOBETA,4       NO, GO TO DIAGNOSTIC SUBROUTINE.          F1E03530
       OCT     706            ERROR FLAG.                               F1E03540
       TRA     TIF4E         *CONTINUE WITH BRANCH COUNT.               F1E03550
TIF4D  TSX     SRNONX,4       SEARCH FOR BETA2 IN THE NONEXC TABLE.     F1E03560
       OCT     710            ERROR FLAG                                F1E03570
TIF4E  AXT     2,1            SET BRANCH COUNT                          F1E03580
       SXD     ALPHA,1        FOR THIS TYPE OF TIFGO.                   F1E03590
       TRA     TIFC          *RETURN TO MAIN ROUTINE.                   F1E03600
       REM                                                              F1E03610
       REM     . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E03620
       REM                                                              F1E03630
       REM                    IF (AC/MQ) OVERFLOW  BETA1, BETA2         F1E03640
       REM                                                              F1E03650
       REM                    ALPHA,,FIVE                               F1E03660
       REM                    BETA1,,BETA2                              F1E03670
       REM                                                              F1E03680
TIF5A  LXD     STPLOC,4       LOAD TSTOPS (ALPHA) TABLE WORD COUNT.     F1E03690
       TXI     *+1,4,1        INCREMENT WORD COUNT.                     F1E03700
       SXD     STPLOC,4       SAVE COUNT.                               F1E03710
       LXA     ALPHA,1        GET THE SECTION I DUMMY ALPHA             F1E03720
       TXI     *+1,1,-1       AND REDUCE TO TRUE ALPHA FOR              F1E03730
       PXA     ,1             TDO SCAN AND FLOW ANALYSIS.               F1E03740
       ADD     L(D2)          SET BRANCH COUNT.                         F1E03750
       STO*    TIFD           STORE IN TSTOPS (ALPHA) TABLE.            F1E03760
       LXA     SRNXC,1        LOAD BETA TABLE WORD COUNT.               F1E03770
       LXA     ALPHA,4        GET THE SECONDARY ALPHA                   F1E03780
       PXA     ,4             AND STORE                                 F1E03790
       STO*    SRNXD          IT IN THE BETA TABLE FOR FLOW ANALYSIS.   F1E03800
       TXI     *+1,1,-1       INCREMENT BETA TABLE WORD COUNT.          F1E03810
       SXA     SRNXC,1        SAVE BETA TABLE WORD COUNT.               F1E03820
       CAL*    TIFLOC         GET SECOND WORD OF TIFGO ENTRY.           F1E03830
       PDX     ,4             MOVE BETA1 FROM THE DECREMENT             F1E03840
       PXA     ,4             FIELD TO THE ADDRESS FIELD.               F1E03850
       TNZ     TIF5B         *DOES BETA1 EXIST, YES.                    F1E03860
       TSX     NOBETA,4       NO, GO TO DIAGNOSTIC SUBROUTINE.          F1E03870
       OCT     736            ERROR FLAG.                               F1E03880
       TRA     TIF5C         *CONTINUE WITH BETA2.                      F1E03890
TIF5B  TSX     SRNONX,4       SEARCH FOR BETA1 IN THE NONEXC TABLE.     F1E03900
       OCT     740            ERROR FLAG.                               F1E03910
TIF5C  CAL*    TIFLOC         GET SECOND WORD OF THIS TIFGO ENTRY AGAIN.F1E03920
       ANA     ADMSK          GET BETA2.                                F1E03930
       TNZ     TIF5D         *DOES BETA2 EXIST, YES.                    F1E03940
       TSX     NOBETA,4       NO, GO TO DIAGNOSTIC SUBROUTINE.          F1E03950
       OCT     746            ERROR FLAG.                               F1E03960
       TRA     TIF5E         *CONTINUE WITH BRANCH COUNT.               F1E03970
TIF5D  TSX     SRNONX,4       SEARCH FOR BETA2 IN THE NONEXC TABLE.     F1E03980
       OCT     750            ERROR FLAG.                               F1E03990
TIF5E  AXT     2,1            SET BRANCH COUNT FOR                      F1E04000
       SXD     ALPHA,1        THIS TYPE OF TIFGO ENTRY.                 F1E04010
       TRA     TIFC          *RETURN TO MAIN ROUTINE.                   F1E04020
       REM                                                              F1E04030
       REM     . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E04040
       REM                                                              F1E04050
       REM                    ASSIGN BETA TO N                          F1E04060
       REM                                                              F1E04070
       REM                    ALPHA,,SIX                                F1E04080
       REM                    ZERO ,,BETA                               F1E04090
       REM                                                              F1E04100
TIF6A  CAL*    TIFLOC         GET SECOND WORD OF TIFGO ENTRY.           F1E04110
       ANA     ADMSK          ELIMINATE THE POSSIBILITY OF HASH.        F1E04120
       TNZ     TIF6B         *DOES BETA EXIST, YES.                     F1E04130
       TSX     NOBETA,4       NO, GO TO DIAGNOSTIC SUBROUTINE.          F1E04140
       OCT     764            ERROR FLAG.                               F1E04150
       TRA     TIFE          *RETURN TO MAIN ROUTINE.                   F1E04160
TIF6B  SIR     1              SET FLAG TO PREVENT ENTRY IN BETA TABLE.  F1E04170
       TSX     SRNONX,4       SEARCH FOR BETA IN THE NONEXC TABLE.      F1E04180
       OCT     765            ERROR FLAG.                               F1E04190
       RIR     1              RESET BETA TABLE FLAG.                    F1E04200
       TRA     TIFE          *RETURN TO MAIN ROUTINE.                   F1E04210
       REM                                                              F1E04220
       REM     . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E04230
       REM                                                              F1E04240
       REM               ROUTINE TO SEARCH FOR BETA IN THE NONEXC       F1E04250
       REM               TABLE AND TO MAKE ENTRIES IN THE BETA TABLE.   F1E04260
       REM                                                              F1E04270
SRNONX SLF                    RESET NOT-EXECUTABLE FLAG.                F1E04280
       SXA     SRNXE,1        SAVE INDEX REGISTER.                      F1E04290
SRNXA  AXT     **,1           LOAD WORD COUNT OF NONEXC TABLE.          F1E04300
SRNXB  LAS     **,1           COMPARE BETA TO A NONEXC ENTRY.           F1E04310
       TRA     *+2            DOES NOT COMPARE.                         F1E04320
       TRA     SRNXF         *COMPARES, PROGRAMMER ERROR.               F1E04330
       TIX     SRNXB,1,1     *DOES NOT COMPARE, TABLE EXHAUSTED, NO.    F1E04340
       RFT     1              YES, SHOULD BETA BE ENTERED IN BETA TABLE.F1E04350
       TRA     SRNXE         *NO.                                       F1E04360
SRNXC  AXT     **,1           YES, LOAD CURRENT BETA TABLE WORD COUNT.  F1E04370
SRNXD  STO     BETA,1         STORE THIS BETA.                          F1E04380
       TXI     *+1,1,-1       INCREMENT COUNT.                          F1E04390
       SXA     SRNXC,1        SAVE BETA WORD COUNT.                     F1E04400
SRNXE  AXT     **,1           RESTORE INDEX REGISTER.                   F1E04410
       TRA     2,4           *RETURN TO CALLER.                         F1E04420
       REM                                                              F1E04430
SRNXF  LXD     GOOFCT,1       LOAD ERROR LIST WORD COUNT.               F1E04440
       ALS     18             SHIFT BETA TO DECREMENT FIELD.            F1E04450
       SLW     ELSEBF-1,1     STORE IN ERROR LIST.                      F1E04460
       CLA     ALPHA          GET THE ALPHA OF THIS STATEMENT.          F1E04470
       STA     ELSEBF-1,1     SAVE IT WITH BETA.                        F1E04480
       CAL     1,4            GET ERROR FLAG.                           F1E04490
       ORA     NXFLG          ADD THE NON-EXECUTABLE FLAG.              F1E04500
       SLW     ELSEBF,1       STORE IN ERROR LIST.                      F1E04510
       TXI     *+1,1,2        UPDATE WORD COUNT.                        F1E04520
       SXD     GOOFCT,1       STORE NEW COUNT.                          F1E04530
       SLN     4              TURN ON NON-EXECUTABLE LITE.              F1E04540
       TRA     SRNXE         *RETURN TO CALLER VIA INDEX RESTORE.       F1E04550
       REM                                                              F1E04560
       REM *************************************************************F1E04570
       REM                                                              F1E04580
       REM               FLOW ANALYSIS ROUTINE.                         F1E04590
       REM               PERFORMS A FLOW ANALYSIS OF THE PROGRAM        F1E04600
       REM               BASED ON THE INFORMATION CONTAINED IN THE      F1E04610
       REM               TSTOPS (ALPHA) TABLE AND THE NONEXC AND        F1E04620
       REM               BETA TABLES.                                   F1E04630
       REM                                                              F1E04640
FLOWA  LXD     STPLOC,1       LOAD TSTOPS WORD COUNT.                   F1E04650
       TXL     TDOA,1,0      *EXIT, NO TABLE.                           F1E04670
       LXD     EIFNO,4        GET LAST IFN-PLUS-ONE AND                 F1E04680
       PXA     ,4             ENTER IT IN THE BETA TABLE                F1E04690
       TSX     SRNXC,4        SO THAT THERE WILL BE A PATCH OF          F1E04700
       NOP                    FLOW TO THE IMAGINARY LAST STATEMENT+1.   F1E04710
       CLA     TRDLOC         INITIALIZE LAST ADDRESS PLUS ONE OF TRAD. F1E04720
       STA     FLOW3                                                    F1E04730
       LAC     SRNXC,4        GET TRUE WORD COUNT OF THE                F1E04740
       PXA     ,4             BETA TABLE AND COMPUTE THE                F1E04750
       ADD     OBETA          LAST ADDRESS PLUS ONE.                    F1E04760
       STA     FLOWD          INITIALIZE THE BETA SEARCH                F1E04770
       SXA     FLOWC,4        ROUTINE.                                  F1E04780
       LXA     NXCLOC,4       INITIALIZE THE NONEXC SEARCH              F1E04790
       SXA     FLOWF,4        ROUTINE WITH THE LAST ADDRESS PLUS ONE    F1E04800
       LXD     NXCLOC,4       AND WORD COUNT.                           F1E04810
       SXA     FLOWE,4                                                  F1E04820
       REM                                                              F1E04830
       REM                                                              F1E04840
       LXD     STPLOC,1       LOAD WORD COUNT OF TSTOPS (ALPHA) TABLE.  F1E04850
FLOWB  CAL     **,1           GET AN ALPHA (AN ALPHA IS THE END OF      F1E04860
       ANA     ADMSK          A PATH OF FLOW).  EXTRACT ALPHA.          F1E04870
FLOW1  ADD     L(A1)          FORM IFN OF ALPHA+N (MUST BE A TRA TO IT).F1E04880
       REM                                                              F1E04890
FLOWC  AXT     **,2           LOAD BETA TABLE WORD COUNT.               F1E04900
       TXL     FLOW2,2,0     *EXIT, NO TABLE.                           F1E04910
FLOWD  LAS     **,2           DOES A BETA TRANSFER TO ALPHA+N.          F1E04920
       TRA     *+2            NO.                                       F1E04930
       TRA     FLOWG         *YES, IS ALL RIGHT.                        F1E04940
       TIX     FLOWD,2,1     *NO, IS BETA EXHAUSTED, NO CONTINUE.       F1E04950
       REM                                                              F1E04960
FLOW2  LXD     TRDLOC,2       YES, LOAD TRAD TABLE WORD COUNT.          F1E04970
       TXL     FLOWE,2,0     *EXIT, NO TABLE.                           F1E04980
FLOW3  LAS     **,2           DOES A BETA IN TRAD TRANSFER TO ALPHA+N.  F1E04990
       TRA     *+2            NO.                                       F1E05000
       TRA     FLOWG         *YES, IS ALL RIGHT.                        F1E05010
       TIX     FLOW3,2,1     *NO, IS TRAD EXHAUSTED, NO CONTINUE.       F1E05020
       REM                                                              F1E05030
FLOWE  AXT     **,2           YES, LOAD THE NONEXC TABLE WORD COUNT.    F1E05040
       TXL     FLOW4,2,0     *EXIT, NO TABLE.                           F1E05050
FLOWF  LAS     **,2           IS ALPHA+N NON-EXECUTABLE.                F1E05060
       TRA     *+2            NO.                                       F1E05070
       TRA     FLOW1          YES, FORM ALPHA+N+1.                      F1E05080
       TIX     FLOWF,2,1     *NO, IS NONEXC EXHAUSTED, NO CONTINUE.     F1E05090
       REM                                                              F1E05100
FLOW4  STA     ALPHA          YES, SAVE ALPHA.                          F1E05110
       TSX     NOBETA,4       GO TO DIAGNOSTIC SUBROUTINE.              F1E05120
       OCT     1014           ERROR FLAG.                               F1E05130
       REM                                                              F1E05140
FLOWG  TIX     FLOWB,1,1     *IS TSTOPS (ALPHA) EXHAUSTED, NO CONTINUE. F1E05150
       REM                                                              F1E05160
       REM *************************************************************F1E05170
       REM                                                              F1E05180
       REM               TDO ROUTINE.                                   F1E05190
       REM               CHECKS THE BETA OF A DO LOOP FOR ITS EXISTENCE,F1E05200
       REM               THAT IT IS EXECUTABLE AND THAT IT IS NOT       F1E05210
       REM               A TIFGO STATEMENT.                             F1E05220
       REM                                                              F1E05230
TDOA   LXD     TDOLOC,1       LOAD TDO TABLE WORD COUNT.                F1E05240
       TXL     FRETA,1,0     *EXIT, NO TABLE.                           F1E05260
       REM                                                              F1E05270
       LXA     NXCLOC,2       INITIALIZE LAST ADDRESS PLUS ONE          F1E05280
       SXA     TDOF,2         OF NONEXC SEARCH ROUTINE.                 F1E05290
       LXA     STPLOC,2       INITIALIZE LAST ADDRESS PLUS ONE          F1E05300
       SXA     TDOD,2         OF TSTOPS SEARCH ROUTINE.                 F1E05310
       LXA     TDOLOC,2       LOAD LAST ADDRESS PLUS ONE OF TDO TABLE.  F1E05320
       SXA     TDOB,2         SET ADDRESS IN PROCESSOR.                 F1E05330
       TXI     *+1,2,1        BUMP BY ONE AND SET IN ERROR ROUTINE      F1E05340
       SXA     TDOI,2         TO GET SYMBOL.                            F1E05350
       REM                                                              F1E05360
       STZ     ALPHA          RESET ALPHA CELL.                         F1E05370
       REM                                                              F1E05380
TDOB   CAL     **,1           GET FIRST WORD OF TDO ENTRY.              F1E05390
       PDX     ,4             GET ALPHA FROM DECREMENT FIELD            F1E05400
       SXA     ALPHA,4        AND SAVE FOR ERROR ROUTINE.               F1E05410
       ANA     ADMSK          GET BETA FOR THIS DO LOOP.                F1E05420
       TNZ     TDOC          *DOES BETA EXIST, YES.                     F1E05430
       TSX     NOBETA,4       NO, GO TO DIAGNOSTIC SUBROUTINE.          F1E05440
       OCT     1050           ERROR FLAG.                               F1E05450
       TRA     TDOG          *TERMINATE PROCESSING ON THIS ENTRY.       F1E05460
       REM                                                              F1E05470
TDOC   STO     ERASE          SAVE BETA.                                F1E05480
       LXD     STPLOC,2       LOAD TSTOPS (ALPHA) TABLE WORD COUNT.     F1E05490
       TXL     TDOE,2,0      *NO TABLE, CONTINUE WITH NONEXC.           F1E05500
TDOD   CAL     **,2           GET A TSTOPS ENTRY.                       F1E05510
       ANA     ADMSK          EXTRACT THE ALPHA.                        F1E05520
       SUB     ERASE          SUBTRACT BETA.                            F1E05530
       TZE     TDOH          *ARE THEY THE SAME, YES - ERROR.           F1E05540
       TIX     TDOD,2,1      *NO, IS TSTOPS EXHAUSTED, NO CONTINUE.     F1E05550
       REM                                                              F1E05560
TDOE   LXD     NXCLOC,2       YES, LOAD NONEXC TABLE WORD COUNT.        F1E05570
       TXL     TDOG,2,0      *NO TABLE, EXIT.                           F1E05580
       CAL     ERASE          SOME TABLE, GET BETA.                     F1E05590
TDOF   LAS     **,2           DOES BETA MATCH NONEXC IFN.               F1E05600
       TRA     *+2            NO.                                       F1E05610
       TRA     TDOJ          *YES, PROGRAMMER ERROR.                    F1E05620
       TIX     TDOF,2,1      *NO, IS NONEXC EXHAUSTED, NO CONTINUE.     F1E05630
       REM                                                              F1E05640
TDOG   TIX     TDOB,1,5      *IS TDO EXHAUSTED, NO CONTINUE.            F1E05650
       TRA     FRETA         *YES, GO TO THE FRET PROCESSOR.            F1E05660
       REM                                                              F1E05670
       REM     . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E05680
       REM                                                              F1E05690
       REM                    BETA IS A TIFGO STATEMENT.                F1E05700
       REM                                                              F1E05710
TDOH   TSX     NOBETA,4       GO TO DIAGNOSTIC SUBROUTINE TO ENTER      F1E05720
       OCT     1100           ERROR FLAG.                               F1E05730
TDOK   LXD     GOOFCT,4       LOAD ERROR COUNT.                         F1E05740
       XEC     TDOB           GET THE FIRST WORD OF THIS TDO ENTRY.     F1E05750
       SLW     ELSEBF,4       STORE IN ERROR LIST.                      F1E05760
TDOI   CAL     **,1           GET SECOND WORD OF TDO ENTRY (SYMBOL).    F1E05770
       SLW     ELSEBF-1,4     STORE IN ERROR LIST.                      F1E05780
       TXI     *+1,4,2        UPDATE ERROR COUNT.                       F1E05790
       SXD     GOOFCT,4       SAVE NEW COUNT.                           F1E05800
       TRA     TDOG          *TEST FOR END OF TABLE.                    F1E05810
       REM                                                              F1E05820
       REM     . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E05830
       REM                                                              F1E05840
       REM                    BETA IS A NON-EXECUTABLE STATEMENT.       F1E05850
       REM                                                              F1E05860
TDOJ   TSX     NOBETA,4       GO TO DIAGNOSTIC SUBROUTINE TO ENTER      F1E05870
       OCT     1070           ERROR FLAG.                               F1E05880
       TRA     TDOK          *CONTINUE BY USING TIFGO ERROR ROUTINE.    F1E05890
       REM                                                              F1E05900
       REM *************************************************************F1E05910
       REM                                                              F1E05920
       REM               FREQUENCY ROUTINE.                             F1E05930
       REM               CHECKS FOR FREQUENCIES SPECIFYING MORE         F1E05940
       REM               BRANCHES THAN THERE ARE FOR THAT TYPE          F1E05950
       REM               OF TIFGO STATEMENT.                            F1E05960
       REM                                                              F1E05970
FRETA  LXD     FRTLOC,1       LOAD FRET TABLE WORD COUNT.               F1E05980
       REM                                                              F1E05990
       REM                                                              F1E06020
       TXL     FINIS,1,0     *EXIT, NO TABLE.                           F1E06030
       REM                                                              F1E06040
       SLF                    MAKE SURE FLAG LITE IS OFF.               F1E06050
       STZ     ALPHA          RESET ALPHA CELL.                         F1E06060
       LXA     STPLOC,2       LOAD TSTOPS (ALPHA) TABLE ORIGIN,         F1E06070
       SXA     FRETE,2        LAST ADDRESS PLUS ONE AND SET ROUTINE.    F1E06080
       LXA     FRTLOC,2       LOAD LAST ADDRESS PLUS ONE FRET           F1E06090
       SXA     FRETB,2        TABLE AND INITIALIZE ADDRESSES.           F1E06100
       SXA     FRETC,2                                                  F1E06110
       REM                                                              F1E06120
FRETB  CLA     **,1           GET THE IFN OF A FRET ENTRY.              F1E06130
       STA     ALPHA          SAVE IT IN ALPHA.                         F1E06140
       TXI     *+1,1,-1       DECREMENT INDEX TO GET FREQUENCY.         F1E06150
       AXT     0,2            INITIALIZE BRANCH COUNTER.                F1E06160
FRETC  CLA     **,1           GET NEXT WORD OF THE FRET TABLE.          F1E06170
       TMI     FRETD         *IS THIS BEGINNING OF NEW ENTRY, YES.      F1E06180
       TXI     *+1,2,1        NO, INCREMENT COUNT OF BRANCHES.          F1E06190
       TIX     FRETC,1,1     *IS FRET EXHAUSTED, NO CONTINUE.           F1E06200
       SLN     1              YES, SET END OF TABLE FLAG.               F1E06210
FRETD  LXD     STPLOC,4       LOAD TSTOPS (ALPHA) TABLE WORD COUNT.     F1E06220
       TXL     FINIS,4,0     *NO ALPHA TABLE, NO MORE WORK TO DO.       F1E06230
FRETE  CAL     **,4           SOME TABLE, GET AN ENTRY.                 F1E06240
       ANA     ADMSK          EXTRACT THE IFN (ALPHA).                  F1E06250
       SUB     ALPHA          IS IT THE SAME AS THE ALPHA OF THIS       F1E06260
       TNZ     FRETF         *FREQUENCY STATEMENT.  NO CONTINUE.        F1E06270
       XEC     FRETE          YES, RETRIEVE ENTRY.                      F1E06280
       STD     *+1            PICK UP BRANCH COUNT FOR THIS TIFGO.      F1E06290
       TXL     FRETG,2,**     DOES THE FRET ENTRY SPECIFY TOO MANY      F1E06300
       TSX     NOBETA,4       BRANCHES.  YES, GO TO DIAGNOSTIC.         F1E06310
       OCT     1172           ERROR FLAG.                               F1E06320
       TRA     FRETG         *CONTINUE BELOW.                           F1E06330
       REM                                                              F1E06340
FRETF  TIX     FRETE,4,1     *IS TSTOPS EXHAUSTED, NO CONTINUE.         F1E06350
       REM                                                              F1E06360
FRETG  SLT     1              IS FRET EXHAUSTED.                        F1E06370
       TRA     FRETB         *NO, GET NEXT FREQUENCY ENTRY.             F1E06380
       REM                                                              F1E06390
       REM *************************************************************F1E06400
       REM                                                              F1E06410
FINIS  LXD     GOOFCT,4       LOAD ERROR COUNT.                         F1E06420
       TXH     *+3,4,0       *ANY ERRORS TODAY, YES.                    F1E06430
       REM                                                              F1E06440
       TSX     (LOAD),4       NO, GET SECTION 2.                        F1E06450
       PZE                                                              F1E06460
       REM                                                              F1E06470
       SXD     SOURCE+1,4     SAVE ERROR COUNT FOR GENERAL DIAGNOSTIC.  F1E06480
       CLA     SOURCE+1       GET ORIGIN OF ERROR LIST.                 F1E06490
       ADD     L(A1)          SET FOR TIX LOOP TO MOVE TEMPORARY LIST.  F1E06500
       STA     *+2                                                      F1E06510
       CAL     ELSEBF+1,4     MOVE ERROR LIST.                          F1E06520
       SLW     **,4                                                     F1E06530
       TIX     *-2,4,1                                                  F1E06540
       TSX     SOURCE,4       GET GENERAL DIAGNOSTIC.                   F1E06550
       REM                                                              F1E06560
       REM *************************************************************F1E06570
       REM                                                              F1E06580
       REM               ERROR SUBROUTINE.                              F1E06590
       REM                                                              F1E06600
ERROR  SXA     ERR01,2        SAVE INDEX.                               F1E06610
       LXD     GOOFCT,2       LOAD ERROR COUNT.                         F1E06620
       CAL     1,4            GET ERROR FLAG.                           F1E06630
       ALS     18             SHIFT TO DECREMENT FIELD.                 F1E06640
       SLW     ELSEBF,2       STORE IN ERROR LIST.                      F1E06650
       STQ     ELSEBF-1,2     STORE PERTINENT INFORMATION.              F1E06660
       TXI     *+1,2,2        UPDATE ERROR COUNT.                       F1E06670
       SXD     GOOFCT,2       SAVE ERROR COUNT.                         F1E06680
ERR01  AXT     **,2           RESTORE INDEX                             F1E06690
       TRA     2,4           *RETURN TO CALLER.                         F1E06700
       REM                                                              F1E06710
       REM     . . . . . . . . . . . . . . . . . . . . . . . . . . . . .F1E06720
       REM                                                              F1E06730
       REM               NOBETA SUBROUTINE.                             F1E06740
       REM                                                              F1E06750
NOBETA SXA     NBET1,2        SAVE INDEX.                               F1E06760
       LXD     GOOFCT,2       LOAD ERROR COUNT.                         F1E06770
       CAL     1,4            GET ERROR FLAG.                           F1E06780
       ALS     18             SHIFT TO DECREMENT FIELD.                 F1E06790
       SLW     ELSEBF,2       STORE IN ERROR LIST.                      F1E06800
       CLA     ALPHA          GET ALPHA (IFN) OF THIS STATEMENT.        F1E06810
       STA     ELSEBF,2       SAVE WITH ERROR FLAG.                     F1E06820
       TXI     *+1,2,1        UPDATE ERROR COUNT.                       F1E06830
       SXD     GOOFCT,2       SAVE ERROR COUNT.                         F1E06840
NBET1  AXT     **,2           RESTORE INDEX.                            F1E06850
       TRA     2,4           *RETURN TO CALLER.                         F1E06860
       REM                                                              F1E06870
       REM *************************************************************F1E06880
       REM                                                              F1E06890
       REM                                                              F1E07080
       REM                                                              F1E07090
       REM *************************************************************F1E07100
       REM                                                              F1E07110
       REM               *** CONSTANTS AND ERASABLE ***                 F1E07120
       REM                                                              F1E07130
BKSPX  MZE     6,,1           COMMAND TO BACKSPACE TO FORVAL.           F1E07131
FORVL  BCI     1,FORVAL       FORVAL LABEL.                             F1E07132
TRADL  PZE     TRADMX         CONSTANT  (MAXIMUM SIZE OF TRAD TABLE).   F1E07140
OBETA  PZE     BETA           ORIGIN OF BETA TABLE.                     F1E07150
NXFLG  OCT     1360000000     NOT EXECUTABLE FLAG.                      F1E07160
L(D1)  PZE     ,,1            CONSTANT.                                 F1E07170
L(D2)  PZE     ,,2            CONSTANT.                                 F1E07180
L(A1)  PZE     1              CONSTANT.                                 F1E07190
ADMSK  PZE     -1             ADDRESS MASK.                             F1E07200
ALL1S  SVN     -1,7,-1        ERROR FLAG FOR EQUIT.                     F1E07210
       REM                                                              F1E07220
ALPHA  PZE     **,,**         IFN,,SOMETHING                            F1E07230
ERASA  PZE     **,,0          ADDRESS ERASABLE.                         F1E07240
ERASE  PZE     **             WHOLE WORD ERASABLE.                      F1E07250
       REM                                                              F1E07260
       REM *************************************************************F1E07270
       REM                                                              F1E07280
PATC1  ANA     ADMSK         MASK ADDRESS.                             $F1E07281
       TNZ     TIF1C        *DOES BETA EXIST, YES.                     $F1E07282
       TRA     TRA1+1        RETURN.                                   $F1E07283
PATC2  ANA     ADMSK         MASK ADDRESS.                             $F1E07284
       TNZ     TIF2C        *DOES BETA EXIST, YES.                     $F1E07285
       TRA     TRA2+1        RETURN.                                   $F1E07286
       BSS     1000           PATCH SPACE FOR I DOUBLE PRIME.           F1E07290
       REM                                                              F1E07300
       REM *************************************************************F1E07310
       REM                                                              F1E07320
BETA   SYN     *              ORIGIN FOR BETA TABLE                     F1E07330
       EJECT                                                            F1E07350
       END     -1                                                       F1E07351
« December 2014 »
Su Mo Tu We Th Fr Sa
1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31
 

Powered by Plone CMS, the Open Source Content Management System

This site conforms to the following standards: