$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 INPU