$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