PAGE 0001 0001 ASMB,A,B,L,T BASIC LANGUAGE -- JANUARY 1, 1970 PREAD 000101 WRITE 000102 PUNCH 000103 REED 000104 LWBM 000106 FWAM 000110 LWAM 000111 PBUFF 000112 PBPTR 000113 FWABP 000114 FCORE 000115 SYMTF 000116 SYMTA 000117 LSTAK 000120 ASBTB 000121 SBTBE 000122 IMOFF 000123 IMON 000124 TLINK 000125 PLSTR 000126 LISTR 000127 TLSTR 000130 .BUFA 000131 BADDR 000132 CCNT 000133 SBUFA 000134 SBPTR 000135 TFLAG 000136 TTYFL 000137 TSTPT 000140 LSTPT 000141 HSTPT 000142 PRADD 000143 NXTST 000144 .LNUM 000145 TYPE 000146 DSTRT 000147 NXTDT 000150 DCCNT 000151 RSYM 000152 SIGN 000153 EXP 000154 XH 000155 XL 000156 TEMPS 000157 MLBX1 000171 B1 000173 B2 000175 B3 000177 START 000201 RUNA 000202 FASE3 000203 PEXMA 000204 RDYDA 000205 DRQSA 000206 PAGE 0002 LISTA 000207 MATA 000210 EMATA 000211 TSRCH 000212 FNDPA 000213 CNSTA 000214 NUMCA 000215 INCHK 000216 ENOTA 000217 NUMOA 000220 PGINT 000221 OUTIA 000222 OUTSA 000223 OUTLA 000224 OUTCA 000225 GETCA 000226 DIGCA 000227 LETCA 000230 SSYMA 000231 FETCA 000232 FORMA 000233 .LOGA 000234 .EXPA 000235 .FADA 000236 .FSBA 000237 .FMPA 000240 .FDVA 000241 ARINA 000242 MPYA 000243 FLUNA 000244 PACKA 000245 FLT 000246 IFIXA 000247 PRNIA 000250 CHRSA 000251 ACCST 000252 DELST 000253 FDAT 000254 LCK2A 000255 XEC4A 000256 FSC1A 000257 FOR1A 000260 FOR0A 000261 FOR0B 000262 FOR1B 000263 FR12A 000264 EOF 000265 NOEOF 000266 E8M1A 000267 ESYN3 000270 FSCEF 000271 E6M1A 000272 EBUFA 000273 EBFA 000274 LBUFA 000275 LNBFA 000276 PAGE 0003 ERBS 000277 RECER 000300 FOPBS 000301 STBAS 000302 XECBR 000303 ARBAS 000304 PDFBS 000305 TBLAD 000306 STTYP 000307 MATIO 000310 MCBOP 000311 PDFNS 000312 MATFN 000313 ANEXT 000314 ADATA 000315 ATHEN 000316 ATO 000317 ASTEP 000320 ANOT 000321 ATAB 000322 MBXL 000323 .1 000324 .2 000325 .3 000326 .4 000327 .6 000330 .7 000331 .8 000332 .9 000333 .10 000334 .12 000335 .15 000336 .23 000337 .26 000340 .27 000341 .28 000342 .30 000343 .31 000344 .32 000345 .33 000346 .34 000347 .37 000350 .40 000351 .41 000352 .43 000353 .45 000354 .46 000355 .47 000356 .48 000357 .49 000360 .58 000361 .63 000362 B100 000363 E 000364 F 000365 .72 000366 PAGE 0004 .74 000367 .75 000370 N 000371 S 000372 B133 000373 B177 000374 B200 000375 MSK0 000376 B400 000377 B776 000400 MSK1 000401 B1000 000402 B2000 000403 B3000 000404 SCCNT 000405 B4000 000406 LF 000407 B1400 000410 UNMNC 000411 B2200 000412 B2300 000413 DEFOP 000414 REMOP 000415 RDOP 000416 TENTH 000417 OPMSK 000420 MSK4 000421 INF 000422 TYPFL 000423 TABCN 000424 OPDMK 000425 RMODE 000426 UNNRM 000427 HIMSK 000430 M1 000431 M2 000432 M3 000433 M4 000434 M5 000435 M6 000436 M7 000437 M8 000440 M9 000441 M10 000442 M11 000443 M15 000444 M16 000445 M21 000446 M25 000447 M32 000450 D53 000451 D72 000452 D100 000453 M72 000454 M73 000455 M76 000456 PAGE 0005 D133 000457 M256 000460 M310 000461 M1000 000462 MAXSN 000463 MSK3 000437 FN 000464 QMARK 000465 HALF 000466 HONE 000466 MNEG 000470 FLGBT 000470 MAXFX 000472 MINFX 000474 BLANK 000476 ERROR 000477 MVTOH 000554 MVTO1 000556 CONST 000567 CONS1 000602 CONS2 000605 CONS3 000611 SYE12 000614 NUMCK 000615 NUMC1 000626 NUMC2 000634 NUMC3 000652 NUMC4 000657 NUMC5 000664 NUMC6 000703 NUMC7 000706 NUMER 000716 NUMC8 000725 NUMC9 000727 NUM10 000751 NUM12 000755 NUM13 000772 NUM14 000776 NUM15 001005 .PACK 001020 PACK1 001040 PACK3 001073 UNDER 001074 PACK4 001077 OVRER 001100 OVFLW 001103 NORML 001113 NORM1 001125 NORM2 001127 NORM3 001130 MBY10 001147 DBY10 001200 MPY 001236 MPY1 001256 MPY2 001271 SYMCK 001274 PAGE 0006 SYMC1 001302 SYMC2 001312 FNDSB 001323 FNDS1 001326 CALER 001330 MDIM 001336 MER9 001352 SBFIX 001353 IFIX 001364 IFIX1 001404 IFIX2 001410 IFIX3 001414 ARINV 001423 ARIN1 001442 ARIN2 001452 .FLUN 001456 SLWST 001467 E1 001473 BHSTP 001476 STTOP 001505 OPCHK 001515 E8 001526 OPCH1 001527 RSCHK 001536 DIGCK 001570 LETCK 001603 GETCR 001614 BCKSP 001633 ENOUT 001643 EDELM 001656 EDEL1 001660 OUTLN 001677 OUTCR 001715 TEMP 000160 TEMP1 000161 TEMP2 000162 TEMP3 000163 TEMP4 000164 COUNT 000165 STEMP 000163 MANT1 001274 MANT2 001336 EXPON 001603 DPFLG 001633 ARYAD 001715 EOL 000567 FINBP 001734 RDYA 002000 READY 002001 LFEED 002004 QMRKA 002005 STOPA 002006 CMNDA 002007 ENTRY 002010 FLUSH 002020 RDYPT 002027 PAGE 0007 PEXMK 002041 DATAI 002046 GTRCD 002056 RPRCS 002064 RTLE 002066 RBOUT 002115 DRQST 002121 CKRCD 002126 INVSC 002137 CMNDS 002146 RUN 002146 SCRTH 002150 TLIST 002151 PLIST 002153 PTAPE 002160 PRERR 002170 EOTR 002174 STOP 002200 TAPE 002214 BYEC 002216 SYNTX 002220 SYNE1 002236 SYNT1 002247 QUOTE 002257 COMMA 002261 SMCLN 002263 RPARN 002265 RBRAC 002267 SCMMA 002271 ASSOP 002273 PLUS 002275 MINUS 002277 TIMES 002301 DIV 002303 EXPS 002305 GTR 002307 LSS 002311 UNEQL 002313 EQUAL 002315 UNMIN 002317 LBRAC 002321 LPARN 002323 UPLUS 002325 OROP 002327 MSFLG 002330 ANDOP 002331 DFLAG 002332 NOTOP 002333 PFLAG 002334 GTREQ 002335 UFLAG 002336 LSSEQ 002337 LETS 002340 SYNE2 002346 EOST 002346 DIMS 002351 PAGE 0008 COMS 002355 SYNE3 002361 COMS1 002363 DEFS 002374 SYNE4 002405 SYNE5 002420 SYNE6 002424 REMS 002434 IFS 002437 SYNE7 002445 GOTOS 002445 FORS 002450 SYNE8 002452 SYNE9 002465 SYE10 002500 NXTS 002502 ENDS 002506 WAITS 002512 CALLS 002514 CALL2 002532 SYE11 002540 CALL3 002543 DATAS 002547 READS 002557 SYE13 002561 PRIN1 002573 PRINS 002577 PRIN2 002604 SYE14 002613 PRIN3 002623 SYE15 002625 PRIN4 002647 PRIN5 002651 MATS 002654 SYE16 002656 SYE17 002671 MATS0 002673 SYE18 002702 MATS1 002710 MATS2 002722 SYE19 002755 SYE20 002775 MATS3 002776 SYE21 003007 MATS4 003010 SYE22 003020 MATS5 003024 SYE23 003041 MATS6 003045 SYE24 003057 MATS7 003061 SYNTB 003067 FSC 003114 FSC1 003117 FSC2 003121 FSC3 003146 PAGE 0009 FSC4 003162 FSC5 003170 FSCE1 003201 FSC7 003210 FSC6 003227 FSC8 003253 FSCE2 003255 FSC9 003261 FSC10 003271 FSC11 003275 FSC12 003301 FSC13 003304 FSCE3 003305 FSC14 003317 MCBCK 003322 FPOP 003330 FRCUR 003353 SSOV 003371 FSCE4 003401 SBSCK 003403 SBSC1 003436 SBSC2 003450 SBSC3 003473 ARRYS 003530 ARRE1 003534 ARRID 003544 ARRE2 003547 VAROP 003556 VARO1 003600 VARO2 003604 VARO3 003616 VARO4 003620 VARO5 003624 LTR 003635 STROP 003650 LPCK 003661 RPCK 003671 MATSB 003704 GETPF 003734 NUMOP 003744 SYCMD 003755 STCMD 003776 LET 004006 DIM 004011 COM 004014 DEF 004017 REM 004022 GOTO 004025 IF 004030 FOR 004032 NEXT 004035 GOSUB 004040 RTRN 004044 END 004050 STP 004053 WAIT 004056 PAGE 0010 CALL 004061 DATA 004064 READ 004067 PRINT 004072 INPUT 004076 RSTOR 004102 MAT 004107 THEN 004112 TO 004115 STEP 004117 NOT 004122 AND 004125 OR 004130 GTE 004132 LTE 004134 AUNEQ 004136 TAB 004140 SIN 004143 COS 004146 TAN 004151 ATN 004154 EXPN 004157 LOG 004162 ABS 004165 SQR 004170 INT 004173 RND 004176 SGN 004201 ZER 004204 CON 004207 IDN 004212 INV 004215 TRN 004220 TBSRH 004223 TSRC1 004246 TSRC2 004262 TSR10 004265 TSRC3 004271 TSRC4 004276 TSRC5 004304 TSRC6 004310 TSRC7 004313 TSRC8 004321 TSRC9 004326 PRGIN 004333 SYE25 004344 PRGI1 004346 INTCK 004351 INTC1 004354 INTC2 004373 CHRST 004410 CHRS1 004414 CHRS2 004432 CHRS3 004433 DLSTM 004437 ACTST 004447 PAGE 0011 ACCS1 004472 ACCS2 004474 ACCS3 004477 ACCS4 004507 FNDPS 004513 FNDP1 004516 FNDP2 004533 FNDP3 004534 FNDP4 004535 CLPRG 004537 CLPR1 004544 CLPR2 004553 OVCHK 004556 LIST 004572 LIST0 004607 LIST1 004614 LIST3 004635 LIST2 004640 LIST4 004644 LIST5 004670 LIST6 004703 LIST7 004710 LIST8 004725 LIST9 004732 LIS10 004751 LIS11 004765 LIS12 004772 LIS13 005003 LIS14 005011 OUTIN 005015 OUTI1 005024 OUTI2 005043 OUTI3 005046 OUTST 005055 OUTS1 005056 MCOUT 005077 MCOU1 005100 MCOU2 005112 MCOU3 005120 LDVSR 005132 SFLAG 003530 TABLE 004333 LNGTH 000167 SMEND 004351 SLENG 004556 TBLPT 004513 TSPTR 004537 INTGR 004556 LFLAG 004333 DIVSR 004351 LDZRO 004556 MIND 004513 MFASE 005137 MLOP1 005151 MLO10 005161 MLO12 005176 PAGE 0012 MLO13 005202 MLOP2 005211 MLOP3 005244 MLOP4 005261 MER3 005264 MLOP5 005272 MLOP6 005301 MER4 005312 MLOP7 005320 MLOP8 005335 MLOP0 005370 MLOP9 005373 MER5 005377 M1LOP 005407 MER6 005413 M2LOP 005414 MER10 005431 M3LOP 005445 MER7 005464 M4LOP 005466 STDIM 005500 ESYMT 005501 MER8 005512 MSYMT 005522 MSYM 005541 MBUF 005543 MBOX1 000157 MBIN1 001467 MBIN2 001536 MPTR 000135 MNPTR 001515 COML 000170 MWDNO 000171 DIGCT 005522 FORMX 005544 FORM1 005547 FORM2 005567 FORM0 005612 FOR11 005617 FOR10 005626 FORM4 005636 FORM5 005645 FORM6 005651 FOR12 005714 FORM7 005726 FORM9 005751 XECTB 005761 XEC 006006 XEC2 006025 XEC4 006044 XEC5 006054 XEC6 006055 FETCH 006064 SETDP 006074 STSRH 006105 STSR1 006110 PAGE 0013 STSR2 006124 FDATA 006126 FDAT1 006127 E4 006135 FDAT2 006137 FLWST 006147 FVSRH 006163 FVSR1 006173 FVSR2 006201 ELET 006203 EGOTO 006205 EIF 006210 EFOR 006216 EFOR1 006230 EFOR2 006263 EFOR3 006274 ENEXT 006312 ENEX1 006333 ENEX2 006340 ENEX3 006347 EGOSB 006353 E2 006363 ERTRN 006364 E3 006367 EWAIT 006373 EWAI1 006404 ECALL 006412 ECAL1 006423 ECAL2 006431 EREAD 006441 PRNIN 006456 EPRIN 006474 EPRI0 006477 EPRI1 006502 EPRI2 006510 EPRI3 006527 EPRI4 006536 EPRI5 006542 EPRI6 006556 EPRI7 006565 EPRI8 006603 ETAB 006605 ETAB1 006627 IENTA 006631 EINP1 006632 EINP2 006634 EINPT 006643 EINP3 006652 ERSTR 006656 AROTB 006663 BINOP 006707 BINO1 006717 BINO2 006720 ESCMA 006722 ESCM1 006747 E6 006760 PAGE 0014 ESBS 006771 ESTR 007002 ESTR1 007007 ESTR2 007022 EFAD 007026 EFSB 007031 EFMP 007034 EFDV 007037 EPWR 007042 RPWR 007054 BASER 007057 EPWR1 007065 IPWR 007073 IPWR1 007103 IPWR2 007107 IPWR5 007117 IPWR3 007124 IPWR4 007135 PCHK 007144 POWER 007153 ZRTNG 007156 PCHK1 007161 EGTRT 007164 ELST 007171 EEQL 007176 EEQL1 007200 EGORE 007203 ELORE 007210 ENEQL 007215 ENEQ1 007217 FALSE 007221 TRUE 007224 EUMIN 007227 ELBRC 007232 EOR 007240 ORS 007242 ORS1 007244 EAND 007246 ANDS 007250 ENOT 007253 ADMUP 007257 ADMU1 007261 ADMU2 007302 ADMU3 007313 ADMU4 007334 ADMU5 007337 .FAD 007343 .FSB 007347 .FSB1 007362 UNPAK 007366 .FMP 007416 .FDV 007463 .FDV1 007543 .FDV2 007546 DBYZR 007547 IDIV 007552 PAGE 0015 IDIV1 007577 IDIV2 007601 SSYMT 007620 SYMT1 007640 SYMT2 007647 SYMT4 007667 SYMT3 007674 ERR 007701 RCERR 010001 EBUFF 010007 EBFF 010013 LBUFF 010015 LNBFF 010022 PDFT 010024 NUMOT 010040 NS1 010052 NS2 010055 NUMO1 010101 NUMO2 010110 NUMO5 010127 NUMO3 010135 EOUT2 010153 EOUT3 010164 EOUT4 010175 EOUT6 010213 EOUT5 010217 EOUT7 010223 EOUT8 010227 ERND1 010242 ERND2 010262 ERND3 010276 EOUT1 010303 EOUT9 010333 EOU10 010340 GETDG 010344 RETCR 010370 A1 006074 A2 006105 C1 006147 C2 006163 ETAN 010406 TRGER 010420 BOTH1 010441 ELSE1 010467 ELSE2 010472 FOPI 010475 K1 010477 XTEMP 010501 YTEMP 010503 UTEMP 010505 K2 010507 COEFF 010511 EATN 010532 BTH1 010546 ELS1 010576 ELS2 010601 PAGE 0016 ELS3 010604 PIBY2 010611 MP2 010613 COEF 010615 EABS 010642 ECOS 010645 ESIN 010647 PAST 010702 TOPI 010717 MM4 010721 COEF1 010723 ERND 010736 ESQR 010765 SQRER 010771 BTH2 011005 SBOX 011032 ODD 011034 SA1 011045 SA2 011047 SB1 011051 SB2 011053 EINT 011055 EINT1 011065 ELOG 011070 .LOG 011072 LOGER 011077 .LOG1 011150 LNZR 011151 R22 011154 LE2 011156 AAA 011160 MB 011162 CCC 011164 ESGN 011166 EEXP 011177 .EXP 011201 INTE 011274 ZERE 011276 .EXP1 011301 EXPER 011305 M124 011310 .244 011311 AAAA 011312 BBBB 011314 CCCC 011316 DDDD 011320 L2E 011322 .CHEB 011324 LOPC 011343 COUT 011371 X2TMP 011401 ATMP 011403 BTMP 011405 CTMP 011407 DTMP 011411 .IENT 011413 PAGE 0017 FLOAT 011432 .PWR2 011440 .RET 011454 TT1 007463 TT2 007552 TT3 000163 TT4 000164 FFLAG 011032 EMAT 011456 EMAT1 011471 EMAT2 011535 EMAT3 011540 EMAT4 011555 EMAT5 011561 EMAT6 011600 EMAT7 011610 EMAT0 011622 EMAT8 011626 EMAT9 011662 LMAP 011666 LBASE 011667 EMA10 011701 EMA11 011711 EMA12 011725 REDIM 011732 REDI1 011746 E7 011766 MCKS 011767 GENER 012000 GEN2 012004 LOOP 012013 MOD1 012017 MOD2 012025 COMPR 012032 LERR 012035 LCHK2 012045 LCHK1 012051 LCHK4 012061 LCHK6 012067 LCHK5 012100 ADD 012103 ADD1 012105 SUB 012116 REPLC 012123 REPL1 012130 SMULT 012137 LCON 012145 LCON1 012150 LCON2 012161 SZER 012170 LIDN 012176 LIDN1 012216 .DLD 012230 .DST 012240 GETAD 012250 GET 012253 PAGE 0018 ADRES 012264 TINY 012265 TRAN 012266 TRAN1 012302 LNEXT 012304 MULT 012331 MULT4 012361 MULT3 012366 MULT2 012374 LINV 012441 LIN11 012502 LIN10 012522 LINV1 012535 LINV2 012551 LINV7 012571 LINV8 012602 LINV3 012626 LDUM1 012704 LINV6 012716 LIN12 012733 LIN13 012740 LIN14 012752 LINV4 012760 LINV5 013006 LIN15 013033 LIN18 013040 LIN17 013062 LWHR 013067 LWHR2 013101 T1 013113 T2 013114 T3 013115 T4 013116 T5 013117 T6 013120 T7 013121 T8 013122 T9 013123 T10 013124 T11 013125 T12 013126 T13 013127 T16 013130 T18 013132 T19 013133 LPIV 013134 LPLUS 013135 LMIN 013137 LTIME 013140 INCB2 013141 FINIS 013142 ** NO ERRORS* PAGE 0019 #01 BASE PAGE LINKS AND CONSTANTS 0001 ASMB,A,B,L,T BASIC LANGUAGE -- JANUARY 1, 1970 0003 00077 ORG 77B 0004 SUP PRESS MULTIPLE OPERAND PRINTING 0005 00077 102077 HLT 77B CHANGED TO JSB 107B,I BY 'BOSS' 0006* 0007** ENTRY POINT FOR CONFIGURED BASIC 0008* 0009 00100 124201 JMP START,I 0010* 0011 00101 000000 PREAD BSS 1 PHOTO READER LINK 0012 00102 000000 WRITE BSS 1 TTY OUTPUT LINK 0013 00103 000000 PUNCH BSS 1 PUNCH LINK 0014 00104 000000 REED BSS 1 KEYBOARD LINK 0015 00105 002200 DEF STOP STOP LINK 0016 00106 000000 LWBM BSS 1 LAST WORD OF AVAILABLE MEMORY 0017 00107 000000 BSS 1 'BOSS' DRIVER LINKAGE 0018 00110 013142 FWAM DEF FINIS FIRST WORD OF AVAILABLE MEMORY 0019 00111 000000 LWAM BSS 1 LAST WORD OF AVAILABLE MEMORY 0020 00112 000000 PBUFF BSS 1 FIRST WORD OF USERS PROGRAM 0021 00113 000000 PBPTR BSS 1 LAST WORD+1 OF USER'S PROGRAM 0022 00114 001734 FWABP DEF FINBP FIRST WORD AVAILABLE BASE PAGE 0023 00115 000000 FCORE BSS 1 START OF FREE CORE 0024 00116 000000 SYMTF BSS 1 START OF SYMBOL TABLE 0025 00117 000000 SYMTA BSS 1 SYMBOL TABLE END 0026 00120 000000 LSTAK BSS 1 LOW-CORE STACK ADDRESS 0027 00121 013142 ASBTB DEF FINIS START OF CALL LINKAGE TABLE 0028 00122 013142 SBTBE DEF FINIS LAST WORD +1 OF CALL TABLE 0029 00123 000000 IMOFF BSS 1 LINK TO INTERRUPT OFF 0030 00124 000000 IMON BSS 1 LINK TO INTERRUPT ON 0031 00125 000000 TLINK BSS 1 TTY INTERRUPT LINK 0032 00126 100103 PLSTR DEF PUNCH,I 0033 00127 100102 LISTR DEF WRITE,I LIST DEVICE REFERENCE JSB,I 0034 00130 100102 TLSTR DEF WRITE,I 0035 00131 000000 .BUFA BSS 1 I/O BUFFER ADDRESS 0036 00132 000000 BADDR BSS 1 I/O BUFFER 0037 00133 000000 CCNT BSS 1 POINTERS 0038 00134 000000 SBUFA BSS 1 SYNTAX BUFFER ADDRESS 0039 00135 000000 SBPTR BSS 1 SYNTAX BUFFER POINTER 0040 00136 000000 TFLAG BSS 1 0041 00137 000000 TTYFL BSS 1 0042 00140 000000 TSTPT BSS 1 TEMPORARY STACK POINTER 0043 00141 000000 LSTPT BSS 1 LOW-CORE STACK POINTER 0044 00142 000000 HSTPT BSS 1 HIGH-CORE STACK POINTER 0045 00143 000000 PRADD BSS 1 PROGRAM EXECUTION 0046 00144 000000 NXTST BSS 1 SEQUENCING INFORMATION 0047 00145 000000 .LNUM BSS 1 CURRENT LINE NUMBER 0048 00146 000000 TYPE BSS 1 CURRENT STATEMENT TYPE 0049 00147 000000 DSTRT BSS 1 DATA 0050 00150 000000 NXTDT BSS 1 STATEMENT 0051 00151 000000 DCCNT BSS 1 POINTERS 0052 00152 000000 RSYM BSS 1 0053 00153 000000 SIGN BSS 1 0054 00154 000000 EXP BSS 1 0055 00155 000000 XH BSS 1 RANDOM 0056 00156 000000 XL BSS 1 VARIABLE 0057 00157 000000 TEMPS BSS 12 TEMPORARIES PAGE 0020 #01 BASE PAGE LINKS AND CONSTANTS 0058 00171 MLBX1 EQU TEMPS+10 0059 00173 000000 B1 BSS 2 0060 00175 000000 B2 BSS 2 0061 00177 000000 B3 BSS 2 PAGE 0021 #01 BASE PAGE LINKS AND CONSTANTS 0063 00201 002010 START DEF ENTRY INITIATE BASIC SYSTEM 0064 00202 005137 RUNA DEF MFASE PHASE 2: BUILD SYMBOL TABLE 0065 00203 006006 FASE3 DEF XEC PHASE 3: PROGRAM EXECUTION 0066 00204 002041 PEXMA DEF PEXMK RETURN TO MONITOR FROM SYNTAX 0067 00205 002027 RDYDA DEF RDYPT RETURN TO MONITOR FROM PHASE 3 0068 00206 002121 DRQSA DEF DRQST REQUEST INPUT DATA 0069 00207 004572 LISTA DEF LIST LIST OR PUNCH PROGRAM 0070 00210 004110 MATA DEF MAT+1 MAT ENTRY IN PRINT-NAME TABLE 0071 00211 011456 EMATA DEF EMAT FIRST WORD OF MATRIX EXECUTION 0072 00212 004223 TSRCH DEF TBSRH SEARCH PRINT-NAME TABLE 0073 00213 004513 FNDPA DEF FNDPS LOCATE STATEMENT SPECIFIED BY # 0074 00214 000567 CNSTA DEF CONST SIGNED ASCII TO BINARY 0075 00215 000615 NUMCA DEF NUMCK UNSIGNED ASCII TO BINARY 0076 00216 004351 INCHK DEF INTCK ASCII TO INTEGER CONVERSION 0077 00217 001643 ENOTA DEF ENOUT SIGNED BINARY NUMBER TO ASCII 0078 00220 010040 NUMOA DEF NUMOT UNSIGNED BINARY NUMBER TO ASCII 0079 00221 004333 PGINT DEF PRGIN FETCH PROGRAM INTEGER 0080 00222 005015 OUTIA DEF OUTIN INTEGER TO ASCII CONVERSION 0081 00223 005055 OUTSA DEF OUTST STRING TO BUFFER 0082 00224 001677 OUTLA DEF OUTLN DUMP PRINT BUFFER WITH CR/LF 0083 00225 001715 OUTCA DEF OUTCR PUT CHARACTER INTO PRINT BUFFER 0084 00226 001614 GETCA DEF GETCR FETCH NEXT NON-BLANK CHARACTER 0085 00227 001570 DIGCA DEF DIGCK SEE IF CHARACTER IS A DIGIT 0086 00230 001603 LETCA DEF LETCK SEE IF CHARACTER IS A LETTER 0087 00231 007620 SSYMA DEF SSYMT SEARCH SYMBOL TABLE FOR SYMBOL 0088 00232 006064 FETCA DEF FETCH EVALUATE FORMULA A RETURN VALUE 0089 00233 005544 FORMA DEF FORMX EVALUATE FORMULA 0090 00234 011072 .LOGA DEF .LOG TAKE NATURAL LOG OF ARGUMENT 0091 00235 011201 .EXPA DEF .EXP COMPUTE EXPONENTIAL OF ARGUMENT 0092 00236 007343 .FADA DEF .FAD FLOATING ADD 0093 00237 007347 .FSBA DEF .FSB FLOATING SUBTRACT 0094 00240 007416 .FMPA DEF .FMP FLOATING MULTIPLY 0095 00241 007463 .FDVA DEF .FDV FLOATING DIVIDE 0096 00242 001423 ARINA DEF ARINV NEGATE FLOATING NUMBER 0097 00243 001236 MPYA DEF MPY INTEGER MULTIPLY 0098 00244 001456 FLUNA DEF .FLUN UNPACK FLOATING NUMBER 0099 00245 001020 PACKA DEF .PACK PACK FLOATING NUMBER 0100 00246 011432 FLT DEF FLOAT 16-BIT INTEGER TO FLOATING 0101 00247 001364 IFIXA DEF IFIX FLOATING TO INTEGER (TRUNCATION) 0102 00250 006456 PRNIA DEF PRNIN INITIALIZE PRINT BUFFER 0103 00251 004410 CHRSA DEF CHRST 0104 00252 004447 ACCST DEF ACTST 0105 00253 004437 DELST DEF DLSTM 0106 00254 006126 FDAT DEF FDATA 0107 00255 012045 LCK2A DEF LCHK2 0108 00256 006044 XEC4A DEF XEC4 0109 00257 003317 FSC1A DEF FSC14 0110 00260 005547 FOR1A DEF FORM1 0111 00261 005612 FOR0A DEF FORM0 0112 00262 005617 FOR0B DEF FOR11 0113 00263 005626 FOR1B DEF FOR10 0114 00264 005714 FR12A DEF FOR12 0115 00265 014477 EOF JSB ERROR 0116 00266 014477 NOEOF JSB ERROR 0117 00267 001525 E8M1A DEF E8-1 0118 00270 002360 ESYN3 DEF SYNE3-1 PAGE 0022 #01 BASE PAGE LINKS AND CONSTANTS 0119 00271 003401 FSCEF DEF FSCE4 0120 00272 006757 E6M1A DEF E6-1 0121 00273 010007 EBUFA DEF EBUFF 0122 00274 010012 EBFA DEF EBFF-1 0123 00275 010015 LBUFA DEF LBUFF 0124 00276 010021 LNBFA DEF LNBFF-1 0125 00277 007700 ERBS DEF ERR-1 0126 00300 000100 RECER DEF RCERR-ERR 0127 00301 002255 FOPBS DEF QUOTE-2 0128 00302 103035 STBAS DEF SYNTB-26,I 0129 00303 105727 XECBR DEF XECTB-26,I 0130 00304 106655 ARBAS DEF AROTB-6,I 0131 00305 010023 PDFBS DEF PDFT-1 0132 00306 003755 TBLAD DEF SYCMD 0133 00307 004006 STTYP DEF LET 0134 00310 004067 MATIO DEF READ 0135 00311 004125 MCBOP DEF AND 0136 00312 004143 PDFNS DEF SIN 0137 00313 004204 MATFN DEF ZER 0138 00314 004035 ANEXT DEF NEXT 0139 00315 004064 ADATA DEF DATA 0140 00316 004112 ATHEN DEF THEN 0141 00317 004115 ATO DEF TO 0142 00320 004117 ASTEP DEF STEP 0143 00321 004122 ANOT DEF NOT 0144 00322 004140 ATAB DEF TAB 0145 00323 000171 MBXL DEF MLBX1 PAGE 0023 #01 BASE PAGE LINKS AND CONSTANTS 0147 00324 000001 .1 DEC 1 0148 00325 000002 .2 DEC 2 0149 00326 000003 .3 DEC 3 0150 00327 000004 .4 DEC 4 0151 00330 000006 .6 DEC 6 0152 00331 000007 .7 DEC 7 0153 00332 000010 .8 DEC 8 0154 00333 000011 .9 DEC 9 0155 00334 000012 .10 DEC 10 0156 00335 000014 .12 DEC 12 0157 00336 000017 .15 DEC 15 0158 00337 000027 .23 DEC 23 0159 00340 000032 .26 DEC 26 0160 00341 000033 .27 DEC 27 0161 00342 000034 .28 DEC 28 0162 00343 000036 .30 DEC 30 0163 00344 000037 .31 DEC 31 0164 00345 000040 .32 DEC 32 0165 00346 000041 .33 DEC 33 0166 00347 000042 .34 DEC 34 0167 00350 000045 .37 DEC 37 0168 00351 000050 .40 DEC 40 0169 00352 000051 .41 DEC 41 0170 00353 000053 .43 DEC 43 0171 00354 000055 .45 DEC 45 0172 00355 000056 .46 DEC 46 0173 00356 000057 .47 DEC 47 0174 00357 000060 .48 DEC 48 0175 00360 000061 .49 DEC 49 0176 00361 000072 .58 DEC 58 0177 00362 000077 .63 DEC 63 0178 00363 000100 B100 OCT 100 0179 00364 000105 E OCT 105 0180 00365 000106 F OCT 106 0181 00366 000110 .72 DEC 72 0182 00367 000112 .74 DEC 74 0183 00370 000113 .75 DEC 75 0184 00371 000116 N OCT 116 0185 00372 000123 S OCT 123 0186 00373 000133 B133 OCT 133 0187 00374 000177 B177 OCT 177 0188 00375 000200 B200 OCT 200 0189 00376 000377 MSK0 OCT 377 0190 00377 000400 B400 OCT 400 0191 00400 000776 B776 OCT 776 0192 00401 000777 MSK1 OCT 777 0193 00402 001000 B1000 OCT 1000 0194 00403 002000 B2000 OCT 2000 0195 00404 003000 B3000 OCT 3000 0196 00405 003002 SCCNT OCT 3002 0197 00406 004000 B4000 OCT 4000 0198 00407 005000 LF OCT 5000 0199 00410 014000 B1400 OCT 14000 0200 00411 021000 UNMNC OCT 21000 0201 00412 022000 B2200 OCT 22000 0202 00413 023000 B2300 OCT 23000 PAGE 0024 #01 BASE PAGE LINKS AND CONSTANTS 0203 00414 035000 DEFOP OCT 35000 0204 00415 036000 REMOP OCT 36000 0205 00416 052000 RDOP OCT 52000 0206 00417 063146 TENTH OCT 63146 0207 00420 077000 OPMSK OCT 77000 0208 00421 077600 MSK4 OCT 77600 0209 00422 077777 INF OCT 77777 0210 00423 100017 TYPFL OCT 100017 0211 00424 100037 TABCN OCT 100037 0212 00425 100777 OPDMK OCT 100777 0213 00426 130000 RMODE OCT 130000 0214 00427 140000 UNNRM OCT 140000 0215 00430 174000 HIMSK OCT 174000 0216 00431 177777 M1 DEC -1 0217 00432 177776 M2 DEC -2 0218 00433 177775 M3 DEC -3 0219 00434 177774 M4 DEC -4 0220 00435 177773 M5 DEC -5 0221 00436 177772 M6 DEC -6 0222 00437 177771 M7 DEC -7 0223 00440 177770 M8 DEC -8 0224 00441 177767 M9 DEC -9 0225 00442 177766 M10 DEC -10 0226 00443 177765 M11 DEC -11 0227 00444 177761 M15 DEC -15 0228 00445 177760 M16 DEC -16 0229 00446 177753 M21 DEC -21 0230 00447 177747 M25 DEC -25 0231 00450 177740 M32 DEC -32 0232 00451 177725 D53 OCT -53 0233 00452 177706 D72 OCT -72 0234 00453 177700 D100 OCT -100 0235 00454 177670 M72 DEC -72 0236 00455 177667 M73 DEC -73 0237 00456 177664 M76 DEC -76 0238 00457 177645 D133 OCT -133 0239 00460 177400 M256 DEC -256 0240 00461 177312 M310 DEC -310 0241 00462 176030 M1000 DEC -1000 0242 00463 154360 MAXSN DEC -10000 0243 00437 MSK3 EQU M7 0244 00464 043116 FN ASC 1,FN 0245 00465 037440 QMARK ASC 1,? 0246 00466 040000 HALF OCT 40000 0247 00467 000000 OCT 0 0248 00466 HONE EQU HALF 0249 00470 100000 MNEG OCT 100000 MAXIMUM NEGATIVE FLOATING 0250 00471 000376 OCT 376 POINT NUMBER 0251 00470 FLGBT EQU MNEG 0252 00472 102756 MAXFX DEC -999999.5 0253 00474 114631 MINFX DEC -0.099999959 0254 00476 000040 BLANK OCT 40 PAGE 0025 #01 BASE PAGE SUBROUTINES 0256** 0257*** EMIT ERROR MESSAGE ** 0258** 0259 00477 000000 ERROR NOP 0260 00500 060130 LDA TLSTR SHIFT TO 0261 00501 070127 STA LISTR COMMAND MODE 0262 00502 060133 LDA CCNT SAVE 0263 00503 071515 STA OPCHK OUTPUT 0264 00504 060132 LDA BADDR BUFFER 0265 00505 071536 STA RSCHK POINTERS 0266 00506 060274 LDA EBFA SET BUFFER 0267 00507 070132 STA BADDR POINTER 0268 00510 060332 LDA .8 SET CHARACTER 0269 00511 070133 STA CCNT COUNT 0270 00512 064477 LDB ERROR ERROR SOURCE IN (B) 0271 00513 060277 LDA ERBS ERROR ADDRESS IN (A) 0272 00514 002004 INA MOVE TO NEXT ERROR 0273 00515 154000 CPB 0,I SAME AS ACTUAL ERROR? 0274 00516 003005 CMA,INA,RSS YES 0275 00517 024514 JMP *-3 NO 0276 00520 040277 ADA ERBS COMPUTE ERROR 0277 00521 071643 STA ENOUT SAVE NEGATIVE OF ERROR 0278 00522 003004 CMA,INA NUMBER 0279 00523 114222 JSB OUTIA,I NUMBER TO BUFFER 0280 00524 064273 LDB EBUFA LOAD BUFFER ADDRESS 0281 00525 060133 LDA CCNT LOAD NEGATIVE OF 0282 00526 003004 CMA,INA CHARACTER COUNT 0283 00527 114102 JSB WRITE,I OUTPUT ERROR MESSAGE 0284 00530 060276 LDA LNBFA OUTPUT 0285 00531 070132 STA BADDR 0286 00532 060334 LDA .10 0287 00533 070133 STA CCNT LINE 0288 00534 060145 LDA .LNUM 0289 00535 114222 JSB OUTIA,I 0290 00536 064275 LDB LBUFA NUMBER 0291 00537 060133 LDA CCNT 0292 00540 114102 JSB WRITE,I 0293 00541 061643 LDA ENOUT RETRIEVE NEGATIVE OF ERROR 0294 00542 040300 ADA RECER RECOVERABLE 0295 00543 002021 SSA,RSS ERROR? 0296 00544 124204 JMP PEXMA,I NO, RETURN TO SYNTAX MODE 0297 00545 060426 LDA RMODE RETURN TO 0298 00546 070127 STA LISTR RUN MODE 0299 00547 061515 LDA OPCHK RESTORE 0300 00550 070133 STA CCNT OUTPUT 0301 00551 061536 LDA RSCHK BUFFER 0302 00552 070132 STA BADDR POINTERS 0303 00553 124477 JMP ERROR,I RETURN TO PROGRAM PAGE 0026 #01 BASE PAGE SUBROUTINES 0305** 0306*** MOVE WORDS TO HIGHER CORE ** 0307** 0308 00554 000000 MVTOH NOP 0309 00555 064162 LDB TEMP2 FETCH SOURCE ADDRESS 0310 00556 054163 MVTO1 CPB TEMP3 ALL RELOCATION DONE? 0311 00557 124554 JMP MVTOH,I YES, EXIT 0312 00560 003400 CCA BACK UP 0313 00561 040164 ADA TEMP4 SOURCE AND 0314 00562 070164 STA TEMP4 DESTINATION 0315 00563 044431 ADB M1 ADDRESSES 0316 00564 160001 LDA 1,I MOVE 0317 00565 170164 STA TEMP4,I WORD 0318 00566 024556 JMP MVTO1 0319** 0320*** INPUT A CONSTANT ** 0321** 0322 00567 000000 CONST NOP 0323 00570 015614 JSB GETCR 0324 00571 124567 JMP CONST,I 0325 00572 006400 CLB SET SIGN 0326 00573 074153 STB SIGN POSITIVE 0327 00574 006004 INB 0328 00575 050353 CPA .43 '+' ? 0329 00576 024602 JMP CONS1 YES 0330 00577 050354 CPA .45 NO, '-' ? 0331 00600 007401 CCB,RSS YES 0332 00601 024605 JMP CONS2 NO 0333 00602 074153 CONS1 STB SIGN RECORD SIGN 0334 00603 015614 JSB GETCR FETCH NEXT 0335 00604 024613 JMP SYE12-1 CHARACTER 0336 00605 014615 CONS2 JSB NUMCK FETCH CONSTANT 0337 00606 024611 JMP CONS3 NONE FOUND 0338 00607 034567 ISZ CONST SUCCESSFULLY FOUND, 0339 00610 124567 JMP CONST,I EXIT VIA (P+2) 0340 00611 054153 CONS3 CPB SIGN SIGN FOUND? ( (B) = 0) 0341 00612 003401 CCA,RSS NO 0342 00613 014477 JSB ERROR YES, SOLITARY SIGN 0343 00614 124567 SYE12 JMP CONST,I EXIT VIA (P+1) 0344** 0345*** FETCH NUMBER AND CONVERT TO BINARY ** 0346** 0347 00615 000000 NUMCK NOP CHARACTER IN (A), SIGN SET 0348 00616 006400 CLB 0349 00617 074154 STB EXP ZERO 0350 00620 075274 STB MANT1 ALL 0351 00621 075336 STB MANT2 COMPONENTS 0352 00622 075603 STB EXPON OF NUMBER 0353 00623 074163 STB TEMP3 SET 'NUMBER' FLAG FALSE 0354 00624 007400 CCB SET 'DECIMAL POINT' 0355 00625 075633 STB DPFLG FLAG FALSE 0356 00626 050355 NUMC1 CPA .46 DECIMAL POINT? 0357 00627 035633 ISZ DPFLG YES, SET FLAG TRUE 0358 00630 024634 JMP NUMC2 NO 0359 00631 002400 CLA INITIALIZE POST-DECIMAL DIGIT 0360 00632 071603 STA EXPON DIGIT COUNTER TO ZERO PAGE 0027 #01 BASE PAGE SUBROUTINES 0361 00633 024653 JMP NUMC3+1 FETCH A CHARACTER 0362 00634 015570 NUMC2 JSB DIGCK DIGIT? 0363 00635 024706 JMP NUMC7 NO 0364 00636 035603 ISZ EXPON YES, COUNT DIGIT 0365 00637 001727 ALF,ALF LEFT-JUSTIFY 0366 00640 001723 ALF,RAR DIGIT AND 0367 00641 070164 STA TEMP4 SAVE IT 0368 00642 015147 JSB MBY10 MULTIPLY PREVIOUS NUMBER BY 10 0369 00643 064154 LDB EXP 0370 00644 006002 SZB ZERO EXPONENT? 0371 00645 024657 JMP NUMC4 NO 0372 00646 060327 LDA .4 YES, SET 0373 00647 070154 STA EXP EXPONENT TO 4 0374 00650 060164 LDA TEMP4 LOAD 0375 00651 006400 CLB NUMBER 0376 00652 015113 NUMC3 JSB NORML NORMALIZE THE NUMBER 0377 00653 034163 ISZ TEMP3 SET 'NUMBER OCCURRED' FLAG 0378 00654 015614 JSB GETCR ANOTHER CHARACTER? 0379 00655 024755 JMP NUM12 NO 0380 00656 024626 JMP NUMC1 YES 0381 00657 044434 NUMC4 ADB M4 COMPUTE 0382 00660 007000 CMB EXPONENT 0383 00661 060164 LDA TEMP4 BIAS AND 0384 00662 074164 STB TEMP4 SAVE IT 0385 00663 006400 CLB 0386 00664 034164 NUMC5 ISZ TEMP4 DIGIT POSITIONED? 0387 00665 024703 JMP NUMC6 NO 0388 00666 000040 CLE YES, ADD IN 0389 00667 045336 ADB MANT2 LOW PART 0390 00670 103101 CLO OF NUMBER 0391 00671 002040 SEZ OVERFLOW? 0392 00672 002004 INA YES, BUMP (A) 0393 00673 041274 ADA MANT1 ADD IN HIGH PART OF NUMBER 0394 00674 102301 SOS OVERFLOW? 0395 00675 024652 JMP NUMC3 NO 0396 00676 000065 CLE,ERA YES, ROTATE 0397 00677 005500 ERB DOWN AND 0398 00700 034154 ISZ EXP BUMP 0399 00701 000000 NOP EXPONENT 0400 00702 024652 JMP NUMC3 0401 00703 000065 NUMC6 CLE,ERA SHIFT 0402 00704 005500 ERB DIGIT 0403 00705 024664 JMP NUMC5 RIGHT 0404 00706 006400 NUMC7 CLB DECIMAL POINT 0405 00707 074164 STB TEMP4 0406 00710 054163 CPB TEMP3 OR DIGIT FOUND? 0407 00711 124615 JMP NUMCK,I NO, EXIT VIA (P+1) 0408 00712 050364 CPA E YES, 'E' ? 0409 00713 002001 RSS YES 0410 00714 024755 JMP NUM12 NO, NO EXPONENT PART 0411 00715 015614 JSB GETCR 0412 00716 014477 NUMER JSB ERROR 0413 00717 050353 CPA .43 '+' ? 0414 00720 024725 JMP NUMC8 YES 0415 00721 050354 CPA .45 NO, '-' ? 0416 00722 003401 CCA,RSS YES PAGE 0028 #01 BASE PAGE SUBROUTINES 0417 00723 024727 JMP NUMC9 NO 0418 00724 070164 STA TEMP4 NOTE MINUS SIGN 0419 00725 015614 NUMC8 JSB GETCR 0420 00726 024716 JMP NUMER 0421 00727 015570 NUMC9 JSB DIGCK DIGIT? 0422 00730 024716 JMP NUMER NO 0423 00731 070163 STA TEMP3 YES, SAVE IT 0424 00732 015614 JSB GETCR 0425 00733 024751 JMP NUM10 SECOND 0426 00734 015570 JSB DIGCK DIGIT? 0427 00735 024751 JMP NUM10 NO 0428 00736 064163 LDB TEMP3 YES 0429 00737 005020 BLS,BLS MULTIPLY 0430 00740 044163 ADB TEMP3 PRIOR DIGIT 0431 00741 005000 BLS BY 10 0432 00742 040001 ADA 1 ADD NEW DIGIT 0433 00743 070163 STA TEMP3 SAVE EXPONENT 0434 00744 015614 JSB GETCR 0435 00745 024751 JMP NUM10 THIRD 0436 00746 015570 JSB DIGCK DIGIT? 0437 00747 002001 RSS NO 0438 00750 024716 JMP NUMER YES 0439 00751 060163 NUM10 LDA TEMP3 LOAD EXPONENT 0440 00752 034164 ISZ TEMP4 POSITIVE? 0441 00753 003004 CMA,INA YES, COMPLEMENT IT 0442 00754 002001 RSS NO 0443 00755 002400 NUM12 CLA CLEAR IF NO EXPONENT PART 0444 00756 035633 ISZ DPFLG DECIMAL POINT? 0445 00757 041603 ADA EXPON YES, CORRECT EXPONENT 0446 00760 002003 SZA,RSS ZERO EXPONENT? 0447 00761 024776 JMP NUM14 YES 0448 00762 002020 SSA NO, NEGATIVE EXPONENT? 0449 00763 024772 JMP NUM13 NO 0450 00764 003004 CMA,INA YES, SET 0451 00765 071603 STA EXPON COUNTER 0452 00766 015200 JSB DBY10 DIVIDE NUMBER BY 10 0453 00767 035603 ISZ EXPON DONE? 0454 00770 024766 JMP *-2 NO 0455 00771 024776 JMP NUM14 YES 0456 00772 071603 NUM13 STA EXPON SET COUNTER 0457 00773 015147 JSB MBY10 MULTIPLY BY 10 0458 00774 035603 ISZ EXPON DONE? 0459 00775 024773 JMP *-2 NO 0460 00776 061274 NUM14 LDA MANT1 YES, LOAD 0461 00777 065336 LDB MANT2 NUMBER 0462 01000 034153 ISZ SIGN POSITIVE? 0463 01001 025005 JMP NUM15 YES 0464 01002 003000 CMA NO, 0465 01003 007007 CMB,INB,SZB,RSS COMPLEMENT 0466 01004 002004 INA IT 0467 01005 015020 NUM15 JSB .PACK PACK NUMBER INTO (A) AND (B) 0468 01006 034135 ISZ SBPTR 0469 01007 170135 STA SBPTR,I STORE 0470 01010 034135 ISZ SBPTR NUMBER IN 0471 01011 174135 STB SBPTR,I PROPER 0472 01012 034135 ISZ SBPTR LOCATION PAGE 0029 #01 BASE PAGE SUBROUTINES 0473 01013 015633 JSB BCKSP FETCH 0474 01014 015614 JSB GETCR FIRST 0475 01015 060334 LDA .10 UNUSED CHARACTER 0476 01016 034615 ISZ NUMCK RETURN 0477 01017 124615 JMP NUMCK,I VIA (P+2) 0478** 0479*** NORMALIZE AND PACK FLOATING POINT NUMBER ** 0480** 0481 01020 000000 .PACK NOP MANTISSA IN (A) AND (B), 0482 01021 015113 JSB NORML EXPONENT IN EXP, (E) CLEARED 0483 01022 002103 CLE,SZA,RSS ZERO RESULT? 0484 01023 125020 JMP .PACK,I YES 0485 01024 044374 ADB B177 NO, ROUND 0486 01025 002021 SSA,RSS POSITIVE NUMBER? 0487 01026 006004 INB YES, FINISH ROUND 0488 01027 103101 CLO 0489 01030 002040 SEZ OVERFLOW FROM (B)? 0490 01031 002104 CLE,INA YES, BUMP (A) 0491 01032 102301 SOS OVERFLOW? (A=100000, B=0) 0492 01033 001200 RAL 0493 01034 002031 SSA,SLA,RSS TWO HIGH BITS 1'S? (A=140000) 0494 01035 025040 JMP PACK1 NO 0495 01036 002300 CCE YES 0496 01037 001130 ARS,SLA,ALS SET (A) =100000 AND SKIP 0497 01040 001300 PACK1 RAR COUNTERPART TO *-5 0498 01041 071147 STA MBY10 SAVE (A) 0499 01042 060001 LDA 1 DELETE 8 LOW 0500 01043 010460 AND M256 ORDER BITS OF MANTISSA 0501 01044 070001 STA 1 SAVE LOWER MANTISSA 0502 01045 060154 LDA EXP FETCH EXPONENT 0503 01046 002040 SEZ DECREMENT EXPONENT? 0504 01047 040431 ADA M1 YES 0505 01050 102201 SOC NO, PRIOR OVERFLOW? 0506 01051 002004 INA YES, INCREMENT EXPONENT 0507 01052 040375 ADA B200 NO, EXPONENT 0508 01053 002020 SSA UNDERFLOW? 0509 01054 025073 JMP PACK3 YES 0510 01055 040460 ADA M256 NO, EXPONENT 0511 01056 002021 SSA,RSS OVERFLOW? 0512 01057 025077 JMP PACK4 YES 0513 01060 040375 ADA B200 NO, RESTORE EXPONENT, 0514 01061 001200 RAL POSITION SIGN, 0515 01062 010376 AND MSK0 MASK TO 8 BITS, AND 0516 01063 044000 ADB 0 COMBINE WITH LOW MANTISSA 0517 01064 061147 LDA MBY10 RETRIEVE HIGH MANTISSA 0518 01065 050470 CPA MNEG 0519 01066 002001 RSS NEGATIVE 0520 01067 125020 JMP .PACK,I 0521 01070 054471 CPB MNEG+1 OVERFLOW? 0522 01071 025077 JMP PACK4 YES 0523 01072 125020 JMP .PACK,I NO 0524 01073 014477 PACK3 JSB ERROR 0525 01074 002400 UNDER CLA ZERO RESULT 0526 01075 006400 CLB ON UNDERFLOW 0527 01076 125020 JMP .PACK,I 0528 01077 014477 PACK4 JSB ERROR PAGE 0030 #01 BASE PAGE SUBROUTINES 0529 01100 061147 OVRER LDA MBY10 0530 01101 015103 JSB OVFLW 0531 01102 125020 JMP .PACK,I 0532** 0533*** LOAD INFINITY ON OVERFLOW ** 0534** 0535 01103 000000 OVFLW NOP 0536 01104 064432 LDB M2 LOAD 0537 01105 002020 SSA APPROPRIATE 0538 01106 064400 LDB B776 LOW MANTISSA 0539 01107 030422 IOR INF LOAD 0540 01110 002020 SSA APPROPRIATE 0541 01111 060470 LDA MNEG HIGH MANTISSA 0542 01112 125103 JMP OVFLW,I 0543** 0544*** NORMALIZE (A), (B), AND EXP ** 0545** 0546 01113 000000 NORML NOP SET 0547 01114 071147 STA MBY10 LEFT-SHIFT 0548 01115 002400 CLA COUNTER 0549 01116 071236 STA MPY TO ZERO 0550 01117 061147 LDA MBY10 0551 01120 002003 SZA,RSS ON 0552 01121 006002 SZB ZERO 0553 01122 025130 JMP NORM3 CLEAR 0554 01123 070154 STA EXP EVERYTHING 0555 01124 071274 STA MANT1 STORE 0556 01125 075336 NORM1 STB MANT2 MANTISSA 0557 01126 125113 JMP NORML,I AND RETURN 0558 01127 035236 NORM2 ISZ MPY COUNT LEFT SHIFTS 0559 01130 004066 NORM3 CLE,ELB ROTATE (A) AND 0560 01131 001600 ELA (B) LEFT INTO (E) 0561 01132 002061 SEZ,SSA,RSS TWO HIGHEST BITS 0? 0562 01133 025127 JMP NORM2 YES, + UNNORMALIZED 0563 01134 002060 SEZ,SSA NO, TWO HIGHEST BITS 1? 0564 01135 025127 JMP NORM2 YES, - UNNORMALIZED 0565 01136 001500 ERA SHIFT TO 0566 01137 005540 ERB,CLE NORMALIZE MANTISSA 0567 01140 071274 STA MANT1 NO, 0568 01141 061236 LDA MPY COMPUTE 0569 01142 003004 CMA,INA CORRECTED 0570 01143 040154 ADA EXP EXPONENT 0571 01144 070154 STA EXP VALUE 0572 01145 061274 LDA MANT1 0573 01146 025125 JMP NORM1 0574** 0575*** MULTIPLY UNPACKED NUMBER BY 10 ** 0576** 0577 01147 000000 MBY10 NOP 0578 01150 061274 LDA MANT1 RETURN ON 0579 01151 002003 SZA,RSS ZERO 0580 01152 125147 JMP MBY10,I MANTISSA 0581 01153 064154 LDB EXP MULTIPLY 0582 01154 044326 ADB .3 BY 0583 01155 074154 STB EXP 8 0584 01156 065336 LDB MANT2 LOAD MANTISSA PAGE 0031 #01 BASE PAGE SUBROUTINES 0585 01157 000065 CLE,ERA DIVIDE 0586 01160 005500 ERB BY 0587 01161 000065 CLE,ERA 4 0588 01162 005540 ERB,CLE 0589 01163 045336 ADB MANT2 DOUBLE 0590 01164 002040 SEZ ADD TO 0591 01165 002004 INA PRODUCE 0592 01166 041274 ADA MANT1 1.25 * MANTISSA 0593 01167 002021 SSA,RSS CORRECT 0594 01170 025175 JMP *+5 0595 01171 000065 CLE,ERA ON 0596 01172 005500 ERB 0597 01173 034154 ISZ EXP OVERFLOW 0598 01174 000000 NOP 0599 01175 071274 STA MANT1 0600 01176 075336 STB MANT2 0601 01177 125147 JMP MBY10,I 0602** 0603*** DIVIDE UNPACKED NUMBER BY 10 ** 0604** 0605 01200 000000 DBY10 NOP MULTIPLY BY DOUBLE-LENGTH TENTH 0606 01201 061274 LDA MANT1 RETURN 0607 01202 002003 SZA,RSS ON ZERO 0608 01203 125200 JMP DBY10,I MANTISSA 0609 01204 064432 LDB M2 ADD EXPONENT OF 0610 01205 044154 ADB EXP 'TENTH' TO 0611 01206 074154 STB EXP MANTISSA EXPONENT 0612 01207 061336 LDA MANT2 JUSTIFY 0613 01210 000065 CLE,ERA LOWER MANTISSA 0614 01211 015236 JSB MPY MULTIPLY BY 0615 01212 000417 DEF TENTH 63146 (ONE-TENTH) 0616 01213 000066 CLE,ELA SHIFT 0617 01214 005640 ELB,CLE BACK 0618 01215 040001 ADA 1 ADD IN LOWER MANTISSA* 0619 01216 002040 SEZ TENTH*(2)-16 0620 01217 006004 INB AND ROUND 0621 01220 075336 STB MANT2 TO 16 BITS 0622 01221 061274 LDA MANT1 DO 0623 01222 015236 JSB MPY SAME 0624 01223 000417 DEF TENTH FOR 0625 01224 000040 CLE HIGH 0626 01225 040001 ADA 1 MANTISSA 0627 01226 041336 ADA MANT2 (EFFECTIVELY) SUM 0628 01227 002040 SEZ DOUBLE-LENGTH 0629 01230 006004 INB PRODUCTS 0630 01231 075274 STB MANT1 EXCHANGE 0631 01232 070001 STA 1 (A) AND (B) 0632 01233 061274 LDA MANT1 REGISTERS 0633 01234 015113 JSB NORML NORMALIZE RESULT 0634 01235 125200 JMP DBY10,I PAGE 0032 #02 BASE PAGE SUBROUTINES 0001** 0002*** MULTIPLY INTEGER IN (A) ** 0003** 0004 01236 000000 MPY NOP ADDRESS OF MULTIPLIER IN MPY,I 0005 01237 064432 LDB M2 SET -2 IN 0006 01240 075147 STB MBY10 SIGN TEMP 0007 01241 165236 LDB MPY,I LOAD 0008 01242 164001 LDB 1,I MULTIPLIER 0009 01243 002120 CLE,SSA (A) NEGATIVE? 0010 01244 003204 CMA,CME,INA YES, COMPLEMENT (A) AND (E) 0011 01245 006020 SSB (B) NEGATIVE? 0012 01246 007204 CMB,CME,INB YES, COMPLEMENT (B) AND (E) 0013 01247 002040 SEZ (E) = 0? 0014 01250 035147 ISZ MBY10 NO, SET SIGN OF RESULT NEGATIVE 0015 01251 075113 STB NORML SAVE MULTIPLIER 0016 01252 064445 LDB M16 SET 0017 01253 074554 STB MVTOH COUNTER 0018 01254 006400 CLB ZERO PRODUCT 0019 01255 001600 ELA BIAS (A) TO LEFT 0020 01256 001550 MPY1 ERA,CLE,SLA SHIFT, TEST, 0021 01257 045113 ADB NORML AND ADD UPON 0022 01260 005500 ERB NON-ZERO BIT 0023 01261 034554 ISZ MVTOH DONE? 0024 01262 025256 JMP MPY1 NO 0025 01263 001540 ERA,CLE YES, ADJUST FINAL RESULT 0026 01264 035147 ISZ MBY10 NEGATIVE RESULT? 0027 01265 025271 JMP MPY2 NO 0028 01266 007000 CMB YES, 0029 01267 003007 CMA,INA,SZA,RSS COMPLEMENT 0030 01270 006004 INB RESULT 0031 01271 103101 MPY2 CLO 0032 01272 035236 ISZ MPY 0033 01273 125236 JMP MPY,I 0034** 0035*** FIND AND STORE ONE-CHARACTER OPERATORS ** 0036** 0037 01274 000000 SYMCK NOP CHARACTER IN (A) 0038 01275 074165 STB COUNT -(ENTRIES TO BE SEARCHED) 0039 01276 001727 ALF,ALF POSITION 0040 01277 030345 IOR .32 CHARACTER 0041 01300 165274 LDB SYMCK,I STARTING TABLE ENTRY - 2 0042 01301 035274 ISZ SYMCK SET RETURN ADDRESS 0043 01302 044325 SYMC1 ADB .2 UPDATE TABLE POINTER 0044 01303 150001 CPA 1,I MATCH? 0045 01304 025312 JMP SYMC2 0046 01305 034165 ISZ COUNT NO, CONTINUE SEARCH? 0047 01306 025302 JMP SYMC1 YES 0048 01307 001727 ALF,ALF NO, RESTORE 0049 01310 010374 AND B177 CHARACTER 0050 01311 125274 JMP SYMCK,I AND EXIT 0051 01312 003400 SYMC2 CCA GET 0052 01313 040001 ADA 1 INFORMATION 0053 01314 160000 LDA 0,I WORD 0054 01315 010420 AND OPMSK AND 0055 01316 170135 STA SBPTR,I STORE IT 0056 01317 050410 CPA B1400 PAGE 0033 #02 BASE PAGE SUBROUTINES 0057 01320 124257 JMP FSC1A,I 0058 01321 035274 ISZ SYMCK RETURN VIA 0059 01322 125274 JMP SYMCK,I (P+2) 0060** 0061*** FIND CALLED SUBROUTINE ** 0062** 0063 01323 000000 FNDSB NOP 0064 01324 074162 STB TEMP2 SAVE SUBROUTINE NUMBER 0065 01325 064121 LDB ASBTB LOAD (B) WITH SUBROUTINE TABLE 0066 01326 054122 FNDS1 CPB SBTBE END OF TABLE? 0067 01327 014477 JSB ERROR YES 0068 01330 160001 CALER LDA 1,I NO, EXTRACT 0069 01331 010362 AND .63 SUBROUTINE NUMBER 0070 01332 050162 CPA TEMP2 DESIRED ONE? 0071 01333 125323 JMP FNDSB,I YES 0072 01334 044325 ADB .2 NO, MOVE TO 0073 01335 025326 JMP FNDS1 NEXT TABLE ENTRY 0075* ************************************************ 0076* SUBROUTINE TO COMPUTE THE STORAGE REQUIRED BY AN 0077* ARRAY WHOSE PACKED DIMENSIONS ARE IN A UPON ENTRY 0078* ************************************************ 0079* 0080* THE SUBROUTINE RETURNS IN A THE NUMBER OF LOCATIONS 0081* REQUIRED FOR THE SPECIFIED DIMENSIONS 0082* = 2*DIM1*DIM2 0083* 0084 01336 000000 MDIM NOP 0085 01337 070001 STA 1 STORE PACKED DIMS. TEMPORALILY 0086 01340 010376 AND MSK0 0087 01341 071456 STA .FLUN STORE # OF COLUMNS 0088 01342 060001 LDA 1 0089 01343 001727 ALF,ALF 0090 01344 010376 AND MSK0 A = # OF ROWS 0091 01345 001000 ALS DOUBLE FOR FLOATING POINT 0092 01346 015236 JSB MPY 0093 01347 001456 DEF .FLUN COMPUTE 2*ROWS*COLUMNS 0094 01350 002020 SSA RESULT < 32768 ? 0095 01351 014477 JSB ERROR NO, ERROR DIMENSIONS TOO LARGE 0096 01352 125336 MER9 JMP MDIM,I YES, RETURN PAGE 0034 #02 BASE PAGE SUBROUTINES 0098** 0099*** ROUND A SUBSCRIPT TO AN INTEGER ** 0100** 0101* 0102* RETURNS INTEGER IN (1,32767) (BIASED BY -1) 0103* OR EXITS TO ERROR. 0104* 0105 01353 000000 SBFIX NOP SUBSCRIPT IN (A) AND (B) 0106 01354 015364 JSB IFIX 24-BIT INTEGER? 0107 01355 124272 JMP E6M1A,I NO 0108 01356 002041 SEZ,RSS YES, ROUND AND 0109 01357 044431 ADB M1 BIAS BY -1 0110 01360 002003 SZA,RSS 15-BIT 0111 01361 006020 SSB POSITIVE INTEGER? 0112 01362 124272 JMP E6M1A,I NO 0113 01363 125353 JMP SBFIX,I YES 0114** 0115*** INTEGERIZE FLOATING POINT NUMBER ** 0116** 0117 01364 000000 IFIX NOP 0118 01365 102101 STO 0119 01366 071614 STA GETCR SAVE (A) 0120 01367 015456 JSB .FLUN EXPONENT 0121 01370 002020 SSA NON-NEGATIVE? 0122 01371 025414 JMP IFIX3 NO 0123 01372 040445 ADA M16 YES, EXPONENT 0124 01373 002020 SSA <= 15? 0125 01374 103101 CLO YES 0126 01375 040440 ADA M8 EXPONENT 0127 01376 002021 SSA,RSS <= 23? 0128 01377 125364 JMP IFIX,I NO, ALL SIGNIFICANCE IS INTEGER 0129 01400 040440 ADA M8 MOVE BINARY POINT TO END OF (B) 0130 01401 071456 STA .FLUN SAVE SHIFT COUNT 0131 01402 061614 LDA GETCR RETRIEVE (A) 0132 01403 025410 JMP IFIX2 0133 01404 000071 IFIX1 CLE,SLA,ARS SHIFT (A) RIGHT 0134 01405 002200 CME SHIFT (B) 0135 01406 004035 SLB,ERB RIGHT 0136 01407 102101 STO NOTE IF A 1 IS LOST 0137 01410 035456 IFIX2 ISZ .FLUN DONE? 0138 01411 025404 JMP IFIX1 NO 0139 01412 035364 ISZ IFIX YES 0140 01413 125364 JMP IFIX,I 0141 01414 061614 IFIX3 LDA GETCR RETRIEVE (A) 0142 01415 002120 CLE,SSA TRUNCATE 0143 01416 003401 CCA,RSS TO 0144 01417 002401 CLA,RSS -1 0145 01420 007401 CCB,RSS OR 0146 01421 006400 CLB 0 0147 01422 025412 JMP IFIX2+2 PAGE 0035 #02 BASE PAGE SUBROUTINES 0149** 0150*** TAKE ARITHMETIC INVERSE ** 0151** 0152 01423 000000 ARINV NOP NUMBER IN (A) AND (B) 0153 01424 071677 STA OUTLN SWAP 0154 01425 060001 LDA 1 0155 01426 065677 LDB OUTLN REGISTERS 0156 01427 007100 CMB,CLE COMPLEMENT HIGH PART 0157 01430 020460 XOR M256 COMPLEMENT LOW PART 0158 01431 040377 ADA B400 ADD IN 1 0159 01432 002041 SEZ,RSS OVERFLOW? 0160 01433 025452 JMP ARIN2 NO 0161 01434 006004 INB YES, INCREMENT HIGH MANTISSA 0162 01435 054470 CPB FLGBT OVERFLOW? 0163 01436 025442 JMP ARIN1 YES 0164 01437 054427 CPB UNNRM NO, NEGATIVE UNNORMALIZED? 0165 01440 002001 RSS YES 0166 01441 025452 JMP ARIN2 NO 0167 01442 044427 ARIN1 ADB UNNRM FIX HIGH MANTISSA 0168 01443 000033 SLA,RAR POSITION EXPONENT 0169 01444 030421 IOR MSK4 FILL IN BITS IF NEGATIVE 0170 01445 006021 SSB,RSS POSITIVE? 0171 01446 002005 INA,RSS YES, BUMP EXPONENT 0172 01447 040431 ADA M1 NO, DECREMENT EXPONENT 0173 01450 001200 RAL POSITION 0174 01451 010376 AND MSK0 EXPONENT 0175 01452 071677 ARIN2 STA OUTLN SWAP 0176 01453 060001 LDA 1 0177 01454 065677 LDB OUTLN REGISTERS 0178 01455 125423 JMP ARINV,I 0179** 0180*** UNPACK LOW WORD OF NUMBER ** 0181** 0182 01456 000000 .FLUN NOP WORD IN (B) 0183 01457 060001 LDA 1 (A) = (B) 0184 01460 010376 AND MSK0 EXTRACT EXPONENT IN (A) 0185 01461 007000 CMB SUBTRACT OFF 0186 01462 044000 ADB 0 EXPONENT FROM 0187 01463 007000 CMB MANTISSA IN (B) 0188 01464 000033 SLA,RAR NEGATIVE EXPONENT? 0189 01465 030421 IOR MSK4 YES, FILL IN LEADING BITS 0190 01466 125456 JMP .FLUN,I NO 0191** 0192*** STACK (B) ON LOW-CORE STACK ** 0193** 0194 01467 000000 SLWST NOP 0195 01470 034141 ISZ LSTPT ADVANCE 'LOW 0196 01471 060141 LDA LSTPT STACK' POINTER 0197 01472 050142 CPA HSTPT STACK OVERFLOW? 0198 01473 014477 E1 JSB ERROR YES 0199 01474 174141 STB LSTPT,I NO, STACK (B) 0200 01475 125467 JMP SLWST,I PAGE 0036 #02 BASE PAGE SUBROUTINES 0202** 0203*** BUMP HIGH STACK POINTER ** 0204** 0205 01476 000000 BHSTP NOP 0206 01477 007400 CCB ADVANCE 0207 01500 044142 ADB HSTPT 0208 01501 074142 STB HSTPT POINTER 0209 01502 054141 CPB LSTPT OVERFLOW? 0210 01503 025473 JMP E1 YES 0211 01504 125476 JMP BHSTP,I NO 0212** 0213*** FETCH TOP OF STACK ** 0214** 0215 01505 000000 STTOP NOP 0216 01506 015515 JSB OPCHK VALIDATE 0217 01507 015536 JSB RSCHK OPERAND 0218 01510 164142 LDB HSTPT,I SAVE 0219 01511 160001 LDA 1,I LOAD 0220 01512 006004 INB 0221 01513 164001 LDB 1,I NUMBER 0222 01514 125505 JMP STTOP,I 0223** 0224*** VERIFY LEGITIMACY OF OPERAND ** 0225** 0226 01515 000000 OPCHK NOP 0227 01516 164142 LDB HSTPT,I OPERAND ADDRESS TO (B) 0228 01517 160001 LDA 1,I HIGH PART OF 0229 01520 050470 CPA MNEG OPERAND 100000B? 0230 01521 006005 INB,RSS YES 0231 01522 025527 JMP OPCH1 NO 0232 01523 160001 LDA 1,I LOW PART 0233 01524 050471 CPA MNEG+1 776B? 0234 01525 014477 JSB ERROR YES 0235 01526 044431 E8 ADB M1 0236 01527 054140 OPCH1 CPB TSTPT TEMPORARY OPERAND? 0237 01530 002001 RSS YES 0238 01531 125515 JMP OPCHK,I NO 0239 01532 060140 LDA TSTPT UNSTACK 0240 01533 040432 ADA M2 THE TEMPORARY 0241 01534 070140 STA TSTPT OPERAND 0242 01535 125515 JMP OPCHK,I EXIT WITH ADDRESS IN (B) 0243** 0244*** ALLOT SPACE FOR INTERMEDIATE RESULT ** 0245** 0246 01536 000000 RSCHK NOP 0247 01537 060140 LDA TSTPT ALLOT 0248 01540 040325 ADA .2 0249 01541 070140 STA TSTPT SPACE 0250 01542 040431 ADA M1 OVERFLOW INTO 0251 01543 050120 CPA LSTAK LOW-CORE STACK? 0252 01544 002001 RSS YES 0253 01545 125536 JMP RSCHK,I NO 0254 01546 060120 LDA LSTAK SAVE 0255 01547 002004 INA LOWER 0256 01550 070163 STA TEMP3 STACK BOUND 0257 01551 040333 ADA .9 UPDATE PAGE 0037 #02 BASE PAGE SUBROUTINES 0258 01552 070120 STA LSTAK STACK BOTTOM 0259 01553 060141 LDA LSTPT SET 0260 01554 002004 INA SOURCE 0261 01555 070162 STA TEMP2 ADDRESS 0262 01556 040333 ADA .9 UPDATE 0263 01557 070141 STA LSTPT STACK TOP 0264 01560 002004 INA SET DESTINATION 0265 01561 070164 STA TEMP4 ADDRESS 0266 01562 003004 CMA,INA OVERFLOW 0267 01563 040142 ADA HSTPT INTO 0268 01564 002020 SSA HIGH-CORE STACK? 0269 01565 025473 JMP E1 YES 0270 01566 014554 JSB MVTOH NO, MOVE 0271 01567 125536 JMP RSCHK,I LOW-CORE STACK 0272** 0273*** CHECK FOR DIGIT ** 0274** 0275 01570 000000 DIGCK NOP CHARACTER IN (A) 0276 01571 064000 LDB 0 0277 01572 044452 ADB D72 ASCII 72B 0278 01573 006021 SSB,RSS OR GREATER? 0279 01574 125570 JMP DIGCK,I YES, RETURN WITH CHARACTER 0280 01575 044334 ADB .10 NO, ASCII 60B 0281 01576 006020 SSB OR GREATER? 0282 01577 125570 JMP DIGCK,I NO 0283 01600 035570 ISZ DIGCK YES, SET 'SUCCESS' EXIT, 0284 01601 060001 LDA 1 LOAD DIGIT INTO (A), 0285 01602 125570 JMP DIGCK,I AND RETURN 0286** 0287*** CHECK FOR LETTER ** 0288** 0289 01603 000000 LETCK NOP CHARACTER IN (A) 0290 01604 064000 LDB 0 0291 01605 044457 ADB D133 ASCII 133B 0292 01606 006021 SSB,RSS OR GREATER? 0293 01607 125603 JMP LETCK,I YES, EXIT WITH CHARACTER IN (A) 0294 01610 044340 ADB .26 NO, ASCII 101B 0295 01611 006021 SSB,RSS OR GREATER? 0296 01612 035603 ISZ LETCK YES 0297 01613 125603 JMP LETCK,I NO 0298* 0299* ON END-OF-FILE CONDITION RETURN TO P+1 ELSE 0300* RETURN TO P+2 WITH NON-BLANK CHARACTER IN (A) 0301* 0302 01614 000000 GETCR NOP 0303 01615 034133 ISZ CCNT ANY CHARACTERS LEFT? 0304 01616 002001 RSS 0305 01617 125614 JMP GETCR,I NO, END-OF-FILE EXIT 0306 01620 064132 LDB BADDR LOAD BUFFER ADDRESS 0307 01621 034132 ISZ BADDR UPDATE FOR NEXT TIME 0308 01622 004065 CLE,ERB SET CHARACTER FLAG 0309 01623 160001 LDA 1,I LOAD CURRENT BUFFER WORD 0310 01624 002041 SEZ,RSS FIRST CHARACTER? 0311 01625 001727 ALF,ALF YES, POSITION IT 0312 01626 010374 AND B177 MASK EXTRANEOUS BITS 0313 01627 050476 CPA BLANK BLANK? PAGE 0038 #02 BASE PAGE SUBROUTINES 0314 01630 025615 JMP GETCR+1 YES, FETCH NEXT CHARACTER 0315 01631 035614 ISZ GETCR UPDATE RETURN ADDRESS 0316 01632 125614 JMP GETCR,I AND EXIT 0317** 0318*** BACKSPACE OVER ONE CHARACTER ** 0319** 0320 01633 000000 BCKSP NOP 0321 01634 003400 CCA BACKSPACE 0322 01635 040133 ADA CCNT OVER 0323 01636 070133 STA CCNT LAST 0324 01637 003400 CCA CHARACTER IN 0325 01640 040132 ADA BADDR INPUT 0326 01641 070132 STA BADDR BUFFER 0327 01642 125633 JMP BCKSP,I 0328** 0329*** PRINT A NUMBER ** 0330** 0331 01643 000000 ENOUT NOP 0332 01644 002300 CCE SET SIGN FLAG TRUE 0333 01645 114220 JSB NUMOA,I OUTPUT THE NUMBER 0334 01646 015677 JSB OUTLN END-OF-LINE ACTION 0335 01647 060345 LDA .32 OUTPUT 0336 01650 015715 JSB OUTCR A BLANK 0337 01651 064172 LDB MLBX1+1 FIELD 0338 01652 044133 ADB CCNT 0339 01653 006002 SZB FULL? 0340 01654 025647 JMP *-5 NO 0341 01655 125643 JMP ENOUT,I 0342** 0343*** SPACE FOR A COMMA ** 0344** 0345 01656 000000 EDELM NOP 0346 01657 064133 LDB CCNT NO, LOAD CHARACTER COUNT 0347 01660 006003 EDEL1 SZB,RSS ZERO? 0348 01661 125656 JMP EDELM,I YES 0349 01662 044444 ADB M15 NO, SUBTRACT ZONE WIDTH 0350 01663 006021 SSB,RSS NEGATIVE RESULT? 0351 01664 025660 JMP EDEL1 NO 0352 01665 075677 STB OUTLN YES, SAVE BLANK COUNT 0353 01666 060345 LDA .32 FETCH BLANK 0354 01667 015715 JSB OUTCR OUTPUT 0355 01670 035677 ISZ OUTLN 0356 01671 025666 JMP *-3 BLANKS 0357 01672 064133 LDB CCNT LINE 0358 01673 044456 ADB M76 0359 01674 006021 SSB,RSS FULL? 0360 01675 015677 JSB OUTLN YES 0361 01676 125656 JMP EDELM,I PAGE 0039 #02 BASE PAGE SUBROUTINES 0363** 0364*** OUTPUT A COMPLETED LINE ** 0365** 0366 01677 000000 OUTLN NOP 0367 01700 060146 LDA TYPE FETCH 'CHARACTERS PRINTED' COUNT 0368 01701 000010 SLA CORRECT FOR START ON 0369 01702 002004 INA ODD PRINT POSITION 0370 01703 040133 ADA CCNT OUTPUT 0371 01704 064131 LDB .BUFA A 0372 01705 114102 JSB WRITE,I LINE 0373 01706 064172 LDB MLBX1+1 CORRECT 0374 01707 044133 ADB CCNT 0375 01710 074172 STB MLBX1+1 MARKER 0376 01711 002400 CLA RESET COUNT OF 0377 01712 070146 STA TYPE CHARACTERS PRINTED 0378 01713 114250 JSB PRNIA,I CLEAN UP 0379 01714 125677 JMP OUTLN,I 0380** 0381*** ADD A CHARACTER TO OUTPUT BUFFER ** 0382** 0383 01715 000000 OUTCR NOP CHARACTER IN (A) 0384 01716 071364 STA IFIX SAVE CHARACTER 0385 01717 034133 ISZ CCNT COUNT IT 0386 01720 064133 LDB CCNT FIRST CHARACTER 0387 01721 004010 SLB OF BUFFER WORD? 0388 01722 034132 ISZ BADDR YES, MOVE TO FRESH WORD 0389 01723 160132 LDA BADDR,I LOAD BUFFER WORD 0390 01724 004010 SLB SAVE 0391 01725 001727 ALF,ALF OTHER 0392 01726 010460 AND M256 CHARACTER 0393 01727 031364 IOR IFIX ADD NEW CHARACTER 0394 01730 004010 SLB POSITION 0395 01731 001727 ALF,ALF WORD AND 0396 01732 170132 STA BADDR,I STORE IT 0397 01733 125715 JMP OUTCR,I 0398* 0399* 0400 00160 TEMP EQU TEMPS+1 0401 00161 TEMP1 EQU TEMPS+2 0402 00162 TEMP2 EQU TEMPS+3 0403 00163 TEMP3 EQU TEMPS+4 0404 00164 TEMP4 EQU TEMPS+5 0405 00165 COUNT EQU TEMPS+6 0406 00163 STEMP EQU TEMPS+4 0407 01274 MANT1 EQU SYMCK 0408 01336 MANT2 EQU MDIM 0409 01603 EXPON EQU LETCK 0410 01633 DPFLG EQU BCKSP 0411 01715 ARYAD EQU OUTCR 0412 00567 EOL EQU CONST 0413 01734 FINBP EQU * FIRST UNUSED WORD OF BASE PAGE PAGE 0040 #02 BASIC INTEPRETER CONTROL 0415* 0416*************** BASIC INTERPRETER CONTROL ************************* 0417* 0418* THIS PROGRAM INTERPRETS THE SYSTEM COMMANDS AND PROVIDES 0419* I/O CONTROL FOR THE BASIC INTERPRETER. ALL USER 0420* COMMUNICATION IS DONE THRU THIS PROGRAM. USER RESPONSES ARE 0421* CHECKED FOR SYSTEM COMMANDS AND IF A VALID COMMAND IS 0422* DETECTED THIS PROGRAM INITIATES APPROPRIATE ACTION. 0423* 0424 02000 ORG 2000B 0425* 0426* DATA LOCAL TO MONITOR 0427* 0428 02000 002001 RDYA DEF READY 0429 02001 051105 READY ASC 2,READ 0430 02003 054415 OCT 54415 0431 02004 000407 LFEED DEF LF 0432 02005 000465 QMRKA DEF QMARK 0433 02006 003776 STOPA DEF STCMD 0434 02007 002146 CMNDA DEF CMNDS 0435* 0436 02010 107700 ENTRY CLC 0,C STARTING POINT, TURN OFF ALL I/O 0437 02011 102100 STF 0 TURN ON INTERRUPT SYSTEM 0438 02012 060106 LDA LWBM LOADED 0439 02013 050111 CPA LWAM BY 'BOSS'? 0440 02014 026020 JMP FLUSH NO 0441 02015 070111 STA LWAM YES, RESET 0442 02016 002004 INA POINTER 0443 02017 070117 STA SYMTA VALUES 0444* 0445 02020 060110 FLUSH LDA FWAM 0446 02021 070112 STA PBUFF SET PROGRAM BUFFER ADDRESS 0447 02022 070113 STA PBPTR SET PROGRAM BUFFER POINTER 0448 02023 060345 LDA .32 INITIALIZE 0449 02024 070476 STA BLANK DELETE CHARACTER FOR GETCR 0450 02025 002400 CLA SET LINE NUMBER 0451 02026 070145 STA .LNUM TO 0 INITIALLY 0452* 0453 02027 060130 RDYPT LDA TLSTR SET TO 0454 02030 070127 STA LISTR COMMAND MODE 0455 02031 002400 CLA 0456 02032 072121 STA DRQST CLEAR DATA REQUEST FLAG 0457 02033 070136 STA TFLAG CLEAR PHOTO READER INPUT FLAG 0458 02034 070137 STA TTYFL CLEAR TTY TAPE FLAG 0459 02035 114102 JSB WRITE,I DO A RETURN AND LINE FEED. 0460 02036 060436 LDA M6 0461 02037 066000 LDB RDYA 0462 02040 114102 JSB WRITE,I PRINT *READY* ON TTY 0463* 0464 02041 060130 PEXMK LDA TLSTR SHIFT TO 0465 02042 070127 STA LISTR COMMAND MODE 0466 02043 060136 LDA TFLAG 0467 02044 002002 SZA IS TAPE FLAG SET? 0468 02045 026161 JMP PTAPE+1 YES, GET RECORD FROM PHOTO RDR PAGE 0041 #02 BASIC INTEPRETER CONTROL 0470 02046 066004 DATAI LDB LFEED LOAD ADDRESS OF LINE FEED 0471 02047 074152 STB RSYM STORE ADDRESS OF READY SYMBOL 0472 02050 060137 LDA TTYFL TTY TAPE 0473 02051 002002 SZA INPUT? 0474 02052 026056 JMP GTRCD YES, SUPPRESS LINE FEED 0475 02053 003400 CCA NO 0476 02054 064152 LDB RSYM LOAD LF OR '?' ADDRESS 0477 02055 114102 JSB WRITE,I PRINT LF OR '?', NO CR-LF 0478* 0479 02056 114123 GTRCD JSB IMOFF,I TURN OFF KEYBOARD INTERRUPT MODE 0480 02057 060366 LDA .72 0481 02060 064131 LDB .BUFA 0482 02061 114104 JSB REED,I GET RECORD FROM TTY 0483 02062 050432 CPA M2 0484 02063 026115 JMP RBOUT RUBOUT IN RECORD, INPUT AGAIN 0485* 0486 02064 003021 RPRCS CMA,SSA,RSS SET A=-1-# CHARS AND CHECK FOR 0487 02065 014477 JSB ERROR RECORD TOO LONG 0488 02066 070133 RTLE STA CCNT -1-# CHARACTERS < 0,SET CCNT 0489 02067 060131 LDA .BUFA LOAD BUFFER ADDRESS 0490 02070 000066 CLE,ELA SHIFT LEFT,LEAST BIT USED AS 0491 02071 070132 STA BADDR ODD/EVEN FLAG 0492 02072 015614 JSB GETCR FETCH FIRST CHARACTER 0493 02073 026046 JMP DATAI NULL RECORD, INPUT AGAIN 0494 02074 066121 LDB DRQST 0495 02075 006003 SZB,RSS DATA REQUEST? 0496 02076 026126 JMP CKRCD NO DATA REQUEST,GO CHECK RECORD 0497 02077 050372 CPA S ASCII S FIRST CHARACTER? 0498 02100 016200 JSB STOP ASSUME STOP REQUESTED 0499 02101 002400 CLA LINE 0500 02102 114102 JSB WRITE,I FEED 0501 02103 015633 JSB BCKSP BACKSPACE 0502 02104 060426 LDA RMODE RETURN TO 0503 02105 070127 STA LISTR RUN MODE 0504 02106 066121 LDB DRQST 0505 02107 002400 CLA 0506 02110 072121 STA DRQST CLEAR DATA REQUEST FLAG 0507 02111 114124 JSB IMON,I DATA REQUEST,TURN ON INTRPT MODE 0508 02112 124001 JMP 1,I GO TO DATA REQUEST CALLING POINT 0509* 0510 02113 056040 ASC 1,\ 0511 02114 002113 DEF *-1 0512 02115 066114 RBOUT LDB *-1 OUTPUT 'X' WITH 0513 02116 002404 CLA,INA CARRIAGE RETURN 0514 02117 114102 JSB WRITE,I AND LINE FEED 0515 02120 026056 JMP GTRCD 0516* 0517* THIS SECTION REQUESTS DATA INPUT 0518* 0519 02121 000000 DRQST NOP EXIT/ENTRY AND FLAG 0520 02122 064130 LDB TLSTR SHIFT TO 0521 02123 074127 STB LISTR COMMAND MODE 0522 02124 066005 LDB QMRKA 0523 02125 026047 JMP DATAI+1 PRINT '?' AND WAIT PAGE 0042 #02 BASIC INTEPRETER CONTROL 0525* 0526* THIS SECTION CHECKS RECORD FOR SYSTEM COMMANDS. 0527* 0528 02126 064134 CKRCD LDB SBUFA 0529 02127 074135 STB SBPTR INITIALIZE SYNTAX BUFFER POINTER 0530 02130 170135 STA SBPTR,I PUT FIRST CHAR IN SYNTAX BUFFER 0531 02131 015603 JSB LETCK IS CHARACTER A LETTER 0532 02132 026220 JMP SYNTX NO, TRY SYNTAX 0533* 0534 02133 060306 LDA TBLAD LOAD SYS CMND TABLE START POINT 0535 02134 064440 LDB M8 LOOK FOR A 0536 02135 114212 JSB TSRCH,I SYSTEM COMMAND 0537 02136 014477 JSB ERROR NOT A VALID COMMAND 0538* 0539 02137 INVSC EQU * INVALID CMND ERROR REFERENCE 0540* 0541 02137 001727 ALF,ALF ENTRY FOUND 0542 02140 001100 ARS MOVE JMP ADDR TO LEAST BITS POS. 0543 02141 042007 ADA CMNDA ADD START ADDR. OF CMND ROUTINES 0544 02142 072200 STA STOP SAVE (A) 0545 02143 002400 CLA OUTPUT 0546 02144 114102 JSB WRITE,I A CR-LF 0547 02145 126200 JMP STOP,I EXECUTE COMMAND PAGE 0043 #02 BASIC INTEPRETER CONTROL 0549* 0550* THIS SETS UP AND EXECUTES THE SYSTEM COMMANDS 0551* 0552 02146 CMNDS EQU * COMMAND LIST REFERENCE 0553* 0554 02146 114124 RUN JSB IMON,I TURN ON TTY INTERRUPT MODE 0555 02147 124202 JMP RUNA,I GO TO RUN ENTRY POINT 0556* 0557 02150 026020 SCRTH JMP FLUSH SCRATCH CURRENT PROGRAM 0558* 0559 02151 060130 TLIST LDA TLSTR LIST PROGRAM, TFLAG = 0 0560 02152 006401 CLB,RSS 0561* 0562 02153 060126 PLIST LDA PLSTR PUNCH PROGRAM, TFLAG # 0 0563 02154 070127 STA LISTR SET DRIVER ADDRESS 0564 02155 074136 STB TFLAG SET DEVICE FLAG 0565 02156 114124 JSB IMON,I TURN ON TTY INTERRUPT MODE 0566 02157 124207 JMP LISTA,I GO TO LIST ENTRY POINT 0567* 0568 02160 114124 PTAPE JSB IMON,I PTAPE COMMAND 0569 02161 060366 LDA .72 0570 02162 064131 LDB .BUFA 0571 02163 114101 JSB PREAD,I GET RECORD FROM PHOTO READER 0572 02164 050432 CPA M2 END OF TAPE? 0573 02165 026174 JMP EOTR YES,GO SEE IF START OR END 0574 02166 050433 CPA M3 PHOTO READER READY? 0575 02167 014477 JSB ERROR NO 0576 02170 002003 PRERR SZA,RSS YES 0577 02171 026161 JMP PTAPE+1 NULL RECORD 0578 02172 070136 STA TFLAG SET FLAG # 0 0579 02173 026064 JMP RPRCS GO PROCESS RECORD 0580* 0581 02174 064136 EOTR LDB TFLAG 0582 02175 006003 SZB,RSS START OR END OF TAPE? 0583 02176 026161 JMP PTAPE+1 START 0584 02177 026027 JMP RDYPT GO TO READY POINT 0585* 0586* STOP COMMAND SERVICE 0587* 0588 02200 000000 STOP NOP 0589 02201 114123 JSB IMOFF,I TURN OFF KEYBOARD INTERRUPT MODE 0590 02202 064130 LDB TLSTR SHIFT TO 0591 02203 074127 STB LISTR COMMAND MODE 0592 02204 060470 LDA MNEG 0593 02205 002006 INA,SZA 0594 02206 026205 JMP *-1 DELAY FOR 100 MILLISECONDS 0595 02207 114102 JSB WRITE,I CARRIAGE-RETURN LINE-FEED 0596 02210 060327 LDA .4 0597 02211 066006 LDB STOPA 0598 02212 114102 JSB WRITE,I PRINT *STOP* 0599 02213 026027 JMP RDYPT PAGE 0044 #02 BASIC INTEPRETER CONTROL 0601* 0602** SET LINE FEED SUPPRESSION 0603* 0604 02214 070137 TAPE STA TTYFL SET TO 'TAPE' MODE 0605 02215 026056 JMP GTRCD 0606* 0607** RETURN TO 'BOSS' EXECUTIVE 0608* 0609 02216 002400 BYEC CLA 0610 02217 024077 JMP 77B PAGE 0045 #03 CHECK SYNTAX AND TRANSLITERATE 0002* 0003* ******************************* 0004**** *** 0005*** CHECK SYNTAX OF STATEMENT *** 0006**** *** 0007* ******************************* 0008* 0009** 0010*** DETERMINE SEQUENCE NUMBER ** 0011** 0012 02220 114216 SYNTX JSB INCHK,I RECORD 0013 02221 000463 DEF MAXSN SEQUENCE NUMBER 0014 02222 034135 ISZ SBPTR SAVE SPACE FOR LENGTH WORD 0015 02223 074145 STB .LNUM SAVE LINE NUMBER 0016 02224 064134 LDB SBUFA SET 0017 02225 006004 INB TEMP TO 0018 02226 074160 STB TEMP (SBUFF)+1 0019** 0020*** DETERMINE STATEMENT TYPE ** 0021** 0022 02227 050334 CPA .10 NULL STATEMENT? 0023 02230 124253 JMP DELST,I YES, DELETE IT 0024 02231 170135 STA SBPTR,I NO, RECORD NEXT CHARACTER 0025 02232 060307 LDA STTYP PRINT-TABLE ADDRESS 0026 02233 064446 LDB M21 -(NUMBER OF ENTRIES) 0027 02234 114212 JSB TSRCH,I FIND STATEMENT TYPE 0028 02235 014477 JSB ERROR NOT FOUND 0029 02236 064441 SYNE1 LDB M9 SET MULTIPLE STORE 0030 02237 076330 STB MSFLG TO FALSE 0031 02240 064113 LDB PBPTR NULL 0032 02241 054112 CPB PBUFF PROGRAM? 0033 02242 002001 RSS YES 0034 02243 026247 JMP SYNT1 NO 0035 02244 064110 LDB FWAM INSURE NO 0036 02245 074112 STB PBUFF SPURIOUS COMMON 0037 02246 074113 STB PBPTR EXISTS 0038 02247 074157 SYNT1 STB TEMPS SET S-STACK POINTER 0039 02250 006400 CLB SET DEFINE FLAG 0040 02251 076332 STB DFLAG TO FALSE 0041 02252 076334 STB PFLAG SET PARAMETER FLAG TO FALSE 0042 02253 001727 ALF,ALF COMPUTE 0043 02254 001300 RAR ADDRESS OF 0044 02255 040302 ADA STBAS SYNTAX ROUTINE AND 0045 02256 124000 JMP 0,I BRANCH TO IT 0046** 0047*** SINGLE CHARACTER AND/OR FORMULA OPERATORS ** 0048** 0049 02257 001000 QUOTE OCT 1000 BITS 15-9 OF THE LABELLED WORD 0050 02260 021040 ASC 1," 0051 02261 002000 COMMA OCT 2000 ARE THE BASIC CODE OPERATOR 0052 02262 026040 ASC 1,, 0053 02263 003000 SMCLN OCT 3000 NUMBERS. BITS 3-0 ARE THE 0054 02264 035440 ASC 1,; 0055 02265 004001 RPARN OCT 4001 OPERATOR'S HIERARCHICAL 0056 02266 024440 ASC 1,) 0057 02267 005001 RBRAC OCT 5001 PRECEDENCE FOR THOSE OPERATORS PAGE 0046 #03 CHECK SYNTAX AND TRANSLITERATE 0058 02270 056440 ASC 1,] 0059 02271 006002 SCMMA OCT 6002 BELONGING TO FORMULAS. THE 0060 02272 026040 ASC 1,, 0061 02273 007002 ASSOP OCT 7002 UNLABELLED WORD GIVES THE 0062 02274 036440 ASC 1,= 0063 02275 010007 PLUS OCT 10007 ASCII REPRESENTATION OF THE 0064 02276 025440 ASC 1,+ 0065 02277 011007 MINUS OCT 11007 SINGLE CHARACTER OPERATORS. 0066 02300 026440 ASC 1,- 0067 02301 012010 TIMES OCT 12010 0068 02302 025040 ASC 1,* 0069 02303 013010 DIV OCT 13010 0070 02304 027440 ASC 1,/ 0071 02305 014012 EXPS OCT 14012 0072 02306 057040 ASC 1,^ 0073 02307 015005 GTR OCT 15005 0074 02310 037040 ASC 1,> 0075 02311 016005 LSS OCT 16005 0076 02312 036040 ASC 1,< 0077 02313 017005 UNEQL OCT 17005 0078 02314 021440 ASC 1,# 0079 02315 020005 EQUAL OCT 20005 0080 02316 036440 ASC 1,= 0081 02317 021011 UNMIN OCT 21011 0082 02320 026440 ASC 1,- 0083 02321 022020 LBRAC OCT 22020 0084 02322 055440 ASC 1,[ 0085 02323 023020 LPARN OCT 23020 0086 02324 024040 ASC 1,( 0087 02325 024011 UPLUS OCT 24011 0088 02326 025440 ASC 1,+ 0089 02327 025003 OROP OCT 25003 0090 02330 000000 MSFLG NOP 0091 02331 026004 ANDOP OCT 26004 0092 02332 000000 DFLAG NOP 0093 02333 027011 NOTOP OCT 27011 0094 02334 000000 PFLAG NOP 0095 02335 030005 GTREQ OCT 30005 0096 02336 000000 UFLAG NOP 0097 02337 031005 LSSEQ OCT 31005 0098* 0099*** *** 0100** LET STATEMENT SYNTAX ** 0101*** *** 0102* 0103 02340 077530 LETS STB SFLAG SET 'NO STORE' FLAG ( (B) = 0 ) 0104 02341 060440 LDA M8 SET MULTIPLE STORE FLAG 0105 02342 072330 STA MSFLG TO TRUE 0106 02343 017114 JSB FSC FETCH FORMULA 0107 02344 057530 CPB SFLAG DID STORE OCCUR? ( (B)=0 ) 0108 02345 014477 JSB ERROR NO 0109 02346 SYNE2 EQU * 0110** 0111*** CHECK FOR END OF STATEMENT ** 0112** 0113 02346 050334 EOST CPA .10 END-OF-STATEMENT? PAGE 0047 #03 CHECK SYNTAX AND TRANSLITERATE 0114 02347 124252 JMP ACCST,I YES, ACCEPT STATEMENT 0115 02350 024266 JMP NOEOF NO, ILLEGAL CHARACTER PAGE 0048 #03 CHECK SYNTAX AND TRANSLITERATE 0117* 0118*** *** 0119** DIM STATEMENT SYNTAX ** 0120*** *** 0121* 0122 02351 036332 DIMS ISZ DFLAG SET DFLAG TO TRUE 0123 02352 017530 JSB ARRYS CHECK AN ARRAY 0124 02353 124252 JMP ACCST,I DONE 0125 02354 026352 JMP DIMS+1 WAS A COMMA, CONTINUE 0126* 0127*** *** 0128** COM STATEMENT SYNTAX ** 0129*** *** 0130* 0131 02355 064113 COMS LDB PBPTR HAS PROGRAM BUFFER 0132 02356 054110 CPB FWAM BEEN MOVED? 0133 02357 002001 RSS NO 0134 02360 014477 JSB ERROR YES, ILLEGAL COM 0135 02361 074166 SYNE3 STB TEMPS+7 SET ARRAY POINTER 0136 02362 036332 ISZ DFLAG SET DEFINE FLAG TO TRUE 0137 02363 003400 COMS1 CCA SET COMMON FLAG 0138 02364 072334 STA PFLAG TO TRUE 0139 02365 017530 JSB ARRYS CHECK AN ARRAY 0140 02366 002001 RSS DONE 0141 02367 026363 JMP COMS1 MORE ARRAYS 0142 02370 064166 LDB TEMPS+7 FETCH UPDATED POINTER 0143 02371 074112 STB PBUFF SET PROGRAM BUFFER ADDRESS 0144 02372 074113 STB PBPTR SET PROGRAM BUFFER POINTER 0145 02373 124252 JMP ACCST,I EXIT 0146* 0147*** *** 0148** DEF STATEMENT SYNTAX ** 0149*** *** 0150* 0151 02374 017635 DEFS JSB LTR 0152 02375 026405 JMP SYNE4 FIRST 0153 02376 060161 LDA TEMP1 0154 02377 001727 ALF,ALF TWO CHARACTERS 0155 02400 030162 IOR TEMP2 0156 02401 050464 CPA FN 'FN'? 0157 02402 002001 RSS YES 0158 02403 026405 JMP SYNE4 NO 0159 02404 017635 JSB LTR LETTER FOLLOWS? 0160 02405 014477 SYNE4 JSB ERROR NO 0161 02406 060161 LDA TEMP1 YES, RECORD A 0162 02407 064361 LDB .58 FUNCTION 0163 02410 017650 JSB STROP NAME 0164 02411 060162 LDA TEMP2 RETRIEVE CHARACTER 0165 02412 017661 JSB LPCK LEFT PARENTHESIS? 0166 02413 030470 IOR FLGBT YES, SET FORMAL 0167 02414 170135 STA SBPTR,I PARAMETER BIT 0168 02415 017556 JSB VAROP FETCH SIMPLE VARIABLE 0169 02416 000000 NOP NONE FOUND 0170 02417 014477 JSB ERROR SUBSCRIPTED VARIABLE FOUND 0171 02420 017671 SYNE5 JSB RPCK RECORD A RIGHT PARENTHESIS 0172 02421 007400 CCB ASSIGNMENT PAGE 0049 #03 CHECK SYNTAX AND TRANSLITERATE 0173 02422 015274 JSB SYMCK 0174 02423 002272 DEF ASSOP-1 OPERATOR? 0175 02424 014477 SYNE6 JSB ERROR NO 0176 02425 060432 LDA M2 YES, 0177 02426 040135 ADA SBPTR RETRIEVE 0178 02427 160000 LDA 0,I PARAMETER 0179 02430 010401 AND MSK1 AND 0180 02431 072334 STA PFLAG SAVE IT 0181 02432 017114 JSB FSC FETCH DEFINING FORMULA 0182 02433 026346 JMP EOST END-OF-STATEMENT TEST 0183* 0184*** *** 0185** REM STATEMENT SYNTAX ** 0186*** *** 0187* 0188 02434 060334 REMS LDA .10 DUMMY STRING TERMINATOR 0189 02435 114251 JSB CHRSA,I FETCH CHARACTER STRING 0190 02436 124252 JMP ACCST,I 0191* 0192*** *** 0193** IF STATEMENT SYNTAX ** 0194*** *** 0195* 0196 02437 017114 IFS JSB FSC GET DECISION FORMULA 0197 02440 170135 STA SBPTR,I TABLE 0198 02441 060316 LDA ATHEN SEARCH 0199 02442 007400 CCB FOR 0200 02443 114212 JSB TSRCH,I 'THEN' 0201 02444 014477 JSB ERROR NOT FOUND 0202 02445 SYNE7 EQU * GET STATEMENT LABEL NUMBER 0203* 0204*** *** 0205** GO TO AND GOSUB STATEMENT SYNTAX ** 0206*** *** 0207 02445 114221 GOTOS JSB PGINT,I FETCH AND RECORD 0208 02446 000463 DEF MAXSN SEQUENCE NUMBER 0209 02447 026346 JMP EOST END-OF-STATEMENT TEST 0210* 0211* 0212*** *** 0213** FOR STATEMENT SYNTAX ** 0214*** *** 0215* 0216 02450 017556 FORS JSB VAROP FETCH SIMPLE VARIABLE 0217 02451 000000 NOP NONE FOUND 0218 02452 014477 SYNE8 JSB ERROR SUBSCRIPTED VARIABLE FOUND 0219 02453 007400 CCB 0220 02454 015274 JSB SYMCK ASSIGNMENT 0221 02455 002272 DEF ASSOP-1 OPERATOR? 0222 02456 026424 JMP SYNE6 NO 0223 02457 017114 JSB FSC YES, FETCH INITIAL VALUE FORMULA 0224 02460 170135 STA SBPTR,I LOOK 0225 02461 060317 LDA ATO FOR 0226 02462 007400 CCB THE 0227 02463 114212 JSB TSRCH,I 'TO' 0228 02464 014477 JSB ERROR MISSING PAGE 0050 #03 CHECK SYNTAX AND TRANSLITERATE 0229 02465 017114 SYNE9 JSB FSC GET LIMIT FORMULA 0230 02466 050334 CPA .10 END-OF-STATEMENT? 0231 02467 124252 JMP ACCST,I YES 0232 02470 007400 CCB NO, ERASE 0233 02471 044135 ADB SBPTR ZERO 0234 02472 074135 STB SBPTR WORD 0235 02473 170135 STA SBPTR,I NOW 0236 02474 060320 LDA ASTEP LOOK 0237 02475 007400 CCB FOR 0238 02476 114212 JSB TSRCH,I THE 'STEP' 0239 02477 014477 JSB ERROR MISSING 0240 02500 017114 SYE10 JSB FSC GET STEP SIZE FORMULA 0241 02501 026346 JMP EOST END-OF-STATEMENT TEST 0242* 0243*** *** 0244** NEXT STATEMENT SYNTAX ** 0245*** *** 0246* 0247 02502 017556 NXTS JSB VAROP FETCH SIMPLE VARIABLE 0248 02503 000000 NOP NONE FOUND 0249 02504 026452 JMP SYNE8 SUBSCRIPTED VARIABLE FOUND 0250 02505 026346 JMP EOST END-OF-STATEMENT TEST 0251* 0252*** *** 0253** END, STOP, RESTORE, RETURN STATEMENT SYNTAX ** 0254*** *** 0255* 0256 02506 034135 ENDS ISZ SBPTR 0257 02507 015614 JSB GETCR END-OF-STATEMENT? 0258 02510 124252 JMP ACCST,I YES 0259 02511 024266 JMP NOEOF NO 0260* 0261*** *** 0262** WAIT STATEMENT SYNTAX ** 0263*** *** 0264* 0265 02512 017734 WAITS JSB GETPF 0266 02513 026346 JMP EOST END-OF-STATEMENT TEST 0267* 0268*** *** 0269** CALL STATEMENT SYNTAX ** 0270*** *** 0271* 0272 02514 015614 CALLS JSB GETCR FETCH AND 0273 02515 024265 JMP EOF RECORD 0274 02516 034135 ISZ SBPTR LEFT 0275 02517 017661 JSB LPCK PARENTHESIS 0276 02520 114221 JSB PGINT,I FETCH AND RECORD 0277 02521 000453 DEF D100 SUBROUTINE NUMBER 0278 02522 070161 STA TEMP1 SAVE NEXT CHARACTER 0279 02523 015323 JSB FNDSB FIND 0280 02524 160001 LDA 1,I NUMBER 0281 02525 001727 ALF,ALF OF 0282 02526 010344 AND .31 PARAMETERS 0283 02527 003000 CMA RECORD 0284 02530 070166 STA TEMPS+7 COMPLEMENT - 1 PAGE 0051 #03 CHECK SYNTAX AND TRANSLITERATE 0285 02531 060161 LDA TEMP1 RETRIEVE CHARACTER 0286 02532 007400 CALL2 CCB 0287 02533 015274 JSB SYMCK COMMA? 0288 02534 002260 DEF COMMA-1 0289 02535 026543 JMP CALL3 NO 0290 02536 034166 ISZ TEMPS+7 YES, MORE 0291 02537 002001 RSS PARAMETERS PERMITTED? 0292 02540 014477 SYE11 JSB ERROR NO 0293 02541 017114 JSB FSC YES, FETCH 0294 02542 026532 JMP CALL2 PARAMETER FORMULA 0295 02543 034166 CALL3 ISZ TEMPS+7 ALL PARAMETERS PRESENT? 0296 02544 026540 JMP SYE11 NO 0297 02545 017671 JSB RPCK YES, FETCH RIGHT PARENTHESIS 0298 02546 026346 JMP EOST END-OF-STATEMENT TEST 0299* 0300*** *** 0301** DATA STATEMENT SYNTAX ** 0302*** *** 0303* 0304 02547 014567 DATAS JSB CONST FETCH A CONSTANT 0305 02550 024613 JMP SYE12-1 NONE FOUND 0306 02551 017744 JSB NUMOP FIX UP PRECEDING OPERATOR 0307 02552 007400 CCB CHECK 0308 02553 015274 JSB SYMCK FOR A 0309 02554 002260 DEF COMMA-1 COMMA 0310 02555 026346 JMP EOST END-OF-STATEMENT TEST 0311 02556 026547 JMP DATAS FETCH ANOTHER NUMBER 0312* 0313*** *** 0314** READ AND INPUT STATEMENT SYNTAX ** 0315*** *** 0316* 0317 02557 017556 READS JSB VAROP RECORD VARIABLE OPERAND 0318 02560 014477 JSB ERROR MISSING 0319 02561 000000 SYE13 NOP 0320 02562 007400 CCB CHECK 0321 02563 015274 JSB SYMCK FOR A 0322 02564 002260 DEF COMMA-1 COMMA 0323 02565 002001 RSS 0324 02566 026557 JMP READS IS, FETCH NEXT ITEM 0325 02567 006400 CLB APPEND 0326 02570 174135 STB SBPTR,I END-OF-FORMULA 0327 02571 034135 ISZ SBPTR OPERATOR 0328 02572 026346 JMP EOST END OF STATEMENT TEST 0329* 0330*** *** 0331** PRINT STATEMENT SYNTAX ** 0332*** *** 0333* 0334 02573 064432 PRIN1 LDB M2 NO, 0335 02574 015274 JSB SYMCK COMMA OR 0336 02575 002260 DEF COMMA-1 SEMICOLON? 0337 02576 026604 JMP PRIN2 NO 0338 02577 003400 PRINS CCA YES, ENABLE 0339 02600 170160 STA TEMP,I FORMULA 0340 02601 034135 ISZ SBPTR PAGE 0052 #03 CHECK SYNTAX AND TRANSLITERATE 0341 02602 015614 JSB GETCR END-OF-STATEMENT? 0342 02603 124252 JMP ACCST,I YES 0343 02604 007400 PRIN2 CCB 0344 02605 015274 JSB SYMCK QUOTE? 0345 02606 002256 DEF QUOTE-1 0346 02607 026623 JMP PRIN3 NO 0347 02610 060347 LDA .34 YES, SET QUOTE AS TERMINATOR 0348 02611 114251 JSB CHRSA,I CHARACTER AND FETCH STRING 0349 02612 014477 JSB ERROR MISSING QUOTE 0350 02613 062257 SYE14 LDA QUOTE RECORD 0351 02614 170135 STA SBPTR,I QUOTE 0352 02615 034135 ISZ SBPTR 0353 02616 015614 JSB GETCR END-OP-STATEMENT? 0354 02617 124252 JMP ACCST,I YES 0355 02620 007400 CCB ENABLE 0356 02621 174160 STB TEMP,I FORMULA 0357 02622 026573 JMP PRIN1 NO 0358 02623 134160 PRIN3 ISZ TEMP,I TAB OR FORMULA PERMITTED? 0359 02624 014477 JSB ERROR NO 0360 02625 170135 SYE15 STA SBPTR,I SEARCH 0361 02626 060322 LDA ATAB FOR 0362 02627 007400 CCB 'TAB' 0363 02630 114212 JSB TSRCH,I 0364 02631 002401 CLA,RSS NOT FOUND 0365 02632 060424 LDA TABCN 0366 02633 007400 CCB BACKUP 0367 02634 044135 ADB SBPTR TO WORD WITH 0368 02635 074135 STB SBPTR PREVIOUS OPERATOR 0369 02636 002003 SZA,RSS 'TAB' ? 0370 02637 026647 JMP PRIN4 NO 0371 02640 130135 IOR SBPTR,I 0372 02641 170135 STA SBPTR,I YES, RECORD IT 0373 02642 017734 JSB GETPF FETCH PARAMETER 0374 02643 006400 CLB FOLLOW 0375 02644 174135 STB SBPTR,I WITH A 0376 02645 034135 ISZ SBPTR ZERO 0377 02646 026651 JMP PRIN5 0378 02647 015633 PRIN4 JSB BCKSP BACKSPACE OVER LAST CHARACTER 0379 02650 017114 JSB FSC FETCH FORMULA 0380 02651 050334 PRIN5 CPA .10 END-OF-STATEMENT? 0381 02652 124252 JMP ACCST,I YES 0382 02653 026573 JMP PRIN1 NO 0383* 0384*** *** 0385** MAT STATEMENT SYNTAX ** 0386*** *** 0387* 0388 02654 017635 MATS JSB LTR FIRST 0389 02655 014477 JSB ERROR TWO CHARACTERS 0390 02656 015603 SYE16 JSB LETCK LETTERS? 0391 02657 026722 JMP MATS2 NO 0392 02660 034135 ISZ SBPTR YES, MOVE TO FRESH S-BUFFER WORD 0393 02661 064161 LDB TEMP1 RETRIEVE FIRST LETTER AND 0394 02662 005727 BLF,BLF PUT IT IN THE 0395 02663 030001 IOR 1 UPPER CHARACTER OF (A) 0396 02664 170135 STA SBPTR,I SEARCH PAGE 0053 #03 CHECK SYNTAX AND TRANSLITERATE 0397 02665 060310 LDA MATIO FOR 0398 02666 064432 LDB M2 'READ' OR 0399 02667 114212 JSB TSRCH,I 'PRINT' 0400 02670 014477 JSB ERROR NOT FOUND 0401 02671 050416 SYE17 CPA RDOP READ? 0402 02672 026710 JMP MATS1 YES 0403 02673 017544 MATS0 JSB ARRID RECORD ARRAY 0404 02674 050334 CPA .10 END-OF-STATEMENT? 0405 02675 124252 JMP ACCST,I YES 0406 02676 064432 LDB M2 NO, 0407 02677 015274 JSB SYMCK COMMA OR 0408 02700 002260 DEF COMMA-1 SEMICOLON? 0409 02701 014477 JSB ERROR NO 0410 02702 015614 SYE18 JSB GETCR END-OF-STATEMENT? 0411 02703 026706 JMP *+3 YES 0412 02704 015633 JSB BCKSP NO 0413 02705 026673 JMP MATS0 0414 02706 034135 ISZ SBPTR INCLUDE 0415 02707 124252 JMP ACCST,I PARAMETER 0416 02710 017544 MATS1 JSB ARRID RECORD ARRAY 0417 02711 017704 JSB MATSB IF SUBSCRIPT, 0418 02712 000000 NOP RECORD IT 0419 02713 050334 CPA .10 END-OF-STATEMENT? 0420 02714 124252 JMP ACCST,I YES 0421 02715 007400 CCB NO 0422 02716 015274 JSB SYMCK 0423 02717 002260 DEF COMMA-1 COMMA? 0424 02720 026701 JMP SYE18-1 NO 0425 02721 026710 JMP MATS1 YES 0426 02722 070162 MATS2 STA TEMP2 0427 02723 060135 LDA SBPTR SAVE 0428 02724 071715 STA ARYAD OPERAND ADDRESS 0429 02725 060161 LDA TEMP1 RETRIEVE FIRST LETTER 0430 02726 064355 LDB .46 RECORD AN 0431 02727 017650 JSB STROP ARRAY 0432 02730 060162 LDA TEMP2 RETRIEVE CHARACTER 0433 02731 007400 CCB ASSIGNMENT 0434 02732 015274 JSB SYMCK 0435 02733 002272 DEF ASSOP-1 OPERATOR? 0436 02734 026424 JMP SYNE6 NO 0437 02735 161715 LDA ARYAD,I YES, RETRIEVE 0438 02736 010401 AND MSK1 AND SAVE 0439 02737 170160 STA TEMP,I PREVIOUS ARRAY IDENTIFIER 0440 02740 017635 JSB LTR LETTER NEXT? 0441 02741 027010 JMP MATS4 NO 0442 02742 015603 JSB LETCK YES, SECOND LETTER? 0443 02743 027024 JMP MATS5 NC 0444 02744 034135 ISZ SBPTR YES, 0445 02745 064161 LDB TEMP1 CONCATENATE 0446 02746 005727 BLF,BLF LETTERS 0447 02747 030001 IOR 1 AND 0448 02750 170135 STA SBPTR,I SEARCH 0449 02751 060313 LDA MATFN FOR 0450 02752 064435 LDB M5 ARRAY 0451 02753 114212 JSB TSRCH,I FUNCTION 0452 02754 014477 JSB ERROR NOT FOUND PAGE 0054 #03 CHECK SYNTAX AND TRANSLITERATE 0453 02755 001727 SYE19 ALF,ALF FOUND 0454 02756 001723 ALF,RAR POSITION IT, 0455 02757 040336 ADA .15 COMPLETE OPERAND, 0456 02760 007400 CCB COMBINE 0457 02761 044135 ADB SBPTR WITH 0458 02762 130001 IOR 1,I OPERATOR, 0459 02763 030470 IOR FLGBT ADD FLAG BIT, 0460 02764 170001 STA 1,I AND STORE 0461 02765 010401 AND MSK1 'INV' 0462 02766 040460 ADA M256 OR 0463 02767 002021 SSA,RSS 'TRN? 0464 02770 026776 JMP MATS3 YES 0465 02771 015614 JSB GETCR NO, FND-OF-STATEMENT? 0466 02772 124252 JMP ACCST,I YES 0467 02773 017704 JSB MATSB NO, SUBSCRIPT? 0468 02774 014477 JSB ERROR NO 0469 02775 024266 SYE20 JMP NOEOF 0470 02776 015614 MATS3 JSB GETCR 0471 02777 024265 JMP EOF 0472 03000 017661 JSB LPCK GET LEFT PARENTHESIS 0473 03001 017544 JSB ARRID FETCH AND RECORD AN ARRAY 0474 03002 017671 JSB RPCK RECORD A RIGHT PARENTHESIS 0475 03003 161715 LDA ARYAD,I RETRIEVE 0476 03004 010401 AND MSK1 PREVIOUS ARRAY IDENTIFIER 0477 03005 150160 CPA TEMP,I MATCH LEFT-HAND SIDE ARRAY? 0478 03006 014477 JSB ERROR YES 0479 03007 124252 SYE21 JMP ACCST,I NO 0480 03010 034135 MATS4 ISZ SBPTR 0481 03011 017661 JSB LPCK FETCH LEFT PARENTHESIS 0482 03012 017114 JSB FSC FETCH FORMULA 0483 03013 017671 JSB RPCK FETCH RIGHT PARENTHESIS 0484 03014 007400 CCB MULTIPLICATION 0485 03015 015274 JSB SYMCK OPERATOR? 0486 03016 002300 DEF TIMES-1 0487 03017 014477 JSB ERROR NO 0488 03020 017544 SYE22 JSB ARRID YES, FETCH AND RECORD ARRAY 0489 03021 050334 CPA .10 END-OF-STATEMENT? 0490 03022 124252 JMP ACCST,I YES 0491 03023 024266 JMP NOEOF NO 0492 03024 070162 MATS5 STA TEMP2 0493 03025 060135 LDA SBPTR SAVE 0494 03026 071715 STA ARYAD OPERAND ADDRESS 0495 03027 060161 LDA TEMP1 RETRIEVE 0496 03030 064355 LDB .46 AND RECORD 0497 03031 017650 JSB STROP ARRAY 0498 03032 060162 LDA TEMP2 END-OF- 0499 03033 050334 CPA .10 STATEMENT? 0500 03034 124252 JMP ACCST,I YES 0501 03035 064433 LDB M3 NO, MUST BE 0502 03036 015274 JSB SYMCK A '+', 0503 03037 002274 DEF PLUS-1 '-', OR '*' 0504 03040 014477 JSB ERROR ISN'T 0505 03041 006400 SYE23 CLB IS, SET FOR FALSE 0506 03042 040332 ADA .8 0507 03043 052301 CPA TIMES '*'? 0508 03044 027061 JMP MATS7 YES PAGE 0055 #03 CHECK SYNTAX AND TRANSLITERATE 0509 03045 076334 MATS6 STB PFLAG NO, SET PFLAG 0510 03046 017544 JSB ARRID GET SECOND ARRAY 0511 03047 050334 CPA .10 END-OF-STATEMENT? 0512 03050 002001 RSS YES 0513 03051 024266 JMP NOEOF NO 0514 03052 036334 ISZ PFLAG WAS OPERATOR A '*'? 0515 03053 124252 JMP ACCST,I NO 0516 03054 161715 LDA ARYAD,I YES, RETRIEVE 0517 03055 010401 AND MSK1 SECOND ARRAY 0518 03056 150160 CPA TEMP,I MATCH LEFT-HAND SIDE ARRAY? 0519 03057 014477 SYE24 JSB ERROR YES 0520 03060 124252 JMP ACCST,I NO 0521 03061 161715 MATS7 LDA ARYAD,I RETRIEVE 0522 03062 010401 AND MSK1 ARRAY 0523 03063 007400 CCB SET FOR TRUE 0524 03064 150160 CPA TEMP,I MATCH LEFT-HAND SIDE ARRAY? 0525 03065 027057 JMP SYE24 YES 0526 03066 027045 JMP MATS6 NO 0527** 0528*** JUMP TABLE FOR STATEMENT SYNTAX ** 0529** 0530 03067 002340 SYNTB DEF LETS LET 0531 03070 002351 DEF DIMS DIM 0532 03071 002355 DEF COMS COM 0533 03072 002374 DEF DEFS DEF 0534 03073 002434 DEF REMS REM 0535 03074 002445 DEF GOTOS GO TO 0536 03075 002437 DEF IFS IF 0537 03076 002450 DEF FORS FOR 0538 03077 002502 DEF NXTS NEXT 0539 03100 002445 DEF GOTOS GOSUB 0540 03101 002506 DEF ENDS RETURN 0541 03102 002506 DEF ENDS END 0542 03103 002506 DEF ENDS STOP 0543 03104 002512 DEF WAITS WAIT 0544 03105 002514 DEF CALLS CALL 0545 03106 002547 DEF DATAS DATA 0546 03107 002557 DEF READS READ 0547 03110 002577 DEF PRINS PRINT 0548 03111 002557 DEF READS INPUT 0549 03112 002506 DEF ENDS RESTORE 0550 03113 002654 DEF MATS MAT 0551* 0552*** *** 0553** FORMULA SYNTAX CHECKER ** 0554*** *** 0555* 0556 03114 000000 FSC NOP 0557 03115 002400 CLA SET LEFT PARENTHESIS 0558 03116 170157 STA TEMPS,I COUNT TO ZERO 0559 03117 003400 FSC1 CCA SET UNARY FLAG 0560 03120 072336 STA UFLAG TO TRUE 0561 03121 017556 FSC2 JSB VAROP LOOK FOR VARIABLE OPERAND 0562 03122 027261 JMP FSC9 NOT FOUND 0563 03123 027227 JMP FSC6 SUBSCRIPTED VARIABLE FOUND 0564 03124 015603 JSB LETCK FOLLOWED BY LETTER? PAGE 0056 #03 CHECK SYNTAX AND TRANSLITERATE 0565 03125 027227 JMP FSC6 NO 0566 03126 064432 LDB M2 YES, LOOK FOR 0567 03127 017322 JSB MCBCK 'AND' OR 'OR' 0568 03130 060161 LDA TEMP1 NOT FOUND, FETCH PREVIOUS 0569 03131 001727 ALF,ALF CHARACTER AND LEFT-JUSTIFY IT 0570 03132 030162 IOR TEMP2 ADD LATEST CHARACTER 0571 03133 050464 CPA FN 'FN'? 0572 03134 027162 JMP FSC4 YES 0573 03135 170135 STA SBPTR,I NO, 0574 03136 060312 LDA PDFNS SEARCH FOR 0575 03137 064443 LDB M11 PREDEFINED 0576 03140 114212 JSB TSRCH,I FUNCTION 0577 03141 027146 JMP FSC3 NOT FOUND 0578 03142 001727 ALF,ALF ASSEMBLE 0579 03143 001723 ALF,RAR OPERAND 0580 03144 030470 IOR FLGBT ADD FLAG BIT 0581 03145 027170 JMP FSC5 0582 03146 036336 FSC3 ISZ UFLAG 'NOT' PERMITTED? 0583 03147 027252 JMP FSC8-1 NO 0584 03150 060321 LDA ANOT YES, 0585 03151 007400 CCB SEARCH FOR 0586 03152 114212 JSB TSRCH,I 'NOT' 0587 03153 027252 JMP FSC8-1 'NOT' NOT FOUND 0588 03154 007400 CCB RETRIEVE 0589 03155 044135 ADB SBPTR PREVIOUS WORD 0590 03156 160001 LDA 1,I WORD 0591 03157 010420 AND OPMSK SET TO 0592 03160 170001 STA 1,I NULL OPERAND 0593 03161 027317 JMP FSC14 0594 03162 015614 FSC4 JSB GETCR IDENTIFYING 0595 03163 026405 JMP SYNE4 FUNCTION 0596 03164 015603 JSB LETCK LETTER? 0597 03165 026405 JMP SYNE4 NO 0598 03166 040453 ADA D100 YES, 0599 03167 001700 ALF ASSEMBLE AND 0600 03170 040336 FSC5 ADA .15 SAVE 0601 03171 070161 STA TEMP1 FUNCTION IDENTIFIER 0602 03172 007400 CCB RETRIEVE 0603 03173 044135 ADB SBPTR PREVIOUS 0604 03174 160001 LDA 1,I PROGRAM WORD 0605 03175 010420 AND OPMSK EXTRACT OPERATOR, 0606 03176 030161 IOR TEMP1 APPEND OPERAND, 0607 03177 170001 STA 1,I AND RECORD 0608 03200 015614 JSB GETCR LEFT PARENTHESIS 0609 03201 014477 FSCE1 JSB ERROR OR 0610 03202 017661 JSB LPCK LEFT BRACKET? 0611 03203 017353 JSB FRCUR YES, SAVE LOCAL VARIABLES OF FSC 0612 03204 017114 JSB FSC FETCH ACTUAL PARAMETER 0613 03205 017330 JSB FPOP RESTORE LOCAL VARIABLES OF FSC 0614 03206 017671 JSB RPCK FETCH RIGHT PARENTHESIS 0615 03207 027272 JMP FSC10+1 0616 03210 064432 FSC7 LDB M2 CHECK FOR 0617 03211 015274 JSB SYMCK RIGHT PARENTHESIS 0618 03212 002264 DEF RPARN-1 OR RIGHT BRACKET 0619 03213 027253 JMP FSC8 NOT FOUND 0620 03214 060406 LDA B4000 RECORD A PAGE 0057 #03 CHECK SYNTAX AND TRANSLITERATE 0621 03215 170135 STA SBPTR,I RIGHT PARENTHESIS 0622 03216 060352 LDA .41 RESTORE RIGHT PARENTHESIS 0623 03217 007400 CCB MATCHING 0624 03220 144157 ADB TEMPS,I LEFT 0625 03221 006020 SSB PARENTHESIS? 0626 03222 027253 JMP FSC8 NO 0627 03223 174157 STB TEMPS,I YES 0628 03224 034135 ISZ SBPTR 0629 03225 015614 JSB GETCR FETCH 0630 03226 060334 LDA .10 CHARACTER 0631 03227 050334 FSC6 CPA .10 END OF FORMULA? 0632 03230 027253 JMP FSC8 YES 0633 03231 072336 STA UFLAG NO, SET UNARY FLAG TO FALSE 0634 03232 064435 LDB M5 SEARCH FOR A MULTICHARACTER 0635 03233 017322 JSB MCBCK BINARY OPERATOR 0636 03234 160135 LDA SBPTR,I NOT FOUND, 0637 03235 001727 ALF,ALF RESTORE 0638 03236 010374 AND B177 CHARACTER 0639 03237 066330 LDB MSFLG SEARCH 0640 03240 015274 JSB SYMCK FOR A 0641 03241 002274 DEF PLUS-1 BINARY OPERATOR 0642 03242 002001 RSS NOT FOUND 0643 03243 027301 JMP FSC12 FOUND 0644 03244 007400 CCB ASSIGNMENT 0645 03245 015274 JSB SYMCK 0646 03246 002272 DEF ASSOP-1 OPERATOR? 0647 03247 027210 JMP FSC7 NO 0648 03250 073530 STA SFLAG YES, SET 0649 03251 027117 JMP FSC1 'STORE OCCURRED' FLAG 0650 03252 060162 LDA TEMP2 RETRIEVE LETTER 0651 03253 164157 FSC8 LDB TEMPS,I ALL LEFT PARENTHESES 0652 03254 006002 SZB MATCHED? 0653 03255 014477 FSCE2 JSB ERROR NO 0654 03256 174135 STB SBPTR,I YES, RECORD AN 0655 03257 034135 ISZ SBPTR END-OF-FORMULA AND 0656 03260 127114 JMP FSC,I EXIT WITH CHARACTER IN (A) 0657* 0658 03261 050351 FSC9 CPA .40 LEFT 0659 03262 027275 JMP FSC11 PARENTHESIS 0660 03263 050373 CPA B133 OR LEFT BRACKET? 0661 03264 027275 JMP FSC11 YES 0662 03265 006400 CLB NO, SET SIGN 0663 03266 074153 STB SIGN POSITIVE 0664 03267 014615 JSB NUMCK NUMBER? 0665 03270 027304 JMP FSC13 NO 0666 03271 017744 FSC10 JSB NUMOP YES, FIX UP PRECEDING OPERATOR 0667 03272 064441 LDB M9 UPDATE 0668 03273 076330 STB MSFLG MULTIPLE STORE 0669 03274 027227 JMP FSC6 FLAG 0670 03275 034135 FSC11 ISZ SBPTR YES 0671 03276 060413 LDA B2300 RECORD 0672 03277 170135 STA SBPTR,I IT AND 0673 03300 134157 ISZ TEMPS,I COUNT IT 0674 03301 064441 FSC12 LDB M9 UPDATE 0675 03302 076330 STB MSFLG MULTIPLE STORE FLAG 0676 03303 027117 JMP FSC1 FLAG PAGE 0058 #03 CHECK SYNTAX AND TRANSLITERATE 0677 03304 036336 FSC13 ISZ UFLAG UNARY OPERATORS PERMITTED? 0678 03305 014477 FSCE3 JSB ERROR NO 0679 03306 064411 LDB UNMNC 0680 03307 050353 CPA .43 '+'? 0681 03310 027314 JMP *+4 YES 0682 03311 050354 CPA .45 NO, '-'? 0683 03312 027315 JMP *+3 YES 0684 03313 027305 JMP FSCE3 NO 0685 03314 044404 ADB B3000 STORE 0686 03315 034135 ISZ SBPTR UNARY 0687 03316 174135 STB SBPTR,I OPERATOR 0688 03317 064441 FSC14 LDB M9 UPDATE 0689 03320 076330 STB MSFLG MULTIPLE STORE FLAG 0690 03321 027121 JMP FSC2 FLAG 0691** 0692*** CHECK FOR A MULTICHARACTER BINARY OPERATOR ** 0693** 0694 03322 000000 MCBCK NOP 0695 03323 170135 STA SBPTR,I SEARCH 0696 03324 060311 LDA MCBOP FOR 'AND' 0697 03325 114212 JSB TSRCH,I OR 'OR' 0698 03326 127322 JMP MCBCK,I NOT FOUND 0699 03327 027301 JMP FSC12 FOUND 0001** 0002*** RESTORE FSC LOCAL QUANTITIES ** 0003** 0004 03330 000000 FPOP NOP 0005 03331 070161 STA TEMP1 SAVE CHARACTER 0006 03332 064157 LDB TEMPS 0007 03333 044435 ADB M5 0008 03334 074157 STB TEMPS RESTORE S-STACK TOP 0009 03335 006004 INB 0010 03336 160001 LDA 1,I 0011 03337 072330 STA MSFLG RESTORE MULTIPLE STORE FLAG 0012 03340 006004 INB 0013 03341 160001 LDA 1,I 0014 03342 072336 STA UFLAG RESTORE UNARY OPERATOR FLAG 0015 03343 006004 INB 0016 03344 160001 LDA 1,I 0017 03345 073114 STA FSC RESTORE FSC RETURN ADDRESS 0018 03346 006004 INB 0019 03347 160001 LDA 1,I RESTORE 0020 03350 073556 STA VAROP VAROP RETURN ADDRESS 0021 03351 060161 LDA TEMP1 RETRIEVE CHARACTER 0022 03352 127330 JMP FPOP,I 0023** 0024*** SAVE LOCAL QUANTITIES OF FSC ** 0025** 0026 03353 000000 FRCUR NOP 0027 03354 064157 LDB TEMPS FETCH CURRENT S-STACK POINTER 0028 03355 006004 INB UPDATE IT 0029 03356 062330 LDA MSFLG DUMP MULTIPLE STORE 0030 03357 170001 STA 1,I FLAG ON S-STACK 0031 03360 006004 INB 0032 03361 062336 LDA UFLAG STACK UNARY OPERATOR 0033 03362 170001 STA 1,I FLAG PAGE 0059 #04 CHECK SYNTAX AND TRANSLITERATE 0034 03363 006004 INB 0035 03364 063114 LDA FSC STACK FSC 0036 03365 170001 STA 1,I RETURN ADDRESS 0037 03366 063556 LDA VAROP STACK VAROP RETURN ADDRESS 0038 03367 017371 JSB SSOV AND CHECK FOR S-STACK OVERFLOW 0039 03370 127353 JMP FRCUR,I 0040** 0041*** PUT ITEM ON S-STACK AND CHECK FOR OVERFLOW ** 0042** 0043 03371 000000 SSOV NOP STORE QUANTITY 0044 03372 006004 INB ADVANCE S-STACK POINTER 0045 03373 170001 STA 1,I SAVE ITEM IN (A) 0046 03374 006004 INB ADVANCE S-STACK POINTER 0047 03375 074157 STB TEMPS AND RECORD IT 0048 03376 007004 CMB,INB 0049 03377 044106 ADB LWBM LAST WORD 0050 03400 006020 SSB EXCEEDED? 0051 03401 014477 FSCE4 JSB ERROR YES 0052 03402 127371 JMP SSOV,I 0053** 0054*** CHECK FOR SUBSCRIPT PART ** 0055** 0056 03403 000000 SBSCK NOP CHARACTER IN (A) 0057 03404 064432 LDB M2 LEFT BRACKET 0058 03405 015274 JSB SYMCK OR 0059 03406 002320 DEF LBRAC-1 LEFT PARENTHESIS? 0060 03407 127403 JMP SBSCK,I NO, RETURN VIA (P+1) 0061 03410 037403 ISZ SBSCK YES, SET RETURN TO (P+2) 0062 03411 161715 LDA ARYAD,I SET 0063 03412 010445 AND M16 ARRAY 0064 03413 002004 INA TO 0065 03414 171715 STA ARYAD,I SINGLE SUBSCRIPT 0066 03415 060412 LDA B2200 RECORD A 0067 03416 170135 STA SBPTR,I LEFT BRACKET 0068 03417 006400 CLB DIM OR COM 0069 03420 056332 CPB DFLAG STATEMENT? 0070 03421 027473 JMP SBSC3 NO 0071 03422 114221 JSB PGINT,I FETCH INTEGER 0072 03423 000460 DEF M256 SUBSCRIPT BOUND 0073 03424 005727 BLF,BLF SAVE 0074 03425 074161 STB TEMP1 BOUND 0075 03426 007400 CCB IS THE 0076 03427 015274 JSB SYMCK NEXT CHARACTER 0077 03430 002270 DEF SCMMA-1 A COMMA? 0078 03431 027436 JMP SBSC1 NO 0079 03432 135715 ISZ ARYAD,I YES, NOTE SECOND SUBSCRIPT 0080 03433 114221 JSB PGINT,I FETCH SECOND 0081 03434 000460 DEF M256 INTEGER SUBSCRIPT BOUND 0082 03435 002001 RSS 0083 03436 006404 SBSC1 CLB,INB SET ONE-DIMENSIONAL CASE 0084 03437 036334 ISZ PFLAG COM STATEMENT? 0085 03440 027450 JMP SBSC2 NO 0086 03441 070162 STA TEMP2 SAVE CHARACTER 0087 03442 060001 LDA 1 0088 03443 030161 IOR TEMP1 RETRIEVE FIRST BOUND 0089 03444 015336 JSB MDIM FIND STORAGE NEED PAGE 0060 #04 CHECK SYNTAX AND TRANSLITERATE 0090 03445 040166 ADA TEMPS+7 UPDATE COM 0091 03446 070166 STA TEMPS+7 STORAGE POINTER 0092 03447 060162 LDA TEMP2 RETRIEVE NEXT CHARACTER 0093 03450 064432 SBSC2 LDB M2 RIGHT PARENTHESIS 0094 03451 015274 JSB SYMCK OR 0095 03452 002264 DEF RPARN-1 RIGHT BRACKET? 0096 03453 027255 JMP FSCE2 NO 0097 03454 060407 LDA LF YES, RECORD A 0098 03455 170135 STA SBPTR,I RIGHT BRACKET 0099 03456 034135 ISZ SBPTR ADJUST S-BUFFER POINTER 0100 03457 015614 JSB GETCR FETCH FOLLOWING 0101 03460 060334 LDA .10 CHARACTER 0102 03461 066332 LDB DFLAG DIM OR COM 0103 03462 006002 SZB STATEMENT? 0104 03463 127403 JMP SBSCK,I YES 0105 03464 017330 JSB FPOP RESTORE FSC LOCAL VARIABLES 0106 03465 064432 LDB M2 RESTORE 0107 03466 044157 ADB TEMPS S-STACK 0108 03467 074157 STB TEMPS POINTER 0109 03470 006004 INB FETCH 0110 03471 164001 LDB 1,I RETURN ADDRESS 0111 03472 124001 JMP 1,I AND EXIT 0112 03473 063403 SBSC3 LDA SBSCK SAVE 0113 03474 064157 LDB TEMPS RETURN ADDRESS 0114 03475 017371 JSB SSOV ON S-STACK 0115 03476 017353 JSB FRCUR SAVE FSC LOCAL VARIABLES 0116 03477 064441 LDB M9 SET MULTIPLE STORE FLAG 0117 03500 076330 STB MSFLG TO FALSE 0118 03501 061715 LDA ARYAD SAVE 0119 03502 064157 LDB TEMPS OPERAND 0120 03503 017371 JSB SSOV ADDRESS 0121 03504 017114 JSB FSC GET SUBSCRIPT FORMULA 0122 03505 007400 CCB CANCEL 0123 03506 044135 ADB SBPTR END-OF-FORMULA 0124 03507 074135 STB SBPTR OPERATOR 0125 03510 064432 LDB M2 RESTORE 0126 03511 044157 ADB TEMPS S-STACK 0127 03512 074157 STB TEMPS POINTER 0128 03513 006004 INB RESTORE 0129 03514 164001 LDB 1,I OPERAND 0130 03515 075715 STB ARYAD ADDRESS 0131 03516 007400 CCB IS THE 0132 03517 015274 JSB SYMCK NEXT CHARACTER 0133 03520 002270 DEF SCMMA-1 A COMMA? 0134 03521 027450 JMP SBSC2 NO 0135 03522 135715 ISZ ARYAD,I YES, NOTE SECOND SUBSCRIPT 0136 03523 017114 JSB FSC GET SUBSCRIPT FORMULA 0137 03524 007400 CCB CANCEL 0138 03525 044135 ADB SBPTR END-OF-FORMULA 0139 03526 074135 STB SBPTR OPERATOR 0140 03527 027450 JMP SBSC2 PAGE 0061 #04 CHECK SYNTAX AND TRANSLITERATE 0142** 0143*** CHECK SYNTAX OF ARRAY DEFINITIONS ** 0144** 0145 03530 000000 ARRYS NOP 0146 03531 017544 JSB ARRID FETCH ARRAY IDENTIFIER 0147 03532 017403 JSB SBSCK RECORD A SUBSCRIPT 0148 03533 014477 JSB ERROR MISSING SUBSCRIPT 0149 03534 050334 ARRE1 CPA .10 END-OF-STATEMENT? 0150 03535 127530 JMP ARRYS,I YES, RETURN VIA (P+1) 0151 03536 007400 CCB NO, 0152 03537 015274 JSB SYMCK MUST BE 0153 03540 002260 DEF COMMA-1 A COMMA 0154 03541 024266 JMP NOEOF ISN'T 0155 03542 037530 ISZ ARRYS IS, RETURN 0156 03543 127530 JMP ARRYS,I VIA (P+2) 0157** 0158*** FETCH ARRAY IDENTIFIER ** 0159*- 0160 03544 000000 ARRID NOP 0161 03545 017635 JSB LTR FETCH LETTER 0162 03546 014477 JSB ERROR NONE FOUND 0163 03547 060135 ARRE2 LDA SBPTR SAVE 0164 03550 071715 STA ARYAD OPERAND ADDRES 0165 03551 060161 LDA TEMP1 RECORD 0166 03552 064355 LDB .46 ARRAY 0167 03553 017650 JSB STROP IDENTIFIER 0168 03554 060162 LDA TEMP2 RETRIEVE FOLLOWING CHARACTER 0169 03555 127544 JMP ARRID,I 0170** 0171*** CHECK FOR VARIABLE OPERAND ** 0172** 0173 03556 000000 VAROP NOP 0174 03557 017635 JSB LTR LETTER? 0175 03560 127556 JMP VAROP,I NO, EXIT VIA (P+1) 0176 03561 037556 ISZ VAROP 0177 03562 050351 CPA .40 LEFT PARENTHESIS? 0178 03563 027624 JMP VARO5 YES 0179 03564 050373 CPA B133 NO, LEFT BRACKET? 0180 03565 027624 JMP VARO5 YES 0181 03566 037556 ISZ VAROP NO 0182 03567 015570 JSB DIGCK DIGIT? 0183 03570 027600 JMP VARO1 NO 0184 03571 060161 LDA TEMP1 YES, RETRIEVE LETTER, 0185 03572 044357 ADB .48 AND RESTORE ASCII DIGIT 0186 03573 074161 STB TEMP1 0187 03574 017650 JSB STROP RECORD VARIABLE 0188 03575 015614 JSB GETCR FETCH FOLLOWING 0189 03576 060334 LDA .10 CHARACTER 0190 03577 027604 JMP VARO2 0191 03600 060161 VARO1 LDA TEMP1 RETRIEVE LETTER, 0192 03601 064356 LDB .47 SET 'NO DIGIT', 0193 03602 017650 JSB STROP AND RECORD VARIABLE 0194 03603 060162 LDA TEMP2 RETRIEVE FOLLOWING CHARACTER 0195 03604 070162 VARO2 STA TEMP2 SAVE CHARACTER 0196 03605 006400 CLB INSIDE A 0197 03606 056334 CPB PFLAG DEF STATEMENT? PAGE 0062 #04 CHECK SYNTAX AND TRANSLITERATE 0198 03607 127556 JMP VAROP,I NO, EXIT VIA (P+3) 0199 03610 007400 CCB 0200 03611 044135 ADB SBPTR RETRIEVE 0201 03612 160001 LDA 1,I 0202 03613 010401 AND MSK1 OPERAND 0203 03614 052334 CPA PFLAG MATCH PARAMETER? 0204 03615 027620 JMP VARO4 YES 0205 03616 060162 VARO3 LDA TEMP2 NO, RETRIEVE 0206 03617 127556 JMP VAROP,I CHARACTER AND EXIT VIA (P+3) 0207 03620 160001 VARO4 LDA 1,I SET OPERAND TO 0208 03621 030470 IOR FLGBT ACTUAL PARAMETER 0209 03622 170001 STA 1,I AND RECORD IT 0210 03623 027616 JMP VARO3 0211 03624 060135 VARO5 LDA SBPTR SAVE 0212 03625 071715 STA ARYAD OPERAND ADDRESS 0213 03626 060161 LDA TEMP1 RETRIEVE LETTER 0214 03627 064355 LDB .46 RECORD 0215 03630 017650 JSB STROP ARRAY IDENTIFIER 0216 03631 060373 LDA B133 RETRIEVE LEFT BRACKET 0217 03632 017403 JSB SBSCK FETCH SUBSCRIPT 0218 03633 000000 NOP 0219 03634 127556 JMP VAROP,I EXIT VIA (P+2) 0220** 0221*** FETCH A LETTER ** 0222** 0223 03635 000000 LTR NOP 0224 03636 015614 JSB GETCR 0225 03637 060334 LDA .10 0226 03640 015603 JSB LETCK LETTER? 0227 03641 127635 JMP LTR,I NO, EXIT VIA (P+1) 0228 03642 037635 ISZ LTR YES, 0229 03643 070161 STA TEMP1 SAVE IT 0230 03644 015614 JSB GETCR NEXT CHARACTER 0231 03645 060334 LDA .10 TO (A) 0232 03646 070162 STA TEMP2 SAVE SECOND CHARACTER 0233 03647 127635 JMP LTR,I EXIT VIA (P+2) 0234** 0235*** STORE AN OPERAND NAME ** 0236** 0237 03650 000000 STROP NOP LETTER IN (A), NUMBER IN (B) 0238 03651 040453 ADA D100 NUMERICALLY ADJUST THE 0239 03652 044451 ADB D53 OPERAND NAME 0240 03653 001700 ALF COMBINE THE 0241 03654 030001 IOR 1 TWO PARTS 0242 03655 130135 IOR SBPTR,I COMPLETE OPERAND-OPERATOR PAIR 0243 03656 170135 STA SBPTR,I AND STORE IT 0244 03657 034135 ISZ SBPTR UPDATE S-BUFFER POINTER 0245 03660 127650 JMP STROP,I PAGE 0063 #04 CHECK SYNTAX AND TRANSLITERATE 0247** 0248*** CHECK FOR LEFT PARENTHESIS ** 0249** 0250 03661 000000 LPCK NOP CHARACTER IN (A) 0251 03662 064432 LDB M2 LEFT PARENTHESIS 0252 03663 015274 JSB SYMCK OR 0253 03664 002320 DEF LBRAC-1 LEFT BRACKET? 0254 03665 027201 JMP FSCE1 NO 0255 03666 060413 LDA B2300 YES, RECORD A 0256 03667 170135 STA SBPTR,I LEFT PARENTHESIS 0257 03670 127661 JMP LPCK,I EXIT 0258** 0259*** CHECK FOR RIGHT PARENTHESIS ** 0260** 0261 03671 000000 RPCK NOP 0262 03672 064432 LDB M2 RIGHT PARENTHESIS 0263 03673 015274 JSB SYMCK OR 0264 03674 002264 DEF RPARN-1 RIGHT BRACKET? 0265 03675 027255 JMP FSCE2 NO 0266 03676 060406 LDA B4000 YES, RECORD A 0267 03677 170135 STA SBPTR,I RIGHT PARENTHESIS 0268 03700 034135 ISZ SBPTR UPDATE SYNTAX BUFFER POINTER 0269 03701 015614 JSB GETCR FETCH 0270 03702 060334 LDA .10 FOLLOWING CHARACTER 0271 03703 127671 JMP RPCK,I 0272** 0273*** FETCH MAT STATEMENT SUBSCRIPT ** 0274** 0275 03704 000000 MATSB NOP 0276 03705 064432 LDB M2 LEFT PARENTHESIS 0277 03706 015274 JSB SYMCK OR 0278 03707 002320 DEF LBRAC-1 LEFT BRACKET? 0279 03710 127704 JMP MATSB,I NO 0280 03711 037704 ISZ MATSB YES, SET RETURN ADDRESS 0281 03712 060412 LDA B2200 RECORD A 0282 03713 170135 STA SBPTR,I LEFT BRACKET 0283 03714 017114 JSB FSC FETCH SUBSCRIPT 0284 03715 007400 CCB 0285 03716 015274 JSB SYMCK COMMA? 0286 03717 002260 DEF COMMA-1 0287 03720 002001 RSS NO 0288 03721 017114 JSB FSC YES, FETCH SUBSCRIPT 0289 03722 064432 LDB M2 RIGHT PARENTHESIS 0290 03723 015274 JSB SYMCK OR 0291 03724 002264 DEF RPARN-1 RIGHT BRACKET 0292 03725 027255 JMP FSCE2 0293 03726 060407 LDA LF RECORD A 0294 03727 170135 STA SBPTR,I RIGHT BRACKET 0295 03730 034135 ISZ SBPTR 0296 03731 015614 JSB GETCR END-OF-STATEMENT? 0297 03732 124252 JMP ACCST,I YES 0298 03733 127704 JMP MATSB,I PAGE 0064 #04 CHECK SYNTAX AND TRANSLITERATE 0300** 0301*** FETCH PARENTHESIZED FORMULA ** 0302** 0303 03734 000000 GETPF NOP 0304 03735 015614 JSB GETCR 0305 03736 024265 JMP EOF 0306 03737 034135 ISZ SBPTR 0307 03740 017661 JSB LPCK FETCH LEFT PARENTHESIS 0308 03741 017114 JSB FSC FETCH FORMULA 0309 03742 017671 JSB RPCK GET RIGHT PARENTHESIS 0310 03743 127734 JMP GETPF,I 0311** 0312*** FLAG OPERATOR WHICH PRECEDES NUMBER ** 0313** 0314 03744 000000 NUMOP NOP 0315 03745 070164 STA TEMP4 0316 03746 064433 LDB M3 FETCH 0317 03747 044135 ADB SBPTR PRECEDING 0318 03750 160001 LDA 1,I OPERATOR 0319 03751 030470 IOR FLGBT ADD FLAG BIT 0320 03752 170001 STA 1,I REPLACE OPERATOR 0321 03753 060164 LDA TEMP4 0322 03754 127744 JMP NUMOP,I PAGE 0065 #04 CHECK SYNTAX AND TRANSLITERATE 0324* 0325* SYSTEM COMMAND TABLE 0326* 0327 03755 000003 SYCMD OCT 00003 0328 03756 051125 ASC 2,RUN EXECUTE PROGRAM 0329* 0330 03760 002003 OCT 02003 0331 03761 051503 ASC 2,SCR SCRATCH PROGRAM 0332* 0333 03763 003004 OCT 03004 0334 03764 046111 ASC 2,LIST LIST COMMAND 0335* 0336 03766 005005 OCT 05005 0337 03767 050114 ASC 3,PLIST PUNCH LIST COMMAND 0338* 0339 03772 012003 OCT 12003 0340 03773 050124 ASC 2,PTA ACTIVATE PHOTO-READER 0341* 0342 03775 033004 OCT 33004 0343 03776 051524 STCMD ASC 2,STOP ABORT CURRENT ACTIVITY 0344* 0345 04000 046003 OCT 46003 0346 04001 052101 ASC 2,TAP ACTIVATE TTY TAPE MODE 0347* 0348 04003 050003 OCT 50003 0349 04004 041131 ASC 2,BYE EXIT SYSTEM 0350** 0351*** PRINT NAME TABLE FOR OPERATORS ** 0352** 0353 04006 032003 LET OCT 32003 BITS 15-9 OF THE LABELLED WORD 0354 04007 046105 ASC 2,LET 0355 04011 033003 DIM OCT 33003 ARE THE BASIC CODE OPERATOR 0356 04012 042111 ASC 2,DIM 0357 04014 034003 COM OCT 34003 NUMBERS. BITS 2-0 ARE THE 0358 04015 041517 ASC 2,COM 0359 04017 035003 DEF OCT 35003 LENGTH IN CHARACTERS OF THE 0360 04020 042105 ASC 2,DEF 0361 04022 036003 REM OCT 36003 SYMBOL. THE ASCII VERSION OF 0362 04023 051105 ASC 2,REM 0363 04025 037004 GOTO OCT 37004 THE SYMBOL FOLLOWS. 0364 04026 043517 ASC 2,GOTO 0365 04030 040002 IF OCT 40002 0366 04031 044506 ASC 1,IF 0367 04032 041003 FOR OCT 41003 0368 04033 043117 ASC 2,FOR 0369 04035 042004 NEXT OCT 42004 0370 04036 047105 ASC 2,NEXT 0371 04040 043005 GOSUB OCT 43005 0372 04041 043517 ASC 3,GOSUB 0373 04044 044006 RTRN OCT 44006 0374 04045 051105 ASC 3,RETURN 0375 04050 045003 END OCT 45003 0376 04051 042516 ASC 2,END 0377 04053 046004 STP OCT 46004 0378 04054 051524 ASC 2,STOP 0379 04056 047004 WAIT OCT 47004 PAGE 0066 #04 CHECK SYNTAX AND TRANSLITERATE 0380 04057 053501 ASC 2,WAIT 0381 04061 050004 CALL OCT 50004 0382 04062 041501 ASC 2,CALL 0383 04064 051004 DATA OCT 51004 0384 04065 042101 ASC 2,DATA 0385 04067 052004 READ OCT 52004 0386 04070 051105 ASC 2,READ 0387 04072 053005 PRINT OCT 53005 0388 04073 050122 ASC 3,PRINT 0389 04076 054005 INPUT OCT 54005 0390 04077 044516 ASC 3,INPUT 0391 04102 055007 RSTOR OCT 55007 0392 04103 051105 ASC 4,RESTORE 0393 04107 056003 MAT OCT 56003 0394 04110 046501 ASC 2,MAT 0395 04112 057004 THEN OCT 57004 0396 04113 052110 ASC 2,THEN 0397 04115 060002 TO OCT 60002 0398 04116 052117 ASC 1,TO 0399 04117 061004 STEP OCT 61004 0400 04120 051524 ASC 2,STEP 0401 04122 027003 NOT OCT 27003 0402 04123 047117 ASC 2,NOT 0403 04125 026003 AND OCT 26003 0404 04126 040516 ASC 2,AND 0405 04130 025002 OR OCT 25002 0406 04131 047522 ASC 1,OR 0407 04132 030002 GTE OCT 30002 0408 04133 037075 ASC 1,>= 0409 04134 031002 LTE OCT 31002 0410 04135 036075 ASC 1,<= 0411 04136 017002 AUNEQ OCT 17002 ALTERNATE UNEQUAL SIGN 0412 04137 036076 ASC 1,<> 0413* 0414 04140 001003 TAB OCT 1003 0415 04141 052101 ASC 2,TAB 0416 04143 002003 SIN OCT 2003 THIS SECTION HAS THE PRE-DEFINED 0417 04144 051511 ASC 2,SIN 0418 04146 003003 COS OCT 3003 FUNCTIONS. HERE BITS 13-9 ARE 0419 04147 041517 ASC 2,COS 0420 04151 004003 TAN OCT 4003 THE IDENTIFYING NUMBER OF THE 0421 04152 052101 ASC 2,TAN 0422 04154 005003 ATN OCT 5003 FUNCTION. 0423 04155 040524 ASC 2,ATN 0424 04157 006003 EXPN OCT 6003 0425 04160 042530 ASC 2,EXP 0426 04162 007003 LOG OCT 7003 0427 04163 046117 ASC 2,LOG 0428 04165 010003 ABS OCT 10003 0429 04166 040502 ASC 2,ABS 0430 04170 011003 SQR OCT 11003 0431 04171 051521 ASC 2,SQR 0432 04173 012003 INT OCT 12003 0433 04174 044516 ASC 2,INT 0434 04176 013003 RND OCT 13003 0435 04177 051116 ASC 2,RND PAGE 0067 #04 CHECK SYNTAX AND TRANSLITERATE 0436 04201 014003 SGN OCT 14003 0437 04202 051507 ASC 2,SGN 0438 04204 015003 ZER OCT 15003 MATRIX FUNCTIONS 0439 04205 055105 ASC 2,ZER 0440 04207 016003 CON OCT 16003 0441 04210 041517 ASC 2,CON 0442 04212 017003 IDN OCT 17003 0443 04213 044504 ASC 2,IDN 0444 04215 020003 INV OCT 20003 0445 04216 044516 ASC 2,INV 0446 04220 021003 TRN OCT 21003 0447 04221 052122 ASC 2,TRN 0448** 0449*** TABLE SEARCH FOR MULTICHARACTER SYMBOLS ** 0450** 0451 04223 000000 TBSRH NOP 0452 04224 072333 STA TABLE STORE TABLE ADDRESS 0453 04225 074167 STB LNGTH STORE -(NUMBER OF ENTRIES) 0454 04226 060132 LDA BADDR SAVE 0455 04227 070163 STA TEMP3 INPUT 0456 04230 060133 LDA CCNT BUFFER 0457 04231 070164 STA TEMP4 STATUS 0458 04232 060135 LDA SBPTR INITIALIZE END-OF-SYMBOL 0459 04233 072351 STA SMEND POINTER 0460 04234 002404 CLA,INA COUNT FIRST CHARACTER OF 0461 04235 072556 STA SLENG SYMBOL 0462 04236 160135 LDA SBPTR,I FETCH PARTIAL SYMBOL 0463 04237 010374 AND B177 TWO 0464 04240 150135 CPA SBPTR,I CHARACTERS? 0465 04241 002001 RSS NO 0466 04242 026265 JMP TSR10 YES 0467 04243 001727 ALF,ALF LEFT-JUSTIFY 0468 04244 030345 IOR .32 FIRST CHARACTER AND 0469 04245 170135 STA SBPTR,I APPEND BLANK 0470 04246 015614 TSRC1 JSB GETCR FETCH NEXT CHARACTER 0471 04247 026326 JMP TSRC9 END-OF-STATEMENT 0472 04250 066556 LDB SLENG CHECK FOR 0473 04251 054331 CPB .7 IMPOSSIBLE LENGTH 0474 04252 026326 JMP TSRC9 0475 04253 004010 SLB EVEN-NUMBERED CHARACTER? 0476 04254 026262 JMP TSRC2 YES 0477 04255 036351 ISZ SMEND NO, FETCH FRESH WORD, 0478 04256 001727 ALF,ALF LEFT-JUSTIFY CHARACTER, 0479 04257 030345 IOR .32 APPEND BLANK, 0480 04260 172351 STA SMEND,I AND STORE 0481 04261 026265 JMP TSR10 0482 04262 040450 TSRC2 ADA M32 DELETE BLANK, 0483 04263 142351 ADA SMEND,I FILL SECOND CHARACTER, 0484 04264 172351 STA SMEND,I AND STORE 0485 04265 036556 TSR10 ISZ SLENG COUNT IT 0486 04266 064167 LDB LNGTH INITIALIZE TABLE LENGTH 0487 04267 074165 STB COUNT COUNTER 0488 04270 062333 LDA TABLE 0489 04271 072513 TSRC3 STA TBLPT SET TABLE POINTER 0490 04272 162513 LDA TBLPT,I EXTRACT SYMBOL LENGTH 0491 04273 010331 AND .7 FROM TABLE AND COMPARE PAGE 0068 #04 CHECK SYNTAX AND TRANSLITERATE 0492 04274 052556 CPA SLENG WITH CURRENT SYMBOL 0493 04275 026304 JMP TSRC5 EQUAL? 0494 04276 040326 TSRC4 ADA .3 DIFFERENT, 0495 04277 001100 ARS UPDATE 0496 04300 042513 ADA TBLPT TABLE POINTER 0497 04301 034165 ISZ COUNT MORE ENTRIES? 0498 04302 026271 JMP TSRC3 YES 0499 04303 026246 JMP TSRC1 NO 0500 04304 066513 TSRC5 LDB TBLPT SET POINTER TO 0501 04305 076537 STB TSPTR TABLE SYMBOL 0502 04306 064135 LDB SBPTR SET (B) TO INPUT 0503 04307 026313 JMP TSRC7 SYMBOL POINTER 0504 04310 056351 TSRC6 CPB SMEND ALL OF SYMBOL CONSIDERED? 0505 04311 026321 JMP TSRC8 YES, MATCH OCCURRED 0506 04312 006004 INB NO, INCREMENT 0507 04313 036537 TSRC7 ISZ TSPTR SYMBOL POINTERS 0508 04314 162537 LDA TSPTR,I FETCH WORD FROM TABLE 0509 04315 150001 CPA 1,I MATCH WITH INPUT SYMBOL? 0510 04316 026310 JMP TSRC6 YES 0511 04317 062556 LDA SLENG NO, WRONG 0512 04320 026276 JMP TSRC4 SYMBOL 0513 04321 162513 TSRC8 LDA TBLPT,I EXTRACT 0514 04322 010420 AND OPMSK SYMBOL CODE 0515 04323 170135 STA SBPTR,I 0516 04324 036223 ISZ TBSRH AND RETURN VIA 0517 04325 126223 JMP TBSRH,I 'SUCCESS' EXIT 0518 04326 060163 TSRC9 LDA TEMP3 RESTORE 0519 04327 070132 STA BADDR INPUT 0520 04330 060164 LDA TEMP4 BUFFER 0521 04331 070133 STA CCNT STATUS 0522 04332 126223 JMP TBSRH,I 'FAILURE' EXIT 0523** 0524*** FETCH AND RECORD PROGRAM INTEGER ** 0525** 0526 04333 000000 PRGIN NOP 0527 04334 160135 LDA SBPTR,I SET 0528 04335 030470 IOR FLGBT 'INTEGER 0529 04336 040326 ADA .3 FOLLOWS' 0530 04337 170135 STA SBPTR,I OPERAND 0531 04340 162333 LDA PRGIN,I GIVE ADDRESS 0532 04341 072346 STA PRGI1 TO INTCK 0533 04342 034135 ISZ SBPTR 0534 04343 015614 JSB GETCR 0535 04344 014477 SYE25 JSB ERROR 0536 04345 016351 JSB INTCK FETCH 0537 04346 000000 PRGI1 NOP 0538 04347 036333 ISZ PRGIN 0539 04350 126333 JMP PRGIN,I 0540** 0541*** BUILD AN INTEGER ** 0542** 0543 04351 000000 INTCK NOP CHARACTER IN (A) 0544 04352 006400 CLB STORE 0545 04353 076556 STB INTGR PARTIAL RESULT 0546 04354 015570 INTC1 JSB DIGCK DIGIT? 0547 04355 026373 JMP INTC2 NO PAGE 0069 #04 CHECK SYNTAX AND TRANSLITERATE 0548 04356 103101 CLO 0549 04357 066556 LDB INTGR MULTIPLY 0550 04360 044001 ADB 1 PARTIAL 0551 04361 044001 ADB 1 RESULT 0552 04362 046556 ADB INTGR BY 0553 04363 044001 ADB 1 10 0554 04364 044000 ADB 0 ADD LATEST DIGIT 0555 04365 102201 SOC OVERFLOW? 0556 04366 026344 JMP SYE25 YES 0557 04367 076556 STB INTGR STORE PARTIAL RESULT 0558 04370 015614 JSB GETCR NO, FETCH 0559 04371 060334 LDA .10 NEXT CHARACTER 0560 04372 026354 JMP INTC1 0561 04373 066556 INTC2 LDB INTGR ZERO 0562 04374 006003 SZB,RSS INTEGER? 0563 04375 026344 JMP SYE25 YES 0564 04376 174135 STB SBPTR,I NO, RECORD IT 0565 04377 166351 LDB INTCK,I INTEGER 0566 04400 164001 LDB 1,I TOO 0567 04401 046556 ADB INTGR LARGE? 0568 04402 006021 SSB,RSS 0569 04403 026344 JMP SYE25 YES 0570 04404 066556 LDB INTGR NO, 0571 04405 034135 ISZ SBPTR RETURN WITH 0572 04406 036351 ISZ INTCK INTEGER 0573 04407 126351 JMP INTCK,I IN (B) 0574** 0575*** PROCESS CHARACTER STRING ** 0576** 0577 04410 000000 CHRST NOP 0578 04411 070162 STA TEMP2 RECORD TERMINATOR CHARACTER 0579 04412 060334 LDA .10 DUMMY 0580 04413 070476 STA BLANK DELETE CHARACTER 0581 04414 015614 CHRS1 JSB GETCR 0582 04415 026433 JMP CHRS3 TO END-OF-STATEMENT EXIT 0583 04416 050162 CPA TEMP2 TERMINATOR CHARACTER? 0584 04417 026432 JMP CHRS2 YES 0585 04420 130135 IOR SBPTR,I NO, FILL 0586 04421 170135 STA SBPTR,I SECOND CHARACTER 0587 04422 015614 JSB GETCR 0588 04423 026433 JMP CHRS3 TO END-OF-STATEMENT EXIT 0589 04424 050162 CPA TEMP2 TERMINATOR CHARACTER? 0590 04425 026432 JMP CHRS2 YES 0591 04426 034135 ISZ SBPTR NO, MOVE TO NEW WORD 0592 04427 001727 ALF,ALF AND STORE 0593 04430 170135 STA SBPTR,I FIRST CHARACTER 0594 04431 026414 JMP CHRS1 0595 04432 036410 CHRS2 ISZ CHRST SET (P+2) EXIT 0596 04433 034135 CHRS3 ISZ SBPTR MOVE TO NEXT BUFFER WORD 0597 04434 060345 LDA .32 RESTORE BLANK AS 0598 04435 070476 STA BLANK DELETE CHARACTER 0599 04436 126410 JMP CHRST,I PAGE 0070 #04 CHECK SYNTAX AND TRANSLITERATE 0601** 0602*** DELETE STATEMENT ** 0603** 0604 04437 160134 DLSTM LDA SBUFA,I LOAD SEQUENCE NUMBER 0605 04440 016513 JSB FNDPS FIND STATEMENT TO BE DELETED 0606 04441 124204 JMP PEXMA,I DOESN'T 0607 04442 124204 JMP PEXMA,I EXIST 0608 04443 002400 CLA ZERO WORD SKIP FOR DESTINATION 0609 04444 006004 INB ADDRESS OF SOURCE WORD SKIP IN B 0610 04445 016537 JSB CLPRG CLOSE UP PROGRAM 0611 04446 124204 JMP PEXMA,I EXIT TO PHASE 1 WAIT 0612* 0613*** *** 0614** ACCEPT STATEMENT ** 0615*** *** 0616* 0617 04447 060134 ACTST LDA SBUFA COMPUTE 0618 04450 003004 CMA,INA LENGTH 0619 04451 040135 ADA SBPTR OF STATEMENT 0620 04452 170160 STA TEMP,I AND RECORD IT 0621 04453 160134 LDA SBUFA,I LOAD SEQUENCE NUMBER 0622 04454 016513 JSB FNDPS SEARCH ON SEQUENCE NUMBER 0623 04455 026472 JMP ACCS1 APPEND STATEMENT TO PROGRAM 0624 04456 026507 JMP ACCS4 INSERT STATEMENT IN PROGRAM 0625 04457 006004 INB REPLACE STATEMENT IN PROGRAM 0626 04460 160001 LDA 1,I COMPARE LENGTHS OF 0627 04461 003004 CMA,INA STATEMENT BEING REPLACED 0628 04462 140160 ADA TEMP,I AND STATEMENT 0629 04463 002003 SZA,RSS REPLACING IT 0630 04464 026474 JMP ACCS2 EQUAL 0631 04465 002021 SSA,RSS 0632 04466 026510 JMP ACCS4+1 SHORTER 0633 04467 160160 LDA TEMP,I LONGER, 0634 04470 016537 JSB CLPRG CLOSE UP PROGRAM 0635 04471 026474 JMP ACCS2 0636 04472 160160 ACCS1 LDA TEMP,I LOAD PROGRAM SPACE REQUIREMENT 0637 04473 016556 JSB OVCHK SUFFICIENT PROGRAM SPACE LEFT? 0638 04474 006400 ACCS2 CLB YES, SET COUNTER TO ZERO 0639 04475 060134 LDA SBUFA INITIALIZE 0640 04476 070162 STA TEMP2 SOURCE ADDRESS 0641 04477 160162 ACCS3 LDA TEMP2,I TRANSFER WORD FROM 0642 04500 170163 STA TEMP3,I S-BUFFER TO PROGRAM SPACE 0643 04501 034162 ISZ TEMP2 INCREMENT SOURCE AND 0644 04502 034163 ISZ TEMP3 DESTINATION ADDRESSES 0645 04503 006004 INB BUMP COUNTER 0646 04504 154160 CPB TEMP,I ENTIRE STATEMENT MOVED? 0647 04505 124204 JMP PEXMA,I YES 0648 04506 026477 JMP ACCS3 NO 0649 04507 160160 ACCS4 LDA TEMP,I LOAD PROGRAM SPACE REQUIREMENT 0650 04510 016556 JSB OVCHK SUFFICIENT PROGRAM SPACE LEFT? 0651 04511 014554 JSB MVTOH MAKE 0652 04512 026474 JMP ACCS2 ROOM PAGE 0071 #04 CHECK SYNTAX AND TRANSLITERATE 0654** 0655*** FIND SEQUENTIAL POSITION ** 0656** 0657 04513 000000 FNDPS NOP 0658 04514 070163 STA TEMP3 SAVE SEQUENCE NUMBER 0659 04515 064112 LDB PBUFF STARTING ADDRESS 0660 04516 054113 FNDP1 CPB PBPTR END OF PROGRAM? 0661 04517 026535 JMP FNDP4 YES, EXIT VIA (P+1) 0662 04520 160001 LDA 1,I SUBTRACT PROGRAM 0663 04521 003004 CMA,INA SEQUENCE NUMBER FROM 0664 04522 040163 ADA TEMP3 S-BUFFER SEQUENCE NUMBER 0665 04523 002003 SZA,RSS EQUAL? 0666 04524 026533 JMP FNDP2 YES, SET EXIT TO (P+3) 0667 04525 002020 SSA NO, P-SEQ NO > S-SEQ NO ? 0668 04526 026534 JMP FNDP3 YES, SET EXIT TO (P+2) 0669 04527 060001 LDA 1 POINT (A) TO 0670 04530 002004 INA PROGRAM ADDRESS INCREMENT 0671 04531 144000 ADB 0,I COMPUTE NEW ADDRESS 0672 04532 026516 JMP FNDP1 0673 04533 036513 FNDP2 ISZ FNDPS 0674 04534 036513 FNDP3 ISZ FNDPS 0675 04535 074163 FNDP4 STB TEMP3 SAVE STATEMENT ADDRESS 0676 04536 126513 JMP FNDPS,I 0677** 0678*** DELETE SPACE IN PROGRAM ** 0679** 0680 04537 000000 CLPRG NOP REFERENCE LOCATION IN TEMP3 0681 04540 040163 ADA TEMP3 SKIP (A) LOCATIONS FROM TEMP3 0682 04541 070164 STA TEMP4 AND SAVE DESTINATION ADDRESS 0683 04542 164001 LDB 1,I SKIP TO END OF STATEMENT BEING 0684 04543 044163 ADB TEMP3 DELETED, SOURCE ADDRESS IN (B) 0685 04544 054113 CLPR1 CPB PBPTR ALL OF PROGRAM MOVED? 0686 04545 026553 JMP CLPR2 YES 0687 04546 160001 LDA 1,I NO, MOVE WORD FROM SOURCE TO 0688 04547 170164 STA TEMP4,I DESTINATION ADDRESS 0689 04550 034164 ISZ TEMP4 INCREMENT DESTINATION ADDRESS 0690 04551 006004 INB INCREMENT SOURCE ADDRESS 0691 04552 026544 JMP CLPR1 0692 04553 060164 CLPR2 LDA TEMP4 SET END-OF-PROGRAM 0693 04554 070113 STA PBPTR POINTER 0694 04555 126537 JMP CLPRG,I 0695** 0696*** CHECK FOR PROGRAM SPACE OVERFLOW ** 0697** 0698 04556 000000 OVCHK NOP NEW WORD REQUIREMENT IN (A) 0699 04557 064113 LDB PBPTR SET SOURCE ADDRESS 0700 04560 074162 STB TEMP2 FOR PROGRAM RELOCATION 0701 04561 044000 ADB 0 SET DESTINATION 0702 04562 074164 STB TEMP4 ADDRESS 0703 04563 007004 CMB,INB ENOUGH 0704 04564 044106 ADB LWBM FREE 0705 04565 006020 SSB SPACE? 0706 04566 124271 JMP FSCEF,I NO, PROGRAM SPACE OVERFLOW 0707 04567 064164 LDB TEMP4 YES, RELOCATE FREE 0708 04570 074113 STB PBPTR PROGRAM SPACE POINTER 0709 04571 126556 JMP OVCHK,I PAGE 0072 #05 LIST PROGRAM 0002* 0003* ********************** 0004**** *** 0005*** LIST THE PROGRAM *** 0006**** *** 0007* ********************** 0008* 0009 04572 064112 LIST LDB PBUFF INITIALIZE TO FIRST 0010 04573 074157 STB TEMPS STATEMENT OF PROGRAM 0011 04574 015614 JSB GETCR SEQUENCE NUMBER GIVEN? 0012 04575 026607 JMP LIST0 NO 0013 04576 064131 LDB .BUFA YES, SET FOR 0014 04577 074135 STB SBPTR SEQUENCE NUMBER 0015 04600 114216 JSB INCHK,I FETCH 0016 04601 000463 DEF MAXSN IT 0017 04602 160131 LDA .BUFA,I LOAD SEQUENCE NUMBER 0018 04603 016513 JSB FNDPS FIND INTIAL STATEMENT 0019 04604 124205 JMP RDYDA,I 0020 04605 000000 NOP SAVE 0021 04606 074157 STB TEMPS ADDRESS 0022 04607 006400 LIST0 CLB HIGH-SPEED 0023 04610 054136 CPB TFLAG PUNCH? 0024 04611 026614 JMP LIST1 NO 0025 04612 060373 LDA B133 YES, EMIT 0026 04613 114127 JSB LISTR,I LEADER 0027 04614 064157 LIST1 LDB TEMPS MORE 0028 04615 054113 CPB PBPTR PROGRAM? 0029 04616 027003 JMP LIS13 NO 0030 04617 003400 CCA INITIALIZE 0031 04620 040134 ADA SBUFA OUTPUT BUFFER 0032 04621 070132 STA BADDR POINTER 0033 04622 002400 CLA INITIALIZE 0034 04623 070133 STA CCNT CHARACTER COUNT 0035 04624 160157 LDA TEMPS,I OUTPUT 0036 04625 017015 JSB OUTIN SEQUENCE NUMBER 0037 04626 060476 LDA BLANK OUTPUT 0038 04627 015715 JSB OUTCR BLANK 0039 04630 034157 ISZ TEMPS FETCH 0040 04631 160157 LDA TEMPS,I STATEMENT LENGTH 0041 04632 003004 CMA,INA SET 0042 04633 002004 INA WORD 0043 04634 071467 STA SLWST COUNTER 0044 04635 034157 LIST3 ISZ TEMPS MORE 0045 04636 035467 ISZ SLWST STATEMENT? 0046 04637 026644 JMP LIST4 YES 0047 04640 064134 LIST2 LDB SBUFA OUTPUT 0048 04641 060133 LDA CCNT 0049 04642 114127 JSB LISTR,I STATEMENT 0050 04643 026614 JMP LIST1 0051 04644 160157 LIST4 LDA TEMPS,I 0052 04645 010420 AND OPMSK 0053 04646 002003 SZA,RSS NULL OPERATOR? 0054 04647 026670 JMP LIST5 YES 0055 04650 070162 STA TEMP2 NO, SAVE OPERATOR 0056 04651 001727 ALF,ALF SINGLE 0057 04652 001100 ARS PAGE 0073 #05 LIST PROGRAM 0058 04653 064000 LDB 0 CHARACTER 0059 04654 040446 ADA M21 0060 04655 002021 SSA,RSS OPERATOR? 0061 04656 026772 JMP LIS12 NO 0062 04657 005000 BLS YES 0063 04660 006004 INB LOAD 0064 04661 044301 ADB FOPBS SYMBOL'S 0065 04662 160001 LDA 1,I ASCII WORD 0066 04663 001727 ALF,ALF ADJUST 0067 04664 010376 AND MSK0 CHARACTER 0068 04665 050347 CPA .34 * ? 0069 04666 027011 JMP LIS14 YES 0070 04667 015715 JSB OUTCR NO 0071 04670 160157 LIST5 LDA TEMPS,I 0072 04671 010425 AND OPDMK SAVE 0073 04672 070163 STA TEMP3 OPERAND 0074 04673 010423 AND TYPFL EXTRACT OPERAND TYPE 0075 04674 072333 STA LFLAG SET LFLAG FALSE 0076 04675 002020 SSA FLAG BIT SET? 0077 04676 026732 JMP LIST9 YES 0078 04677 002003 SZA,RSS NO, NULL OPERAND? 0079 04700 026635 JMP LIST3 YES 0080 04701 050336 CPA .15 FUNCTION? 0081 04702 026725 JMP LIST8 YES 0082 04703 040435 LIST6 ADA M5 0083 04704 002020 SSA LETTER-DIGIT COMBINATION? 0084 04705 026710 JMP LIST7 NO 0085 04706 003400 CCA YES, SET 0086 04707 072333 STA LFLAG LFLAG FALSE 0087 04710 060163 LIST7 LDA TEMP3 0088 04711 001727 ALF,ALF RESTORE AND 0089 04712 001700 ALF 0090 04713 010374 AND B177 OUTPUT 0091 04714 040363 ADA B100 0092 04715 015715 JSB OUTCR LETTER 0093 04716 036333 ISZ LFLAG DIGIT FOLLOWS? 0094 04717 026635 JMP LIST3 NO 0095 04720 060163 LDA TEMP3 YES 0096 04721 010336 AND .15 RESTORE 0097 04722 040353 ADA .43 DIGIT 0098 04723 015715 JSB OUTCR OUTPUT DIGIT 0099 04724 026635 JMP LIST3 0100 04725 060365 LIST8 LDA F OUTPUT 0101 04726 015715 JSB OUTCR 'F' 0102 04727 060371 LDA N OUTPUT 0103 04730 015715 JSB OUTCR 'N' 0104 04731 026710 JMP LIST7 0105 04732 020470 LIST9 XOR FLGBT 0106 04733 002102 CLE,SZA NUMBER? 0107 04734 026751 JMP LIS10 NO 0108 04735 034157 ISZ TEMPS YES 0109 04736 070153 STA SIGN SET SIGN FLAG FALSE 0110 04737 160157 LDA TEMPS,I 0111 04740 034157 ISZ TEMPS 0112 04741 164157 LDB TEMPS,I 0113 04742 035467 ISZ SLWST PAGE 0074 #05 LIST PROGRAM 0114 04743 035467 ISZ SLWST 0115 04744 002020 SSA NEGATIVE NUMBER? 0116 04745 002300 CCE YES, SET SIGN FLAG TRUE 0117 04746 114220 JSB NUMOA,I 0118 04747 000000 NOP 0119 04750 026635 JMP LIST3 0120 04751 050326 LIS10 CPA .3 INTEGER? 0121 04752 026765 JMP LIS11 YES 0122 04753 050336 CPA .15 NO, FUNCTION? 0123 04754 002001 RSS YES 0124 04755 026703 JMP LIST6 NO, MUST BE A PARAMETER 0125 04756 060163 LDA TEMP3 COMPUTE 0126 04757 001722 ALF,RAL PRINT 0127 04760 010420 AND OPMSK TABLE 0128 04761 070162 STA TEMP2 CODE 0129 04762 064322 LDB ATAB OUTPUT 0130 04763 017077 JSB MCOUT FUNCTION NAME 0131 04764 026635 JMP LIST3 0132 04765 034157 LIS11 ISZ TEMPS OUTPUT 0133 04766 035467 ISZ SLWST 0134 04767 160157 LDA TEMPS,I INTEGER 0135 04770 017015 JSB OUTIN 0136 04771 026635 JMP LIST3 OPERAND 0137 04772 060476 LIS12 LDA BLANK OUTPUT 0138 04773 015715 JSB OUTCR BLANK 0139 04774 064307 LDB STTYP OUTPUT 0140 04775 017077 JSB MCOUT OPERATOR 0141 04776 060415 LDA REMOP WAS IT 0142 04777 050162 CPA TEMP2 A REM? 0143 05000 027056 JMP OUTS1 YES, OUTPUT REMARK 0144 05001 060476 LDA BLANK NO, OUTPUT 0145 05002 026667 JMP LIST5-1 A BLANK 0146 05003 006400 LIS13 CLB HIGH-SPEED 0147 05004 054136 CPB TFLAG PUNCH? 0148 05005 124205 JMP RDYDA,I NO 0149 05006 060373 LDA B133 YES, EMIT 0150 05007 114127 JSB LISTR,I TRAILER 0151 05010 124205 JMP RDYDA,I 0152 05011 015715 LIS14 JSB OUTCR OUTPUT * 0153 05012 017055 JSB OUTST OUTPUT QUOTE STRING 0154 05013 060347 LDA .34 OUTPUT 0155 05014 026667 JMP LIST5-1 0156* * 0157** OUTPUT AN INTEGER ** 0158* * 0159 05015 000000 OUTIN NOP INTEGER IN (A) 0160 05016 064434 LDB M4 SET 0161 05017 077522 STB DIGCT DIGIT COUNTER 0162 05020 067132 LDB LDVSR SET DIVISOR 0163 05021 076351 STB DIVSR ADDRESS 0164 05022 006400 CLB SET LEADING 0165 05023 076556 STB LDZRO ZERO FLAG 0166 05024 166351 OUTI1 LDB DIVSR,I NEGATE 0167 05025 007004 CMB,INB AND STORE 0168 05026 076513 STB MIND DIVISOR 0169 05027 007400 CCB SET QUOTIENT PAGE 0075 #05 LIST PROGRAM 0170 05030 006004 INB TO ZERO 0171 05031 042513 ADA MIND SUBTRACT DIVISOR FROM INTEGER 0172 05032 002021 SSA,RSS NEGATIVE RESULT? 0173 05033 027030 JMP *-3 NO, INCREMENT QUOTIENT 0174 05034 142351 ADA DIVSR,I YES, RECOVER REMAINDER 0175 05035 073077 STA MCOUT AND SAVE IT 0176 05036 060001 LDA 1 0177 05037 002002 SZA ZERO? 0178 05040 027043 JMP OUTI2 NO 0179 05041 052556 CPA LDZRO YES, LEADING ZERO? 0180 05042 027046 JMP OUTI3 YES 0181 05043 040357 OUTI2 ADA .48 NO, COMPUTE ASCII FOR DIGIT 0182 05044 072556 STA LDZRO SET 'ZEROES SIGNIFICANT' 0183 05045 015715 JSB OUTCR OUTPUT DIGIT 0184 05046 063077 OUTI3 LDA MCOUT RETRIEVE REMAINDER 0185 05047 036351 ISZ DIVSR SET FOR NEXT DIVISOR 0186 05050 037522 ISZ DIGCT DIVISION NECESSARY? 0187 05051 027024 JMP OUTI1 YES 0188 05052 040357 ADA .48 NO, COMPUTE ASCII FOR LAST 0189 05053 015715 JSB OUTCR DIGIT AND OUTPUT IT 0190 05054 127015 JMP OUTIN,I 0191* * 0192** OUTPUT A STRING ** 0193* * 0194 05055 000000 OUTST NOP * ENTRY POINT 0195 05056 160157 OUTS1 LDA TEMPS,I REM ENTRY POINT 0196 05057 010374 AND B177 OUTPUT SECOND CHARACTER 0197 05060 002002 SZA OF WORD IF 0198 05061 015715 JSB OUTCR NOT NULL 0199 05062 034157 ISZ TEMPS BUMP POINTER 0200 05063 035467 ISZ SLWST REM COMPLETED? 0201 05064 002001 RSS NO 0202 05065 026640 JMP LIST2 YES 0203 05066 160157 LDA TEMPS,I EXTRACT 0204 05067 001727 ALF,ALF FIRST CHARACTER 0205 05070 010374 AND B177 OF WORD 0206 05071 050325 CPA .2 EXIT 0207 05072 127055 JMP OUTST,I IF A 0208 05073 050326 CPA .3 CLOSING 0209 05074 127055 JMP OUTST,I QUOTE 0210 05075 015715 JSB OUTCR OUTPUT 0211 05076 027056 JMP OUTS1 CHARACTER 0212* * 0213** LIST A MULTICHARACTER SYMBOL ** 0214* * 0215 05077 000000 MCOUT NOP 0216 05100 160001 MCOU1 LDA 1,I LOAD INFORMATION WORD 0217 05101 010420 AND OPMSK COMPARE WITH 0218 05102 050162 CPA TEMP2 OPERATOR CODE 0219 05103 027112 JMP MCOU2 EQUAL 0220 05104 160001 LDA 1,I UNEQUAL, 0221 05105 010331 AND .7 COMPUTE 0222 05106 040326 ADA .3 ENTRY 0223 05107 001100 ARS LENGTH 0224 05110 044000 ADB 0 COMPUTE ADDRESS OF NEXT ENTRY 0225 05111 027100 JMP MCOU1 PAGE 0076 #05 LIST PROGRAM 0226 05112 160001 MCOU2 LDA 1,I COMPUTE 0227 05113 010331 AND .7 ENTRY 0228 05114 003004 CMA,INA LENGTH 0229 05115 073522 STA DIGCT AND SAVE IT 0230 05116 006104 CLE,INB SET FOR FIRST CHARACTER 0231 05117 074163 STB TEMP3 SAVE SYMBOL ADDRESS 0232 05120 160163 MCOU3 LDA TEMP3,I LOAD WORD 0233 05121 002041 SEZ,RSS FIRST CHARACTER? 0234 05122 001727 ALF,ALF YES, POSITION IT 0235 05123 010374 AND B177 EXTRACT CHARACTER 0236 05124 015715 JSB OUTCR OUTPUT IT 0237 05125 002240 SEZ,CME SET FOR NEXT CHARACTER 0238 05126 034163 ISZ TEMP3 MOVE TO NEXT WORD OF SYMBOL 0239 05127 037522 ISZ DIGCT MORE CHARACTERS? 0240 05130 027120 JMP MCOU3 YES 0241 05131 127077 JMP MCOUT,I 0242* 0243* 0244 05132 005133 LDVSR DEF *+1 0245 05133 023420 DEC 10000 0246 05134 001750 DEC 1000 0247 05135 000144 DEC 100 0248 05136 000012 DEC 10 0249* 0250* 0251 03530 SFLAG EQU ARRYS 0252 04333 TABLE EQU PRGIN 0253 00167 LNGTH EQU TEMPS+8 0254 04351 SMEND EQU INTCK 0255 04556 SLENG EQU OVCHK 0256 04513 TBLPT EQU FNDPS 0257 04537 TSPTR EQU CLPRG 0258 04556 INTGR EQU OVCHK 0259 04333 LFLAG EQU PRGIN 0260 04351 DIVSR EQU INTCK 0261 04556 LDZRO EQU OVCHK 0262 04513 MIND EQU FNDPS PAGE 0077 #05 PRE-EXECUTION PROCESSING 0264* *********************** 0265* PHASE 2 OF THE COMPILER 0266* *********************** 0267* 0268* THIS PHASE HAS THE FOLLOWING 3 FUNCTIONS: 0269* 1. SYMBOL TABLE CONSTRUCTION 0270* 2. FOR LOOP CHECKING 0271* 3. ARRAY STORAGE ALLOCATION 0272* 0273 05137 060113 MFASE LDA PBPTR NULL 0274 05140 050112 CPA PBUFF PROGRAM? 0275 05141 124205 JMP RDYDA,I YES 0276 05142 070115 STA FCORE NO, SET FOR-TABLE POINTER 0277 05143 060110 LDA FWAM 0278 05144 070170 STA COML INITIALIZE COMMON POINTER 0279 05145 060117 LDA SYMTA 0280 05146 070116 STA SYMTF INITIALIZE SYMBOL TABLE POINTER 0281 05147 060112 LDA PBUFF 0282 05150 070135 STA MPTR INITIALIZE PROGRAM POINTER 0283 05151 164135 MLOP1 LDB MPTR,I 0284 05152 074145 STB .LNUM SET LINE NUMBER 0285 05153 064135 LDB MPTR 0286 05154 034135 ISZ MPTR 0287 05155 144135 ADB MPTR,I COMPUTE LOCATION OF NEXT 0288 05156 075515 STB MNPTR STATEMENT AND STORE THIS 0289 05157 034135 ISZ MPTR 0290 05160 160135 LDA MPTR,I FETCH THE FIRST WORD IN THE 0291 05161 001100 MLO10 ARS STATEMENT AND SAVE 0292 05162 001727 ALF,ALF THE STATEMENT TYPE 0293 05163 010362 AND .63 0294 05164 070146 STA TYPE 0295 05165 050355 CPA .46 MAT STATEMENT? 0296 05166 027176 JMP MLO12 YES 0297 05167 050343 CPA .30 NO, REM STATEMENT? 0298 05170 074135 STB MPTR YES, SET TO SKIP IT 0299 05171 050353 CPA .43 NO, PRINT STATEMENT? 0300 05172 074135 STB MPTR YES, SET TO SKIP IT 0301 05173 003400 CCA NO, SET 0302 05174 070171 STA MWDNO 'FIRST VARIABLE' 0303 05175 027212 JMP MLOP2+1 FLAG 0304* 0305 05176 060135 MLO12 LDA MPTR SEEK 0306 05177 002004 INA SUBSIDIARY 0307 05200 160000 LDA 0,I STATEMENT 0308 05201 027161 JMP MLO10 TYPE 0309* 0310 05202 010401 MLO13 AND MSK1 YES, ISOLATE OPERAND 0311 05203 064135 LDB MPTR INDEX THE PROGRAM POINTER BY 0312 05204 002003 SZA,RSS AN AMOUNT APPROPRIATE TO THE 0313 05205 044325 ADB .2 OPERAND. THE FOLLOWING APPLIES 0314 05206 050326 CPA .3 OPERAND = 0 ADD 2 TO POINTER 0315 05207 006004 INB OPERAND =3 ADD 1 TO POINTER 0316 05210 074135 STB MPTR 0317* 0318 05211 034135 MLOP2 ISZ MPTR INCREMENT WORD-OF-STATEMENT PTR 0319 05212 060135 LDA MPTR STATEMENT PAGE 0078 #05 PRE-EXECUTION PROCESSING 0320 05213 051515 CPA MNPTR EXHAUSTED? 0321 05214 027272 JMP MLOP5 YES 0322 05215 160135 LDA MPTR,I NO 0323 05216 002020 SSA 'CONSTANT' OPERAND? 0324 05217 027202 JMP MLO13 YES 0325 05220 010401 AND MSK1 NO 0326 05221 002003 SZA,RSS NULL OPERAND? 0327 05222 027211 JMP MLOP2 YES 0328 05223 070157 STA MBOX1 NO, SAVE IT 0329 05224 010336 AND .15 PROGRAMMER-DEFINED 0330 05225 050336 CPA .15 FUNCTION? 0331 05226 027301 JMP MLOP6 YES 0332 05227 040434 ADA M4 NO 0333 05230 002020 SSA ARRAY VARIABLE? 0334 05231 027320 JMP MLOP7 YES 0335 05232 060157 LDA MBOX1 NO, SIMPLE VARIABLE 0336 05233 114231 JSB SSYMA,I ALREADY IN 0337 05234 006021 SSB,RSS SYMBOL TABLE? 0338 05235 027244 JMP MLOP3 YES 0339 05236 060470 LDA MNEG NO 0340 05237 064471 LDB MNEG+1 ENTER 0341 05240 070160 STA MBOX1+1 IT WITH 0342 05241 074161 STB MBOX1+2 'UNDEFINED' 0343 05242 060433 LDA M3 VALUE 0344 05243 017501 JSB ESYMT 0345 05244 064146 MLOP3 LDB TYPE 0346 05245 060157 LDA MBOX1 0347 05246 054347 CPB .34 NEXT STATEMENT? 0348 05247 027261 JMP MLOP4 YES 0349 05250 054346 CPB .33 NO, FOR STATEMENT? 0350 05251 034171 ISZ MWDNO YES, FIRST VARIABLE? 0351 05252 027211 JMP MLOP2 NO 0352 05253 034115 ISZ FCORE DEMAND 0353 05254 064115 LDB FCORE SPACE 0354 05255 054116 CPB SYMTF FOR NEW 0355 05256 027511 JMP MER8-1 ENTRY 0356 05257 170115 STA FCORE,I SAVE VARIABLE NAME 0357 05260 027211 JMP MLOP2 0358* 0359 05261 064115 MLOP4 LDB FCORE FOR-TABLE 0360 05262 054113 CPB PBPTR EMPTY? 0361 05263 014477 JSB ERROR YES 0362 05264 150115 MER3 CPA FCORE,I NO, MATCH LATEST ENTRY? 0363 05265 002001 RSS YES 0364 05266 027263 JMP MER3-1 NO 0365 05267 044431 ADB M1 REMOVE 0366 05270 074115 STB FCORE MATCHED 0367 05271 027211 JMP MLOP2 ENTRY 0368* 0369 05272 050113 MLOP5 CPA PBPTR PROGRAM EXHAUSTED? 0370 05273 002001 RSS YES 0371 05274 027151 JMP MLOP1 NO 0372 05275 060146 LDA TYPE YES 0373 05276 050350 CPA .37 END STATEMENT? 0374 05277 027407 JMP M1LOP YES 0375 05300 014477 JSB ERROR NO PAGE 0079 #05 PRE-EXECUTION PROCESSING 0376 05301 160135 MLOP6 LDA MPTR,I ISOLATE 0377 05302 010420 AND OPMSK PRECEDING OPERATOR 0378 05303 050414 CPA DEFOP 'DEF' ? 0379 05304 002001 RSS YES 0380 05305 027211 JMP MLOP2 NO GO TO PROCESS NEXT WORD 0381 05306 060157 LDA MBOX1 SEARCH SYMBOL TABLE FOR 0382 05307 114231 JSB SSYMA,I THE FUNCTION 0383 05310 006021 SSB,RSS 0384 05311 014477 JSB ERROR FOUND. ERROR MULTIPLY DEFINED 0385 05312 060135 MER4 LDA MPTR 0386 05313 040326 ADA .3 ENTER THE FUNCTION INTO THE 0387 05314 070160 STA MBOX1+1 SYMBOL TABLE TOGETHER WITH 0388 05315 060432 LDA M2 ITS ENTRY POINT IN THE SOURCE 0389 05316 017501 JSB ESYMT CODE 0390 05317 027211 JMP MLOP2 GO TO PROCESS THE NEXT WORD 0391* 0392 05320 070001 MLOP7 STA 1 0393 05321 060146 LDA TYPE 0394 05322 050341 CPA .27 DIM STATEMENT? 0395 05323 027335 JMP MLOP8 YES 0396 05324 050342 CPA .28 NO, COM STATEMENT? 0397 05325 027335 JMP MLOP8 YES 0398 05326 017522 JSB MSYMT NO, LOOK FOR IT IN SYMBOL TABLE 0399 05327 027211 JMP MLOP2 FOUND 0400 05330 002400 CLA NOT THERE 0401 05331 070160 STA MBOX1+1 ENTER IT WITH 0402 05332 070161 STA MBOX1+2 DIMENSIONS AND 0403 05333 070162 STA MBOX1+3 DIMENSIONALITY 0404 05334 027370 JMP MLOP0 UNDEFINED 0405* 0406 05335 034135 MLOP8 ISZ MPTR PROCESS COM OR DIM STMT 0407 05336 034135 ISZ MPTR 0408 05337 160135 LDA MPTR,I PICK UP FIRST DIMENSION 0409 05340 001727 ALF,ALF SHIFT TO M. S. PART OF WORD 0410 05341 054433 CPB M3 IS THIS A SINGLE DIMENSION ARRAY 0411 05342 027347 JMP *+5 YES, JUMP 0412 05343 034135 ISZ MPTR NO, INDEX POINTER TO THE LOC. 0413 05344 034135 ISZ MPTR OF SECOND DIMENSION AND PACK 0414 05345 130135 IOR MPTR,I INTO A WITH THE FIRST DIMENSION 0415 05346 002001 RSS 0416 05347 030324 IOR .1 0417 05350 070161 STA MBOX1+2 SET UP TO STORE PACKED 0418 05351 070162 STA MBOX1+3 DIMENSIONS IN FORMAL AND ACTUAL 0419 05352 002400 CLA SLOTS AND UNDEFINED FLAG IN 0420 05353 070160 STA MBOX1+1 STORAGE ALLOCATION SLOT 0421 05354 017522 JSB MSYMT IN SYMBOL TABLE? 0422 05355 027373 JMP MLOP9 NO 0423 05356 060146 LDA TYPE YES 0424 05357 050342 CPA .28 0425 05360 002001 RSS IS STMT A COM 0426 05361 027370 JMP MLOP0 NO, JUMP 0427 05362 060161 LDA MBOX1+2 YES PICK UP PACKED DIMENSIONS 0428 05363 015336 JSB MDIM COMPUTE STORAGE REQUIRED 0429 05364 064170 LDB COML POINTER TO NEXT FREE LOC IN COM 0430 05365 074160 STB MBOX1+1 STORE IN STORAGE ALLOCATION SLOT 0431 05366 044000 ADB 0 UPDATE POINTER BY THE AMOUNT OF PAGE 0080 #05 PRE-EXECUTION PROCESSING 0432 05367 074170 STB COML STORAGE ASSIGNED. 0433 05370 060434 MLOP0 LDA M4 ENTER THE FOUR WORD ENTRY 0434 05371 017501 JSB ESYMT PREVIOUSLY SET UP IN MBOX1 INTO 0435 05372 027211 JMP MLOP2 SYMBOL TABLE AND CONTINUE 0436* 0437 05373 044325 MLOP9 ADB .2 CHECK THE FORMAL DIMENSIONS 0438 05374 160001 LDA 1,I LOCATION TO SEE IF THE DIMENSION 0439 05375 002002 SZA IS ALREADY DEFINED 0440 05376 014477 JSB ERROR ERROR, DOUBLY DIMENSIONED 0441 05377 060146 MER5 LDA TYPE 0442 05400 050342 CPA .28 COM STMT? 0443 05401 124270 JMP ESYN3,I ERROB MISPLACED COM STMT 0444 05402 060161 LDA MBOX1+2 0445 05403 170001 STA 1,I STORE THESE DIMENSIONS IN FORMAL 0446 05404 006004 INB AND ACTUAL SLOTS IN SYMBOL TABLE 0447 05405 170001 STA 1,I ENTRY 0448 05406 027211 JMP MLOP2 GO TO PROCESS NEXT WORD 0449* 0450* THE SECTION WHICH FOLLOWS CHECKS 0451* THAT ALL FOR LOOPS HAVE BEEN 0452* TERMINATED, ASSIGNS THE STANDARD 0453* DIMENSIONS TO UNDIMENSIONED ARRAYS 0454* AND MAKES STORAGE ASSIGNMENTS FOR 0455* ALL ARRAYS WHICH DO NOT APPEAR IN 0456* A COM STMT 0457* 0458 05407 060115 M1LOP LDA FCORE ALL FORS 0459 05410 050113 CPA PBPTR MATCHED? 0460 05411 002001 RSS YES 0461 05412 014477 JSB ERROR NO 0462 05413 064116 MER6 LDB SYMTF 0463* 0464 05414 054117 M2LOP CPB SYMTA MORE SYMBOLS? 0465 05415 027466 JMP M4LOP NO 0466 05416 160001 LDA 1,I YES 0467 05417 010336 AND .15 ACCONT FOR 0468 05420 044325 ADB .2 A FUNCTION 0469 05421 050336 CPA .15 IS IT? 0470 05422 027414 JMP M2LOP YES 0471 05423 006004 INB NO, ACCOUNT FOR 0472 05424 040434 ADA M4 SIMPLE VARIABLE 0473 05425 002025 SSA,INA,RSS IS IT? 0474 05426 027414 JMP M2LOP YES 0475 05427 002003 SZA,RSS NO, # OF SUBSCRIPTS KNOWN? 0476 05430 014477 JSB ERROR NO 0477 05431 002004 MER10 INA SAVE 0478 05432 070160 STA MBOX1+1 FLAG 0479 05433 074157 STB MBOX1 SAVE POINTER 0480 05434 160001 LDA 1,I DEFINED 0481 05435 002002 SZA ARRAY? 0482 05436 027445 JMP M3LOP YES 0483 05437 063500 LDA STDIM NO, LOAD 0484 05440 034160 ISZ MBOX1+1 APPROPRIATE 0485 05441 040333 ADA .9 STANDARD DIMENSIONS 0486 05442 170001 STA 1,I RECORD AS 0487 05443 044431 ADB M1 FORMAL AND ACTUAL PAGE 0081 #05 PRE-EXECUTION PROCESSING 0488 05444 170001 STA 1,I DIMENSIONS 0489 05445 015336 M3LOP JSB MDIM SAVE STORAGE 0490 05446 070160 STA MBOX1+1 REQUIREMENT 0491 05447 064157 LDB MBOX1 LOAD 0492 05450 044432 ADB M2 ADDRESS OF 0493 05451 160001 LDA 1,I ELEMENT SPACE 0494 05452 002002 SZA DEFINED IN COM? 0495 05453 027464 JMP MER7 YES 0496 05454 060115 LDA FCORE NO, USE CURRENT 0497 05455 170001 STA 1,I FREE-CORE ADDRESS 0498 05456 040160 ADA MBOX1+1 UPDATE FREE-CORE 0499 05457 070115 STA FCORE ADDRESS 0500 05460 003004 CMA,INA OUT 0501 05461 040116 ADA SYMTF OF 0502 05462 002020 SSA SPACE? 0503 05463 014477 JSB ERROR YES 0504 05464 044326 MER7 ADB .3 NO, ADVANCE POINTER 0505 05465 027414 JMP M2LOP TO NEXT ENTRY 0506* 0507 05466 064113 M4LOP LDB PBPTR INITIALIZE ALL 0508 05467 054115 CPB FCORE ARRAY ELEMENTS 0509 05470 124203 JMP FASE3,I TO 'UNDEFINED' 0510 05471 060470 LDA MNEG 0511 05472 170001 STA 1,I 0512 05473 006004 INB 0513 05474 060471 LDA MNEG+1 0514 05475 170001 STA 1,I 0515 05476 006004 INB 0516 05477 027467 JMP M4LOP+1 0517* 0518 05500 005001 STDIM OCT 5001 PAGE 0082 #05 PRE-EXECUTION PROCESSING 0520* ***************************** 0521* ENTER SYMBOL TABLE SUBROUTINE 0522* ***************************** 0523* 0524* TRANSFER -(A) WORDS FROM THE BUFFER ADDRESSED 0525* BY MBUF TO THE TOP OF THE SYMBOL TABLE. 0526* 0527 05501 000000 ESYMT NOP 0528 05502 071467 STA MBIN1 SAVE NEGATIVE OF LENGTH OF ENTRY 0529 05503 040116 ADA SYMTF 0530 05504 070116 STA SYMTF MOVE SYMBOL TABLE START LOCATOR 0531 05505 071536 STA MBIN2 UP BY THE LENGTH OF ENTRY 0532 05506 003004 CMA,INA CHECK THAT THE SYMBOL TABLE AND 0533 05507 040115 ADA FCORE FOR TABLE DO NOT OVERLAP 0534 05510 002021 SSA,RSS 0535 05511 014477 JSB ERROR OVERLAP ERROR 0536 05512 067543 MER8 LDB MBUF POINTER TO REQD ENTRY 0537 05513 160001 LDA 1,I TRANSFER ENTRY TO THE SYMBOL 0538 05514 171536 STA MBIN2,I TABLE 0539 05515 006004 INB 0540 05516 035536 ISZ MBIN2 0541 05517 035467 ISZ MBIN1 0542 05520 027513 JMP MER8+1 0543 05521 127501 JMP ESYMT,I RETURN 0544* 0545* ********************************************** 0546* SUBROUTINE TO SEARCH SYMBOL TABLE FOR AN ARRAY 0547* ********************************************** 0548 05522 000000 MSYMT NOP B GIVES ARRAY TYPE -3 = 1 DIM, 0549 05523 075467 STB MBIN1 -2 = 2DIM, -1 = UNDIMENSIONED 0550 05524 060157 LDA MBOX1 LOAD IDENTIFIER 0551 05525 114231 JSB SSYMA,I SEARCH SYMBOL TABLE 0552 05526 006021 SSB,RSS 0553 05527 127522 JMP MSYMT,I FOUND, RETURN 0554 05530 035467 ISZ MBIN1 IF ARRAY UNDIMENSIONED 0555 05531 002001 RSS 0556 05532 027541 JMP MSYM JUMP TO NOT FOUND EXIT 0557 05533 035467 ISZ MBIN1 SET UP TO CHECK THAT ARRAY DOES 0558 05534 040325 ADA .2 NOT APPEAR IN THE TABLE WITH 0559 05535 040431 ADA M1 DIFFERENT DIMENSIONS. CHANGE 0560 05536 114231 JSB SSYMA,I TYPE 2 TO 1 8 TYPE 1 TO 2 AND 0561 05537 006021 SSB,RSS SEARCH AGAIN 0562 05540 014477 JSB ERROR FOUND, INCONSISTENT DIMENSIONS 0563 05541 037522 MSYM ISZ MSYMT NOT FOUND, INCREMENT RETURN 0564 05542 127522 JMP MSYMT,I ADDRESS AND RETURN 0565* 0566* 0567 05543 000157 MBUF DEF TEMPS 0568 00157 MBOX1 EQU TEMPS 0569 01467 MBIN1 EQU SLWST 0570 01536 MBIN2 EQU RSCHK 0571 00135 MPTR EQU SBPTR 0572 01515 MNPTR EQU OPCHK 0573 00170 COML EQU TEMPS+9 0574 00171 MWDNO EQU TEMPS+10 0575 05522 DIGCT EQU MSYMT PAGE 0083 #06 EXECUTE THE PROGRAM 0002* 0003*** *** 0004** EVALUATE A FORMULA ** 0005*** *** 0006* 0007 05544 000000 FORMX NOP FORMULA BEGINS IN (TEMPS) 0008 05545 006400 CLB INITIALIZE OPERATOR 0009 05546 015467 JSB SLWST STACK 0010 05547 160157 FORM1 LDA TEMPS,I FETCH OPERAND 0011 05550 034157 ISZ TEMPS SET FOR NEXT WORD OF FORMULA 0012 05551 010425 AND OPDMK EXTRACT OPERAND 0013 05552 070165 STA TEMPS+6 AND SAVE IT 0014 05553 002003 SZA,RSS NULL OPERAND? 0015 05554 027567 JMP FORM2 YES 0016 05555 015476 JSB BHSTP SET STACK FOR OPERAND ADDRESS 0017 05556 002020 SSA FLAG BIT SET? 0018 05557 027636 JMP FORM4 YES 0019 05560 114231 JSB SSYMA,I FETCH OPERAND ADDRESS 0020 05561 006007 INB,SZB,RSS EXISTANT? 0021 05562 124267 JMP E8M1A,I NO 0022 05563 010336 AND .15 YES 0023 05564 050336 CPA .15 FUNCTION? 0024 05565 027651 JMP FORM6 YES 0025 05566 174142 STB HSTPT,I NO, STACK OPERAND ADDRESS 0026 05567 160157 FORM2 LDA TEMPS,I FETCH 0027 05570 010420 AND OPMSK OPERATOR 0028 05571 001727 ALF,ALF POSITION IT 0029 05572 064000 LDB 0 LOAD ADDRESS OF 0030 05573 044301 ADB FOPBS OPERATOR'S INFORMATION WORD 0031 05574 040440 ADA M8 NON-FORMULA 0032 05575 002020 SSA OPERATOR? 0033 05576 006400 CLB YES 0034 05577 040451 ADA D53 NO, NON-FORMULA 0035 05600 002021 SSA,RSS OPERATOR? 0036 05601 006400 CLB YES 0037 05602 002400 CLA NO 0038 05603 160001 LDA 1,I LOAD INFORMATION WORD 0039 05604 010401 AND MSK1 SAVE 0040 05605 070166 STA TEMPS+7 PRECEDENCE 0041 05606 120001 XOR 1,I SAVE 0042 05607 001100 ARS 0043 05610 070165 STA TEMPS+6 IDENTIFICATION 0044 05611 027617 JMP FOR11 0045 05612 170140 FORM0 STA TSTPT,I STACK HIGH WORD 0046 05613 060140 LDA TSTPT STACK OPERAND 0047 05614 170142 STA HSTPT,I ADDRESS 0048 05615 002004 INA STORE 0049 05616 174000 STB 0,I LOW WORD 0050 05617 160141 FOR11 LDA LSTPT,I DOES OPERATOR 0051 05620 010376 AND MSK0 ON TOP OF 0052 05621 003000 CMA OPERATOR STACK 0053 05622 040166 ADA TEMPS+7 HAVE HIGHER 0054 05623 002020 SSA PRECEDENCE? 0055 05624 027751 JMP FORM9 YES, EXECUTE IT 0056 05625 002001 RSS NO 0057 05626 034141 FOR10 ISZ LSTPT PAGE 0084 #06 EXECUTE THE PROGRAM 0058 05627 064166 LDB TEMPS+7 RETRIEVE PRECEDENCE 0059 05630 044444 ADB M15 NO, LEFT PARENTHESIS 0060 05631 006020 SSB OR LEFT BRACKET? 0061 05632 044336 ADB .15 NO, RESTORE PRECEDENCE 0062 05633 044165 ADB TEMPS+6 COMBINE IDENTIFICATION 0063 05634 015467 JSB SLWST WITH PRECEDENCE AND STACK 0064 05635 027547 JMP FORM1 0065 05636 050470 FORM4 CPA FLGBT CONSTANT? 0066 05637 027645 JMP FORM5 YES 0067 05640 010336 AND .15 NO, PRE-DEFINED 0068 05641 050336 CPA .15 FUNCTION 0069 05642 027726 JMP FORM7 YES 0070 05643 064170 LDB TEMPS+9 NO, MUST BE A 0071 05644 027566 JMP FORM2-1 PARAMETER 0072 05645 064157 FORM5 LDB TEMPS LOAD CONSTANT ADDRESS 0073 05646 034157 ISZ TEMPS MOVE POINTER TO 0074 05647 034157 ISZ TEMPS NEXT CODE WORD 0075 05650 027566 JMP FORM2-1 0076 05651 074165 FORM6 STB TEMPS+6 SAVE SYMBOL TABLE POINTER 0077 05652 064140 LDB TSTPT SAVE CURRENT POINTER 0078 05653 015467 JSB SLWST TO TEMPORARY STACK 0079 05654 164165 LDB TEMPS+6,I 0080 05655 015467 JSB SLWST SAVE FUNCTION ADDRESS 0081 05656 063544 LDA FORMX SAVE CURRENT 0082 05657 170142 STA HSTPT,I FORMX RETURN ADDRESS 0083 05660 017544 JSB FORMX EVALUATE THE PARAMETER 0084 05661 034157 ISZ TEMPS UPDATE FORMULA POINTER 0085 05662 034157 ISZ TEMPS PAST RIGHT PARENTHESIS 0086 05663 060157 LDA TEMPS SWITCH 0087 05664 164141 LDB LSTPT,I FORMULA POINTER 0088 05665 074157 STB TEMPS TO FUNCTION'S 0089 05666 170141 STA LSTPT,I FORMULA 0090 05667 064170 LDB TEMPS+9 SET 0091 05670 160142 LDA HSTPT,I PARAMETER POINTER 0092 05671 034141 ISZ LSTPT TO NEW PARAMETER, 0093 05672 034142 ISZ HSTPT SAVING PREVIOUS 0094 05673 174141 STB LSTPT,I SETTING ON 0095 05674 070170 STA TEMPS+9 LOW-CORE STACK 0096 05675 050140 CPA TSTPT PROTECT PARAMETER IF 0097 05676 015536 JSB RSCHK ON TEMPORARY STACK 0098 05677 017544 JSB FORMX EVALUATE FUNCTION 0099 05700 160141 LDA LSTPT,I RESTORE OLD 0100 05701 070170 STA TEMPS+9 PARAMETER POINTER 0101 05702 060141 LDA LSTPT CUT BACK 0102 05703 040433 ADA M3 LOW-CORE 0103 05704 070141 STA LSTPT STACK 0104 05705 002004 INA RESTORE ORIGINAL 0105 05706 164000 LDB 0,I TEMPORARY STACK 0106 05707 074140 STB TSTPT POINTER 0107 05710 002004 INA RESTORE 0108 05711 164000 LDB 0,I ORIGINAL 0109 05712 074157 STB TEMPS FORMULA POINTER 0110 05713 015505 JSB STTOP POP RESULT PAGE 0085 #06 EXECUTE THE PROGRAM 0112* 0113** PRE-DEFINED FUNCTIONS RETURN HERE WITH RESULT 0114* 0115 05714 170140 FOR12 STA TSTPT,I STORE HIGH WORD 0116 05715 060140 LDA TSTPT 0117 05716 002004 INA STORE 0118 05717 174000 STB 0,I LOW WORD 0119 05720 034142 ISZ HSTPT 0120 05721 164142 LDB HSTPT,I RESTORE FORMX 0121 05722 077544 STB FORMX RETURN ADDRESS 0122 05723 040431 ADA M1 STACK ADDRESS 0123 05724 170142 STA HSTPT,I OF RESULT 0124 05725 027567 JMP FORM2 0125 05726 060165 FORM7 LDA TEMPS+6 COMPUTE 0126 05727 001727 ALF,ALF 0127 05730 001700 ALF FUNCTION 0128 05731 010344 AND .31 0129 05732 040305 ADA PDFBS ADDRESS 0130 05733 164000 LDB 0,I 0131 05734 015467 JSB SLWST SAVE FUNCTION ADDRESS 0132 05735 063544 LDA FORMX SAVE CURRENT 0133 05736 170142 STA HSTPT,I FORMX RETURN ADDRESS 0134 05737 017544 JSB FORMX EVALUATE THE PARAMETER 0135 05740 034157 ISZ TEMPS UPDATE FORMULA POINTER 0136 05741 034157 ISZ TEMPS PAST RIGHT PARENTHESIS 0137 05742 164141 LDB LSTPT,I POP 0138 05743 003400 CCA FUNCTION 0139 05744 040141 ADA LSTPT ENTRY 0140 05745 070141 STA LSTPT ADDRESS 0141 05746 077501 STB ESYMT SAVE 0142 05747 015505 JSB STTOP POP PARAMETER 0143 05750 127501 JMP ESYMT,I EVALUATE FUNCTION 0144 05751 160141 FORM9 LDA LSTPT,I UNSTACK 0145 05752 007400 CCB OPERATOR 0146 05753 044141 ADB LSTPT INFORMATION 0147 05754 074141 STB LSTPT WORD 0148 05755 001727 ALF,ALF COMPUTE 0149 05756 010374 AND B177 SUBROUTINE 0150 05757 040304 ADA ARBAS ADDRESS 0151 05760 124000 JMP 0,I EXECUTE 0152** 0153*** EXECUTION BRANCH TABLE ** 0154** 0155 05761 006203 XECTB DEF ELET LET 0156 05762 006044 DEF XEC4 DIM 0157 05763 006044 DEF XEC4 COM 0158 05764 006044 DEF XEC4 DEF 0159 05765 006044 DEF XEC4 REM 0160 05766 006205 DEF EGOTO GO TO 0161 05767 006210 DEF EIF IF 0162 05770 006216 DEF EFOR FOR 0163 05771 006312 DEF ENEXT NEXT 0164 05772 006353 DEF EGOSB GOSUB 0165 05773 006364 DEF ERTRN RETURN 0166 05774 100205 DEF RDYDA,I END 0167 05775 100205 DEF RDYDA,I STOP PAGE 0086 #06 EXECUTE THE PROGRAM 0168 05776 006373 DEF EWAIT WAIT 0169 05777 006412 DEF ECALL CALL 0170 06000 006044 DEF XEC4 DATA 0171 06001 006441 DEF EREAD READ 0172 06002 006474 DEF EPRIN PRINT 0173 06003 006643 DEF EINPT INPUT 0174 06004 006656 DEF ERSTR RESTORE 0175 06005 011456 DEF EMAT MAT 0176* 0177* ************************* 0178**** *** 0179*** EXECUTE THE PROGRAM *** 0180**** *** 0181* ************************* 0182* 0183** 0184***INITIALIZE FOR OUTPUT ** 0185** 0186 06006 002400 XEC CLA SET COUNTER FOR 0187 06007 070146 STA TYPE CHARACTERS OUTPUTTED 0188 06010 070155 STA XH INITIALIZE 0189 06011 002004 INA RANDOM 0190 06012 070156 STA XL VARIABLE 0191** 0192*** INITIALIZE THE DATA POINTER ** 0193** 0194 06013 003400 CCA SET 0195 06014 070151 STA DCCNT 'NO 0196 06015 070147 STA DSTRT DATA' 0197 06016 064112 LDB PBUFF CONDITION 0198 06017 074150 STB NXTDT 0199 06020 160315 LDA ADATA,I SEARCH FOR FIRST 0200 06021 016105 JSB STSRH DATA STATEMENT 0201 06022 026025 JMP XEC2 NONE FOUND 0202 06023 074147 STB DSTRT SAVE STATEMENT LOCATION 0203 06024 016074 JSB SETDP SET DATA POINTER 0204** 0205*** INITIALIZE STACK POINTERS ** 0206** 0207 06025 064116 XEC2 LDB SYMTF INITIALIZE 0208 06026 074142 STB HSTPT POINTERS TO 0209 06027 064115 LDB FCORE 'HIGH CORE' STACK, 0210 06030 074140 STB TSTPT 'TEMPORARY' 0211 06031 044337 ADB .23 STACK, AND 0212 06032 074120 STB LSTAK 'LOW CORE' 0213 06033 074141 STB LSTPT STACK 0214 06034 007000 CMB DO 0215 06035 044142 ADB HSTPT STACKS 0216 06036 006020 SSB MEET? 0217 06037 025473 JMP E1 YES 0218 06040 064426 LDB RMODE NO, SHIFT TO 0219 06041 074127 STB LISTR RUN MODE 0220 06042 064112 LDB PBUFF BEGIN 0221 06043 026054 JMP XEC5 EXECUTION PAGE 0087 #06 EXECUTE THE PROGRAM 0223** 0224*** FIND NEXT STATEMENT TO BE EXECUTED ** 0225** 0226 06044 060144 XEC4 LDA NXTST NEXT STATEMENT NUMBER 0227 06045 064143 LDB PRADD PROSPECTIVE ADDRESS 0228 06046 150001 CPA 1,I DESIRED STATEMENT? 0229 06047 026055 JMP XEC6 YES 0230 06050 064112 LDB PBUFF NO, FIND 0231 06051 114213 JSB FNDPA,I STATEMENT 0232 06052 000000 NOP NON-EXISTENT 0233 06053 014477 JSB ERROR STATEMENT 0234 06054 160001 XEC5 LDA 1,I SAVE NEW 0235 06055 070145 XEC6 STA .LNUM SEQUENCE NUMBER 0236** 0237*** SET SUCCESSOR STATEMENT ** 0238** 0239 06056 016147 JSB FLWST 0240 06057 010420 AND OPMSK EXTRACT STATEMENT TYPE 0241 06060 001727 ALF,ALF POSITION 0242 06061 001300 RAR IT 0243 06062 040303 ADA XECBR COMPUTE EXECUTION ADDRESS 0244 06063 124000 JMP 0,I BRANCH TO EXECUTION CODE 0245** 0246*** EVALUATE FORMULA AND RETURN RESULT ** 0247** 0248 06064 000000 FETCH NOP 0249 06065 114233 JSB FORMA,I EVALUATE FORMULA 0250 06066 015515 JSB OPCHK 0251 06067 034142 ISZ HSTPT UNSTACK RESULT ADDRESS 0252 06070 160001 LDA 1,I LOAD (A) WITH HIGH MANTISSA 0253 06071 006004 INB LOAD LOW PART 0254 06072 164001 LDB 1,I OF RESULT INTO (B) 0255 06073 126064 JMP FETCH,I EXIT 0256** 0257*** SET POINTER TC START OF DATA STATEMENT ** 0258** 0259 06074 000000 SETDP NOP STATEMENT ADDRESS IN (B) 0260 06075 006004 INB LOAD 0261 06076 160001 LDA 1,I STATEMENT LENGTH 0262 06077 003004 CMA,INA SET 0263 06100 002004 INA DATA COUNTER 0264 06101 070151 STA DCCNT TO 1-STATEMENT LENGTH 0265 06102 006004 INB SET 'NEXT DATA' POINTER ONE 0266 06103 074150 STB NXTDT WORD ABOVE FIRST CONSTANT 0267 06104 126074 JMP SETDP,I 0268** 0269*** SEARCH FOR STATEMENT OF GIVEN TYPE ** 0270** 0271 06105 000000 STSRH NOP TYPE IN (A), ADDRESS IN (B) 0272 06106 010420 AND OPMSK EXTRACT 0273 06107 070164 STA TEMP4 STATEMENT TYPE 0274 06110 060001 STSR1 LDA 1 EXTRACT 0275 06111 040325 ADA .2 PROGRAM 0276 06112 160000 LDA 0,I STATEMENT 0277 06113 010420 AND OPMSK TYPE 0278 06114 050164 CPA TEMP4 DESIRED TYPE? PAGE 0088 #06 EXECUTE THE PROGRAM 0279 06115 026124 JMP STSR2 YES 0280 06116 060001 LDA 1 NO, FETCH 0281 06117 002004 INA STATEMENT LENGTH 0282 06120 144000 ADB 0,I COMPUTE NEW ADDRESS 0283 06121 054113 CPB PBPTR PAST LAST STATEMENT? 0284 06122 126105 JMP STSRH,I YES 0285 06123 026110 JMP STSR1 NO 0286 06124 036105 STSR2 ISZ STSRH 0287 06125 126105 JMP STSRH,I 0288** 0289*** FETCH A DATA ITEM ** 0290** 0291 06126 000000 FDATA NOP 0292 06127 034151 FDAT1 ISZ DCCNT MORE DATA? 0293 06130 026137 JMP FDAT2 YES 0294 06131 160315 LDA ADATA,I NO, SEARCH 0295 06132 064150 LDB NXTDT FOR NEXT 0296 06133 016105 JSB STSRH DATA STATEMENT 0297 06134 014477 JSB ERROR NONE FOUND 0298 06135 016074 E4 JSB SETDP INITIALIZE THE 0299 06136 026127 JMP FDAT1 DATA POINTERS 0300 06137 034151 FDAT2 ISZ DCCNT UPDATE 0301 06140 034151 ISZ DCCNT POINTER 0302 06141 034150 ISZ NXTDT 0303 06142 160150 LDA NXTDT,I LOAD 0304 06143 034150 ISZ NXTDT DATA 0305 06144 164150 LDB NXTDT,I ITEM 0306 06145 034150 ISZ NXTDT UPDATE POINTER 0307 06146 126126 JMP FDATA,I 0308** 0309*** SET FOR FOLLOWING STATEMENT ** 0310** 0311 06147 000000 FLWST NOP (B) HOLDS PRESENT ADDRESS 0312 06150 060001 LDA 1 COMPUTE 0313 06151 002004 INA ADDRESS 0314 06152 160000 LDA 0,I OF 0315 06153 040001 ADA 1 NEXT 0316 06154 070143 STA PRADD STATEMENT 0317 06155 160000 LDA 0,I RECORD THE 0318 06156 070144 STA NXTST SEQUENCE NUMBER 0319 06157 044325 ADB .2 FETCH 0320 06160 074157 STB TEMPS FIRST WORD 0321 06161 160001 LDA 1,I OF CURRENT 0322 06162 126147 JMP FLWST,I STATEMENT 0323** 0324*** SEARCH STACK FOR GIVEN FOR-VARIABLE ** 0325** 0326 06163 000000 FVSRH NOP 0327 06164 160157 LDA TEMPS,I FETCH 0328 06165 010401 AND MSK1 FOR-VARIABLE 0329 06166 071656 STA EDELM SAVE FOR-VARIABLE 0330 06167 114231 JSB SSYMA,I FIND ADDRESS IN 0331 06170 006004 INB SYMBOL TABLE 0332 06171 060142 LDA HSTPT SAVE 0333 06172 070163 STA TEMP3 STACK TOP 0334 06173 050116 FVSR1 CPA SYMTF STACK BOTTOM? PAGE 0089 #06 EXECUTE THE PROGRAM 0335 06174 126163 JMP FVSRH,I YES, EXIT VIA (P+1) 0336 06175 154000 CPB 0,I MATCHING FOR-VARIABLE? 0337 06176 026201 JMP FVSR2 YES 0338 06177 040330 ADA .6 NO, MOVE TO 0339 06200 026173 JMP FVSR1 NEXT STACK ENTRY 0340 06201 036163 FVSR2 ISZ FVSRH EXIT 0341 06202 126163 JMP FVSRH,I VIA (P+2) 0342* 0343*** *** 0344** EXECUTE LET ** 0345*** *** 0346* 0347 06203 114233 ELET JSB FORMA,I 0348 06204 026044 JMP XEC4 0349* 0350*** *** 0351** EXECUTE GO TO ** 0352*** *** 0353* 0354 06205 006004 EGOTO INB LOAD SEQUENCE 0355 06206 160001 LDA 1,I NUMBER 0356 06207 026045 JMP XEC4+1 FIND REFERENCED STATEMENT 0357* 0358*** *** 0359** EXECUTE IF ** 0360*** *** 0361* 0362 06210 114232 EIF JSB FETCA,I FETCH VALUE OF FORMULA 0363 06211 002003 SZA,RSS RESULTANT TRUE? 0364 06212 026044 JMP XEC4 NO 0365 06213 034157 ISZ TEMPS YES, BRANCH TO 0366 06214 064157 LDB TEMPS FOLLOWING 0367 06215 026205 JMP EGOTO SEQUENCE NUMBER 0368* 0369*** *** 0370** EXECUTE FOR ** 0371*** *** 0372* 0373 06216 016163 EFOR JSB FVSRH FOR-VARIABLE ALREADY IN STACK? 0374 06217 026230 JMP EFOR1 NO 0375 06220 070162 STA TEMP2 YES, SAVE SOURCE ADDRESS 0376 06221 040330 ADA .6 SAVE 0377 06222 070164 STA TEMP4 DESTINATION ADDRESS 0378 06223 074161 STB TEMP1 SAVE FOR-VARIABLE ADDRESS 0379 06224 014554 JSB MVTOH COMPRESS STACK 0380 06225 064161 LDB TEMP1 RESTORE FOR-VARIABLE ADDRESS 0381 06226 002400 CLA COMPUTE 0382 06227 002401 CLA,RSS COMPUTE 0383 06230 060436 EFOR1 LDA M6 NEW TOP OF 0384 06231 040142 ADA HSTPT FOR-STACK 0385 06232 070142 STA HSTPT POINTER 0386 06233 070161 STA TEMP1 0387 06234 003004 CMA,INA STACK 0388 06235 040141 ADA LSTPT 0389 06236 002021 SSA,RSS OVERFLOW? 0390 06237 025473 JMP E1 YES PAGE 0090 #06 EXECUTE THE PROGRAM 0391 06240 174161 STB TEMP1,I NO, RECORD FOR-VARIABLE ADDRESS 0392 06241 114233 JSB FORMA,I INITIALIZE FOR-VARIABLE 0393 06242 034157 ISZ TEMPS 0394 06243 034161 ISZ TEMP1 SAVE 0395 06244 060161 LDA TEMP1 LIMIT 0396 06245 072340 STA ENEX2 ADDRESS 0397 06246 114232 JSB FETCA,I FETCH 0398 06247 170161 STA TEMP1,I AND 0399 06250 034161 ISZ TEMP1 STORE 0400 06251 174161 STB TEMP1,I LIMIT 0401 06252 034161 ISZ TEMP1 0402 06253 064432 LDB M2 SET FOR STEP SIZE 0403 06254 076126 STB FDATA SIGN CHECK 0404 06255 160157 LDA TEMPS,I LOOK FOR 0405 06256 002002 SZA FOLLOWING ' STEP' 0406 06257 026263 JMP EFOR2 FOUND 0407 06260 060466 LDA HONE NOT FOUND, 0408 06261 064325 LDB .2 DEFAULT 0409 06262 002001 RSS IS 1.0 0410 06263 114232 EFOR2 JSB FETCA,I 0411 06264 002020 SSA STEP SIZE NEGATIVE? 0412 06265 036126 ISZ FDATA YES 0413 06266 170161 STA TEMP1,I SAVE 0414 06267 034161 ISZ TEMP1 STEP 0415 06270 174161 STB TEMP1,I SIZE 0416 06271 034161 ISZ TEMP1 SET POINTER 0417 06272 060144 LDA NXTST TO STATEMENT 0418 06273 170161 STA TEMP1,I FOLLOWING THE FOR 0419 06274 160314 EFOR3 LDA ANEXT,I FIND 0420 06275 064143 LDB PRADD 'NEXT' 0421 06276 016105 JSB STSRH STATEMENT 0422 06277 000000 NOP 0423 06300 016147 JSB FLWST FIND FOLLOWING STATEMENT 0424 06301 010401 AND MSK1 SAME 0425 06302 051656 CPA EDELM FOR-VARIABLE? 0426 06303 002001 RSS YES 0427 06304 026274 JMP EFOR3 NO 0428 06305 164142 LDB HSTPT,I LOAD 0429 06306 160001 LDA 1,I VALUE 0430 06307 006004 INB OF 0431 06310 164001 LDB 1,I FOR-VARIABLE 0432 06311 026337 JMP ENEX2-1 CHECK ACCEPTABILITY 0433* 0434*** *** 0435** EXECUTE NEXT ** 0436*** *** 0437* 0438 06312 016163 ENEXT JSB FVSRH FIND CORRESPONDING STACK ENTRY 0439 06313 026044 JMP XEC4 NONE PRESENT 0440 06314 070142 STA HSTPT RESET TOP OF STACK 0441 06315 076333 STB ENEX1 SAVE FOR-VARIABLE ADDRESS 0442 06316 002004 INA SAVE LIMIT 0443 06317 072340 STA ENEX2 ADDRESS 0444 06320 040325 ADA .2 SAVE STEP SIZE 0445 06321 070161 STA TEMP1 ADDRESS 0446 06322 064432 LDB M2 SET STEP SIZE PAGE 0091 #06 EXECUTE THE PROGRAM 0447 06323 076126 STB FDATA SIGN CHECK 0448 06324 160161 LDA TEMP1,I LOAD 0449 06325 034161 ISZ TEMP1 STEP 0450 06326 164161 LDB TEMP1,I SIZE 0451 06327 034161 ISZ TEMP1 0452 06330 002020 SSA CHECK 0453 06331 036126 ISZ FDATA SIGN 0454 06332 017343 JSB .FAD INCREMENT 0455 06333 000000 ENEX1 NOP FOR-VARIABLE 0456 06334 172333 STA ENEX1,I AND 0457 06335 036333 ISZ ENEX1 SAVE 0458 06336 176333 STB ENEX1,I VALUE 0459 06337 017347 JSB .FSB COMPUTE FOR-VARIABLE - LIMIT 0460 06340 000000 ENEX2 NOP 0461 06341 036126 ISZ FDATA POSITIVE STEP SIZE? 0462 06342 001600 ELA YES, COMPLEMENT SIGN 0463 06343 002020 SSA NO, NON-NEGATIVE RESULT? 0464 06344 026347 JMP ENEX3 NO 0465 06345 160161 LDA TEMP1,I YES, GO TO FIRST 0466 06346 026045 JMP XEC4+1 STATEMENT OF LOOP 0467 06347 060142 ENEX3 LDA HSTPT FAILS, 0468 06350 040330 ADA .6 ERASE 0469 06351 070142 STA HSTPT STACK 0470 06352 026044 JMP XEC4 ENTRY 0471* 0472*** *** 0473** EXECUTE GOSUB ** 0474*** *** 0475* 0476 06353 006004 EGOSB INB LOAD (A) WITH 0477 06354 160001 LDA 1,I SEQUENCE NUMBER 0478 06355 064144 LDB NXTST LOAD (B) WITH 0479 06356 070144 STA NXTST RETURN SEQUENCE NUMBER 0480 06357 015467 JSB SLWST STACK RETURN ON LOW-CORE STACK 0481 06360 040442 ADA M10 GOSUBS NESTED 0482 06361 050120 CPA LSTAK 10 DEEP? 0483 06362 014477 JSB ERROR YES 0484 06363 026044 E2 JMP XEC4 NO 0485* 0486*** *** 0487** EXECUTE RETURN ** 0488*** *** 0489* 0490 06364 064141 ERTRN LDB LSTPT RETURN STACK 0491 06365 054120 CPB LSTAK EMPTY? 0492 06366 014477 JSB ERROR YES 0493 06367 160141 E3 LDA LSTPT,I NO, LOAD RETURN ADDRESS 0494 06370 044431 ADB M1 RESET 0495 06371 074141 STB LSTPT STACK POINTER 0496 06372 026045 JMP XEC4+1 PAGE 0092 #06 EXECUTE THE PROGRAM 0498* 0499*** *** 0500** EXECUTE WAIT ** 0501*** *** 0502* 0503 06373 034157 EWAIT ISZ TEMPS POINT (TEMPS) TO FORMULA 0504 06374 114232 JSB FETCA,I FETCH EVALUATED FORMULA 0505 06375 002020 SSA NEGATIVE? 0506 06376 026044 JMP XEC4 YES 0507 06377 015364 JSB IFIX CONVERT TO INTEGER 0508 06400 002404 CLA,INA LARGE INTEGER 0509 06401 002003 SZA,RSS SMALL 0510 06402 007021 CMB,SSB,RSS INTEGER? 0511 06403 064470 LDB MNEG NO 0512 06404 006007 EWAI1 INB,SZB,RSS WAIT? 0513 06405 026044 JMP XEC4 NO 0514 06406 060461 LDA M310 YES, SET INNER LOOP 0515 06407 002006 INA,SZA MORE? 0516 06410 026407 JMP *-1 YES 0517 06411 026404 JMP EWAI1 NO 0518* 0519*** *** 0520** EXECUTE CALL ** 0521*** *** 0522* 0523 06412 034157 ECALL ISZ TEMPS FETCH 0524 06413 034157 ISZ TEMPS SUBROUTINE 0525 06414 164157 LDB TEMPS,I NUMBER 0526 06415 015323 JSB FNDSB FIND 0527 06416 006004 INB ENTRY 0528 06417 164001 LDB 1,I POINT AND 0529 06420 074172 STB TEMPS+11 SAVE IT 0530 06421 060142 LDA HSTPT SAVE HIGH CORE 0531 06422 070171 STA TEMPS+10 STACK POINTER 0532 06423 034157 ECAL1 ISZ TEMPS ANY 0533 06424 160157 LDA TEMPS,I PARAMETERS 0534 06425 050406 CPA B4000 LEFT? 0535 06426 026431 JMP ECAL2 NO 0536 06427 114233 JSB FORMA,I YES, EVALUATE 0537 06430 026423 JMP ECAL1 A PARAMETER 0538 06431 003400 ECAL2 CCA LOAD ADDRESS OF 0539 06432 040171 ADA TEMPS+10 PARAMETER ADDRESSES 0540 06433 114172 JSB TEMPS+11,I AND BRANCH TO SUBROUTINE 0541 06434 060171 LDA TEMPS+10 RESTORE 0542 06435 070142 STA HSTPT 0543 06436 064115 LDB FCORE POINTERS 0544 06437 074140 STB TSTPT 0545 06440 026044 JMP XEC4 PAGE 0093 #06 EXECUTE THE PROGRAM 0547* 0548*** *** 0549** EXECUTE READ ** 0550*** *** 0551* 0552 06441 054143 EREAD CPB PRADD END-OF-STATEMENT? 0553 06442 026044 JMP XEC4 YES 0554 06443 114233 JSB FORMA,I NO, EVALUATE NEXT ADDRESS 0555 06444 160142 LDA HSTPT,I RECORD 0556 06445 071677 STA OUTLN ADDRESS 0557 06446 016126 JSB FDATA GET DATA ITEM 0558 06447 171677 STA OUTLN,I STORE 0559 06450 035677 ISZ OUTLN DATA 0560 06451 175677 STB OUTLN,I ITEM 0561 06452 034142 ISZ HSTPT 0562 06453 064157 LDB TEMPS 0563 06454 006004 INB 0564 06455 026441 JMP EREAD 0565** 0566*** INITIALIZE FOR PRINT ** 0567** 0568 06456 000000 PRNIN NOP 0569 06457 003400 CCA INITIALIZE 0570 06460 040131 ADA .BUFA BUFFER 0571 06461 070132 STA BADDR POINTER 0572 06462 060146 LDA TYPE INITIALIZE 0573 06463 003004 CMA,INA 'CHARACTERS OUTPUTTED' 0574 06464 070133 STA CCNT COUNTER 0575 06465 002011 SLA,RSS START ON ODD CHARACTER POSITION? 0576 06466 126456 JMP PRNIN,I NO 0577 06467 040431 ADA M1 YES, BIAS 0578 06470 070133 STA CCNT COUNTER 0579 06471 002400 CLA OUTPUT A 0580 06472 015715 JSB OUTCR NULL CHARACTER 0581 06473 126456 JMP PRNIN,I 0582* 0583*** *** 0584** EXECUTE PRINT ** 0585*** *** 0586* 0587 06474 016456 EPRIN JSB PRNIN SET FOR PRINT 0588 06475 002400 CLA TURN ON 0589 06476 026503 JMP EPRI1+1 'END-OF-LINE' FLAG 0590 06477 002400 EPRI0 CLA EXECUTE COMMA 0591 06500 050567 CPA EOL IF NOT FOLLOWING 0592 06501 015656 JSB EDELM A TAB 0593 06502 003400 EPRI1 CCA TURN OFF 0594 06503 070567 STA EOL 'END-OF-LINE' FLAG 0595 06504 160157 LDA TEMPS,I EXTRACT 0596 06505 010425 AND OPDMK OPERAND 0597 06506 002002 SZA NULL? 0598 06507 026527 JMP EPRI3 NO, FORMULA OR TAB 0599 06510 034157 EPRI2 ISZ TEMPS YES 0600 06511 064157 LDB TEMPS MORE 0601 06512 054143 CPB PRADD STATEMENT? 0602 06513 026565 JMP EPRI7 NO PAGE 0094 #06 EXECUTE THE PROGRAM 0603 06514 160157 LDA TEMPS,I YES, EXTRACT 0604 06515 010420 AND OPMSK NEXT OPERATOR 0605 06516 050403 CPA B2000 ',' ? 0606 06517 026477 JMP EPRI0 YES 0607 06520 050404 CPA B3000 NO, ')' ? 0608 06521 026502 JMP EPRI1 YES 0609 06522 050402 CPA B1000 NO, * ? 0610 06523 026536 JMP EPRI4 YES 0611 06524 003400 CCA NO, MUST BE +,-, OR ( 0612 06525 040157 ADA TEMPS BACKUP TO PRIOR 0613 06526 070157 STA TEMPS NULL OPERAND 0614 06527 003400 EPRI3 CCA SET 0615 06530 070567 STA EOL TAB FLAG 0616 06531 114232 JSB FETCA,I EVALUATE 0617 06532 034567 ISZ EOL TAB? 0618 06533 026510 JMP EPRI2 YES 0619 06534 015643 JSB ENOUT NO, PRINT NUMBER 0620 06535 026510 JMP EPRI2 0621 06536 002400 EPRI4 CLA TURN ON 0622 06537 070567 STA EOL 'END-OF-LINE' FLAG 0623 06540 071467 STA SLWST ZERO 0624 06541 071677 STA OUTLN CHARACTER COUNT 0625 06542 160001 EPRI5 LDA 1,I 0626 06543 010376 AND MSK0 NON-NULL 0627 06544 002003 SZA,RSS LOW CHARACTER? 0628 06545 026556 JMP EPRI6 NO 0629 06546 035677 ISZ OUTLN YES, COUNT IT 0630 06547 006004 INB 0631 06550 160001 LDA 1,I 0632 06551 010420 AND OPMSK 0633 06552 050402 CPA B1000 * NEXT? 0634 06553 026556 JMP EPRI6 YES 0635 06554 035677 ISZ OUTLN NO, COUNT HIGH CHARACTER 0636 06555 026542 JMP EPRI5 0637 06556 065677 EPRI6 LDB OUTLN WILL 0638 06557 044133 ADB CCNT LINE 0639 06560 044455 ADB M73 EXCEED 0640 06561 006021 SSB,RSS 72 CHARACTERS? 0641 06562 015677 JSB OUTLN YES, GET FRESH LINE 0642 06563 114223 JSB OUTSA,I OUTPUT STRING 0643 06564 026504 JMP EPRI1+2 0644 06565 034567 EPRI7 ISZ EOL 'END-OF-LINE' ? 0645 06566 026603 JMP EPRI8 YES 0646 06567 064146 LDB TYPE NO, LOAD COUNT OF 0647 06570 007004 CMB,INB CHARACTERS OUTPUTTED 0648 06571 060133 LDA CCNT LOAD LINE LENGTH 0649 06572 003004 CMA,INA SAVE NEW COUNT OF 0650 06573 070146 STA TYPE CHARACTERS OUTPUTTFD 0651 06574 040001 ADA 1 COMPUTE CHARACTERS NOT YET OUT 0652 06575 004010 SLB CORRECT FOR START ON 0653 06576 040431 ADA M1 ODD PRINT POSITION 0654 06577 064131 LDB .BUFA OUTPUT 0655 06600 002002 SZA NON-EMPTY 0656 06601 114102 JSB WRITE,I BUFFER 0657 06602 026044 JMP XEC4 0658 06603 015677 EPRI8 JSB OUTLN PRINT LINE PAGE 0095 #06 EXECUTE THE PROGRAM 0659 06604 026044 JMP XEC4 0660** 0661*** TAB TELEPRINTER ** 0662** 0663 06605 116631 ETAB JSB IENTA,I SMALL INTEGER? 0664 06606 026627 JMP ETAB1 NO 0665 06607 006400 CLB YES, SET 0666 06610 074567 STB EOL 'TAB' FLAG TRUE 0667 06611 040454 ADA M72 EXCEED 0668 06612 002021 SSA,RSS 72? 0669 06613 026627 JMP ETAB1 YES 0670 06614 003004 CMA,INA NO, COMPUTE 0671 06615 040454 ADA M72 BLANKS? 0672 06616 040133 ADA CCNT REQUIRED 0673 06617 002021 SSA,RSS ANY? 0674 06620 124264 JMP FR12A,I NO 0675 06621 071677 STA OUTLN YES, 0676 06622 060345 LDA .32 OUTPUT 0677 06623 015715 JSB OUTCR REQUIRED 0678 06624 035677 ISZ OUTLN NUMBER 0679 06625 026622 JMP *-3 OF BLANKS 0680 06626 124264 JMP FR12A,I 0681 06627 015677 ETAB1 JSB OUTLN OUTPUT THE 0682 06630 124264 JMP FR12A,I LINE 0683* 0684 06631 011413 IENTA DEF .IENT 0685* 0686*** *** 0687** EXECUTE INPUT ** 0688*** *** 0689* 0690 06632 002006 EINP1 INA,SZA END-OF-INPUT? 0691 06633 114206 JSB DRQSA,I YES, CALL FOR MORE 0692 06634 014567 EINP2 JSB CONST CONVERT AND STORE NUMBER 0693 06635 026632 JMP EINP1 NOT NUMBER 0694 06636 064157 LDB TEMPS END-OF- 0695 06637 006004 INB 0696 06640 054143 CPB PRADD STATEMENT? 0697 06641 026652 JMP EINP3 YES 0698 06642 050334 CPA .10 NO, INSURE MORE INPUT 0699 06643 114206 EINPT JSB DRQSA,I CALL FOR INPUT 0700 06644 114233 JSB FORMA,I COMPUTE VARIABLE ADDRESS 0701 06645 003400 CCA STORE 0702 06646 140142 ADA HSTPT,I ADDRESS-1 0703 06647 034142 ISZ HSTPT IN 0704 06650 070135 STA SBPTR POINTER 0705 06651 026634 JMP EINP2 0706 06652 002400 EINP3 CLA RESET 0707 06653 070146 STA TYPE OUTPUT BUFFER 0708 06654 026044 JMP XEC4 PAGE 0096 #06 EXECUTE THE PROGRAM 0710** 0711*** EXIT FORMULA ON EMPTY STACK ** 0712** 0713 06655 105544 DEF FORMX,I 0714* 0715*** *** 0716** EXECUTE RESTORE ** 0717*** *** 0718* 0719 06656 064147 ERSTR LDB DSTRT GET FIRST DATA STATEMENT ADDRESS 0720 06657 054431 CPB M1 IMPOSSIBLE ADDRESS? 0721 06660 026044 JMP XEC4 YES, DONE 0722 06661 016074 JSB SETDP NO, SET DATA POINTER 0723 06662 026044 JMP XEC4 DONE 0001** 0002*** FORMULA OPERATOR JUMP TABLE ** 0003** 0004 06663 006722 AROTB DEF ESCMA SUBSCRIPT SEPARATOR 0005 06664 007002 DEF ESTR ASSIGNMENT OPERATOR 0006 06665 007026 DEF EFAD '+' 0007 06666 007031 DEF EFSB '-' 0008 06667 007034 DEF EFMP '*' 0009 06670 007037 DEF EFDV '/' 0010 06671 007042 DEF EPWR '^' 0011 06672 007164 DEF EGTRT '>' 0012 06673 007171 DEF ELST '<' 0013 06674 007215 DEF ENEQL '#' 0014 06675 007176 DEF EEQL '=' 0015 06676 007227 DEF EUMIN UNARY '-' 0016 06677 007232 DEF ELBRC '[' 0017 06700 100260 DEF FOR1A,I '(' 0018 06701 100262 DEF FOR0B,I UNARY '+' 0019 06702 007240 DEF EOR OR 0020 06703 007246 DEF EAND AND 0021 06704 007253 DEF ENOT NOT 0022 06705 007203 DEF EGORE '>=' 0023 06706 007210 DEF ELORE '<=' 0024** 0025*** EXECUTE A BINARY OPERATOR ** 0026** 0027 06707 000000 BINOP NOP SAVE 0028 06710 162707 LDA BINOP,I SUBROUTINE 0029 06711 072717 STA BINO1 CALL 0030 06712 036707 ISZ BINOP SET RETURN ADDRESS 0031 06713 015515 JSB OPCHK SAVE ADDRESS OF 0032 06714 076720 STB BINO2 TOP OPERAND 0033 06715 034142 ISZ HSTPT UNSTACK ADDRESS 0034 06716 015505 JSB STTOP LOAD SECOND OPERAND 0035 06717 000000 BINO1 NOP PERFORM OPERATION 0036 06720 000000 BINO2 NOP ADDRESS OF SECOND OPERAND 0037 06721 126707 JMP BINOP,I PAGE 0097 #07 EXECUTE THE PROGRAM 0039** 0040*** EXECUTE SUBSCRIPT COMMA ** 0041** 0042 06722 016771 ESCMA JSB ESBS INTEGERIZE COLUMN SUBSCRIPT 0043 06723 034141 ISZ LSTPT 0044 06724 016771 JSB ESBS INTEGERIZE ROW SUBSCRIPT 0045 06725 164142 LDB HSTPT,I FETCH 0046 06726 044325 ADB .2 SUBSCRIPT 0047 06727 160001 LDA 1,I ROUNDS 0048 06730 010376 AND MSK0 SAVE 0049 06731 071677 STA OUTLN COLUMN BOUND 0050 06732 160001 LDA 1,I EXTRACT 0051 06733 001727 ALF,ALF ROW 0052 06734 010376 AND MSK0 BOUND 0053 06735 003004 CMA,INA ACTUAL 0054 06736 140141 ADA LSTPT,I ROW SUBSCRIPT 0055 06737 002021 SSA,RSS LEGAL? 0056 06740 026757 JMP E6-1 NO 0057 06741 061677 LDA OUTLN YES 0058 06742 050324 CPA .1 COLUMN MATRIX? 0059 06743 026747 JMP ESCM1 YES 0060 06744 015236 JSB MPY NO, COMPUTE ADDRESS 0061 06745 100141 DEF LSTPT,I DISPLACEMENT 0062 06746 002001 RSS DUE TO ROWS 0063 06747 160141 ESCM1 LDA LSTPT,I 0064 06750 007400 CCB UNSTACK 0065 06751 044141 ADB LSTPT ROW 0066 06752 074141 STB LSTPT SUBSCRIPT 0067 06753 065677 LDB OUTLN ACTUAL 0068 06754 007004 CMB,INB COLUMN 0069 06755 144141 ADB LSTPT,I SUBSCRIPT 0070 06756 006021 SSB,RSS LEGAL? 0071 06757 014477 JSB ERROR NO 0072 06760 140141 E6 ADA LSTPT,I YES, ADD IN COLUMN DISPLACEMENT 0073 06761 001000 ALS DOUBLE DISPLACEMENT 0074 06762 164142 LDB HSTPT,I COMPUTE 0075 06763 140001 ADA 1,I ACTUAL 0076 06764 170142 STA HSTPT,I ADDRESS 0077 06765 064141 LDB LSTPT UNSTACK 0078 06766 044431 ADB M1 0079 06767 074141 STB LSTPT ( 0080 06770 124260 JMP FOR1A,I 0081** 0082*** INTEGERIZE A SUBSCRIPT ** 0083** 0084 06771 000000 ESBS NOP 0085 06772 015515 JSB OPCHK VALIDATE SUBSCRIPT 0086 06773 160001 LDA 1,I FETCH 0087 06774 006004 INB SUBSCRIPT 0088 06775 164001 LDB 1,I 0089 06776 015353 JSB SBFIX INTEGERIZE 0090 06777 174141 STB LSTPT,I SAVE IN OPERATOR STACK 0091 07000 034142 ISZ HSTPT POP OPERAND STACK 0092 07001 126771 JMP ESBS,I PAGE 0098 #07 EXECUTE THE PROGRAM 0094** 0095*** EXECUTE STORE ** 0096** 0097 07002 064166 ESTR LDB TEMPS+7 IS NEXT OPERATOR 0098 07003 006002 SZB AN END-OF-FORMULA? 0099 07004 124263 JMP FOR1B,I NO, DEFER STORE 0100 07005 054165 CPB TEMPS+6 YES, FIRST STORE OPERATOR USED? 0101 07006 027022 JMP ESTR2 YES 0102 07007 160142 ESTR1 LDA HSTPT,I SET 0103 07010 070170 STA TEMPS+9 DESTINATION 0104 07011 060165 LDA TEMPS+6 SOURCE ADDRESS IN (A) 0105 07012 164000 LDB 0,I TRANSFER HIGH 0106 07013 174170 STB TEMPS+9,I PART OF SOURCE 0107 07014 034170 ISZ TEMPS+9 UPDATE 0108 07015 002004 INA POINTERS 0109 07016 164000 LDB 0,I TRANSFER LOW 0110 07017 174170 STB TEMPS+9,I PART OF SOURCE 0111 07020 034142 ISZ HSTPT POP STACK 0112 07021 124262 JMP FOR0B,I 0113 07022 015515 ESTR2 JSB OPCHK SAVE ADDRESS 0114 07023 074165 STB TEMPS+6 OF QUANTITY 0115 07024 034142 ISZ HSTPT YES, POP HIGH-CORE 0116 07025 027007 JMP ESTR1 STACK AND EXECUTE STORE 0117** 0118*** CALL ADD ** 0119** 0120 07026 016707 EFAD JSB BINOP 0121 07027 017343 JSB .FAD 0122 07030 124261 JMP FOR0A,I 0123** 0124*** CALL SUBTRACT ** 0125** 0126 07031 016707 EFSB JSB BINOP 0127 07032 017347 JSB .FSB 0128 07033 124261 JMP FOR0A,I 0129** 0130*** CALL MULTIPLY ** 0131** 0132 07034 016707 EFMP JSB BINOP 0133 07035 017416 JSB .FMP 0134 07036 124261 JMP FOR0A,I 0135** 0136*** CALL DIVIDE ** 0137** 0138 07037 016707 EFDV JSB BINOP 0139 07040 017463 JSB .FDV 0140 07041 124261 JMP FOR0A,I 0141** 0142*** EXECUTE ^ ** 0143** 0144 07042 164142 EPWR LDB HSTPT,I LOAD 0145 07043 160001 LDA 1,I 0146 07044 006004 INB POWER 0147 07045 164001 LDB 1,I 0148 07046 015364 JSB IFIX 0149 07047 027052 JMP *+3 PAGE 0099 #07 EXECUTE THE PROGRAM 0150 07050 102301 SOS INTEGER? 0151 07051 027065 JMP EPWR1 YES 0152 07052 016707 JSB BINOP NO 0153 07053 027054 JMP RPWR 0154 07054 017144 RPWR JSB PCHK CHECK ARGUMENTS 0155 07055 002020 SSA NEGATIVE BASE? 0156 07056 014477 JSB ERROR YES 0157 07057 BASER EQU * 0158 07057 066717 LDB BINO1 NO, LOAD BASE 0159 07060 114234 JSB .LOGA,I TAKE NATURAL LOG 0160 07061 017416 JSB .FMP MULTIPLY 0161 07062 106720 DEF BINO2,I BY POWER 0162 07063 114235 JSB .EXPA,I EXPONENTIATE 0163 07064 124261 JMP FOR0A,I RESULT 0164 07065 077463 EPWR1 STB TT1 SAVE SIGN 0165 07066 006020 SSB SAVE 0166 07067 007004 CMB,INB ABSOLUTE VALUE 0167 07070 077552 STB TT2 OF POWER 0168 07071 016707 JSB BINOP 0169 07072 027073 JMP IPWR 0170 07073 017144 IPWR JSB PCHK CHECK ARGUMENTS 0171 07074 066717 LDB BINO1 STORE 0172 07075 072717 STA BINO1 0173 07076 076720 STB BINO2 BASE 0174 07077 060466 LDA HONE INITIALIZE 0175 07100 070163 STA TT3 RESULT 0176 07101 060325 LDA .2 TO 0177 07102 070164 STA TT4 1.0 0178 07103 067552 IPWR1 LDB TT2 DIVIDE POWER 0179 07104 004031 SLB,BRS BY 2 0180 07105 027124 JMP IPWR3 WAS ODD 0181 07106 077552 STB TT2 WAS EVEN 0182 07107 006002 IPWR2 SZB ZERO? 0183 07110 027135 JMP IPWR4 NO 0184 07111 063463 LDA TT1 YES 0185 07112 002020 SSA POSITIVE POWER? 0186 07113 027117 JMP IPWR5 NO 0187 07114 060163 LDA TT3 YES,LOAD 0188 07115 064164 LDB TT4 RESULT 0189 07116 124261 JMP FOR0A,I 0190 07117 060466 IPWR5 LDA HONE LOAD 0191 07120 064325 LDB .2 1.0 0192 07121 017463 JSB .FDV DIVIDE BY 0193 07122 000163 DEF TT3 RESULT 0194 07123 124261 JMP FOR0A,I 0195 07124 077552 IPWR3 STB TT2 SAVE POWER 0196 07125 062717 LDA BINO1 LOAD 0197 07126 066720 LDB BINO2 BASE 0198 07127 017416 JSB .FMP MULTIPLY BY 0199 07130 000163 DEF TT3 RESULT-SO-FAR 0200 07131 070163 STA TT3 SAVE PARTIAL 0201 07132 074164 STB TT4 RESULT 0202 07133 067552 LDB TT2 LOAD POWER 0203 07134 027107 JMP IPWR2 0204 07135 062717 IPWR4 LDA BINO1 LOAD 0205 07136 066720 LDB BINO2 BASE PAGE 0100 #07 EXECUTE THE PROGRAM 0206 07137 017416 JSB .FMP SQUARE 0207 07140 006717 DEF BINO1 IT 0208 07141 072717 STA BINO1 SAVE 0209 07142 076720 STB BINO2 RESULT 0210 07143 027103 JMP IPWR1 0211** 0212*** INSURE VALID OPERATION ** 0213** 0214 07144 000000 PCHK NOP 0215 07145 076717 STB BINO1 LOAD 0216 07146 166720 LDB BINO2,I POWER 0217 07147 002002 SZA BASE ZERO? 0218 07150 027161 JMP PCHK1 NO 0219 07151 006003 SZB,RSS YES, POWER ZERO? 0220 07152 014477 JSB ERROR YES 0221 07153 POWER EQU * 0222 07153 006021 SSB,RSS NO, POWER POSITIVE? 0223 07154 027221 JMP FALSE YES 0224 07155 014477 JSB ERROR NO 0225 07156 060422 ZRTNG LDA INF USE POSITIVE 0226 07157 064432 LDB M2 INFINITY 0227 07160 124261 JMP FOR0A,I 0228 07161 006003 PCHK1 SZB,RSS POWER ZERO? 0229 07162 027224 JMP TRUE YES, RETURN 1.0 0230 07163 127144 JMP PCHK,I NO 0231** 0232*** EXECUTE > ** 0233** 0234 07164 016707 EGTRT JSB BINOP COMPUTE OPERAND 0235 07165 017347 JSB .FSB DIFFERENCE 0236 07166 002020 SSA NEGATIVE? 0237 07167 027221 JMP FALSE YES 0238 07170 027217 JMP ENEQ1 NO 0239** 0240*** EXECUTE < ** 0241** 0242 07171 016707 ELST JSB BINOP COMPUTE OPERAND 0243 07172 017347 JSB .FSB DIFFERENCE 0244 07173 002020 SSA NEGATIVE? 0245 07174 027224 JMP TRUE YES 0246 07175 027221 JMP FALSE NO 0247** 0248*** EXECUTE = ** 0249** 0250 07176 016707 EEQL JSB BINOP COMPUTE OPERAND 0251 07177 017347 JSB .FSB DIFFERENCE 0252 07200 002002 EEQL1 SZA ZERO? 0253 07201 027221 JMP FALSE NO 0254 07202 027224 JMP TRUE YES PAGE 0101 #07 EXECUTE THE PROGRAM 0256** 0257*** EXECUTE >= ** 0258** 0259 07203 016707 EGORE JSB BINOP COMPUTE OPERAND 0260 07204 017347 JSB .FSB DIFFERENCE 0261 07205 002020 SSA POSITIVE? 0262 07206 027221 JMP FALSE NO 0263 07207 027224 JMP TRUE YES 0264** 0265*** EXECUTE <= ** 0266** 0267 07210 016707 ELORE JSB BINOP COMPUTE OPERAND 0268 07211 017347 JSB .FSB DIFFERENCE 0269 07212 002020 SSA NEGATIVE? 0270 07213 027224 JMP TRUE YES 0271 07214 027200 JMP EEQL1 NO 0272** 0273*** EXECUTE # ** 0274** 0275 07215 016707 ENEQL JSB BINOP COMPUTE OPERAND 0276 07216 017347 JSB .FSB DIFFERENCE 0277 07217 002002 ENEQ1 SZA NON-ZERO? 0278 07220 027224 JMP TRUE YES 0279** 0280*** SET LOGICAL VALUES ** 0281** 0282 07221 002400 FALSE CLA LOAD 0283 07222 006400 CLB ZERO 0284 07223 124261 JMP FOR0A,I 0285 07224 060466 TRUE LDA HONE LOAD 0286 07225 064325 LDB .2 ONE 0287 07226 124261 JMP FOR0A,I 0288** 0289*** EXECUTE UNARY - ** 0290** 0291 07227 015505 EUMIN JSB STTOP LOAD NUMBER 0292 07230 015423 JSB ARINV NEGATE NUMBER 0293 07231 124261 JMP FOR0A,I 0294** 0295*** EXECUTE LEFT BRACKET ** 0296** 0297 07232 034141 ELBRC ISZ LSTPT LOAD SUBSCRIPT COMMA 0298 07233 064405 LDB SCCNT INFORMATION WORD 0299 07234 015467 JSB SLWST STACK IT 0300 07235 015476 JSB BHSTP STACK 0301 07236 015536 JSB RSCHK 0302 07237 027224 JMP TRUE 1 0303** 0304*** EXECUTE OR ** 0305** 0306 07240 016707 EOR JSB BINOP VALIDATE 0307 07241 027242 JMP ORS OPERANDS 0308 07242 002002 ORS SZA SECOND OPERAND NON-ZERO? 0309 07243 027224 JMP TRUE YES 0310 07244 162720 ORS1 LDA BINO2,I NO, CHECK SECOND 0311 07245 027217 JMP ENEQ1 OPERAND PAGE 0102 #07 EXECUTE THE PROGRAM 0312** 0313*** EXECUTE AND ** 0314** 0315 07246 016707 EAND JSB BINOP VALIDATE 0316 07247 027250 JMP ANDS OPERANDS 0317 07250 002003 ANDS SZA,RSS SECOND OPERAND ZERO? 0318 07251 027221 JMP FALSE YES 0319 07252 027244 JMP ORS1 NO 0320** 0321*** EXECUTE NOT ** 0322** 0323 07253 015505 ENOT JSB STTOP LOAD OPERAND 0324 07254 002002 SZA ZERO? 0325 07255 027221 JMP FALSE NO 0326 07256 027224 JMP TRUE YES 0327** 0328*** ADD TWO FLOATING POINT QUANTITIES ** 0329** 0330 07257 000000 ADMUP NOP 0331 07260 061677 LDA OUTLN COMPUTE 0332 07261 003004 ADMU1 CMA,INA EXPONENT 0333 07262 040154 ADA EXP DIFFERENCE 0334 07263 002021 SSA,RSS ARG 1 LARGER? 0335 07264 027302 JMP ADMU2 YES 0336 07265 062074 LDA A1 NO, 0337 07266 066105 LDB A2 SWAP 0338 07267 072105 STA A2 ARGUMENTS 0339 07270 076074 STB A1 0340 07271 062147 LDA C1 0341 07272 066163 LDB C2 0342 07273 072163 STA C2 0343 07274 076147 STB C1 0344 07275 060154 LDA EXP 0345 07276 065677 LDB OUTLN 0346 07277 071677 STA OUTLN 0347 07300 074154 STB EXP 0348 07301 027261 JMP ADMU1 0349 07302 040447 ADMU2 ADA M25 SHIFT COUNT >= 0350 07303 066147 LDB C1 0351 07304 002021 SSA,RSS 25 ? 0352 07305 027334 JMP ADMU4 YES, IGNORE SMALLER ARGUMENT 0353 07306 003100 CMA,CLE NO, COMPUTE 0354 07307 040447 ADA M25 SHIFT COUNT 0355 07310 071677 STA OUTLN AS NEGATIVE 0356 07311 062105 LDA A2 LOAD SMALLER 0357 07312 066163 LDB C2 MANTISSA 0358 07313 035677 ADMU3 ISZ OUTLN MORE SHIFTS? 0359 07314 027337 JMP ADMU5 YES 0360 07315 046147 ADB C1 NO, ADD LOW MANTISSAS 0361 07316 103101 CLO 0362 07317 005326 RBR,ELB SAVE (E) IN B(0) 0363 07320 000040 CLE 0364 07321 042074 ADA A1 ADD HIGH MANTISSAS 0365 07322 004010 SLB OVERFLOW FROM LOWER MANTISSA? 0366 07323 002004 INA YES, ADD IT IN 0367 07324 005566 ERB,CLE,ELB ERASE B(0) PAGE 0103 #07 EXECUTE THE PROGRAM 0368 07325 102301 SOS OVERFLOW? 0369 07326 027335 JMP ADMU4+1 NO 0370 07327 001500 ERA YES, SHIFT 0371 07330 005500 ERB MANTISSA DOWN AND 0372 07331 034154 ISZ EXP CORRECT EXPONENT 0373 07332 027335 JMP ADMU4+1 0374 07333 002001 RSS 0375 07334 062074 ADMU4 LDA A1 RETRIEVE HIGH MANTISSA 0376 07335 015020 JSB .PACK NORMALIZE AND PACK 0377 07336 127257 JMP ADMUP,I 0378 07337 000071 ADMU5 CLE,SLA,ARS ARITHMETIC 0379 07340 002200 CME DOUBLE 0380 07341 005540 ERB,CLE SHIFT 0381 07342 027313 JMP ADMU3 0382** 0383*** ADD TWO FLOATING POINT NUMBERS ** 0384** 0385 07343 000000 .FAD NOP 0386 07344 017366 JSB UNPAK UNPACK THE ARGUMENTS 0387 07345 017257 JSB ADMUP ADD THEM UP 0388 07346 127343 JMP .FAD,I 0389** 0390*** SUBTRACT TWO FLOATING POINT NUMBERS ** 0391** 0392 07347 000000 .FSB NOP 0393 07350 017366 JSB UNPAK UNPACK THE ARGUMENTS 0394 07351 062105 LDA A2 TWO'S COMPLEMENT 0395 07352 003000 CMA THE SECOND ARGUMENT 0396 07353 007006 CMB,INB,SZB LOW PART ZERO? 0397 07354 027362 JMP .FSB1 NO 0398 07355 002025 SSA,INA,RSS YES, ORIGINAL NUMBER NEGATIVE? 0399 07356 002021 SSA,RSS YES, STILL NEGATIVE? 0400 07357 027362 JMP .FSB1 NO 0401 07360 001300 RAR YES, SHIFT DOWN AND 0402 07361 035677 ISZ OUTLN CORRECT EXPONENT 0403 07362 076163 .FSB1 STB C2 SAVE COMPLEMENTED 0404 07363 072105 STA A2 NUMBER 0405 07364 017257 JSB ADMUP ADD ARGUMENTS 0406 07365 127347 JMP .FSB,I 0407** 0408*** UNPACK ARGUMENTS FOR ARITHMETIC OPERATIONS ** 0409** 0410 07366 000000 UNPAK NOP 0411 07367 072074 STA A1 SAVE HIGH PART OF ARG 1 0412 07370 002003 SZA,RSS UNPACK 0413 07371 006404 CLB,INB SECOND 0414 07372 015456 JSB .FLUN WORD 0415 07373 076147 STB C1 SAVE LOW PART OF ARG 1 0416 07374 070154 STA EXP SAVE EXPONENT OF ARG 1 0417 07375 063366 LDA UNPAK COMPUTE ADDRESS OF 0418 07376 040432 ADA M2 CALLING ROUTINE 0419 07377 164000 LDB 0,I 0420 07400 134000 ISZ 0,I SET CALLING ROUTINE'S RETURN 0421 07401 164001 LDB 1,I LOAD 0422 07402 005275 RBL,CLE,SLB,ERB ADDRESS OF 0423 07403 027401 JMP *-2 ARG 2 PAGE 0104 #07 EXECUTE THE PROGRAM 0424 07404 160001 LDA 1,I LOAD 0425 07405 006004 INB ARG 2 0426 07406 164001 LDB 1,I 0427 07407 072105 STA A2 SAVE HIGH PART OF ARG 2 0428 07410 002003 SZA,RSS UNPACK 0429 07411 006404 CLB,INB SECOND 0430 07412 015456 JSB .FLUN WORD 0431 07413 076163 STB C2 SAVE LOW PART OF ARG 2 0432 07414 071677 STA OUTLN SAVE EXPONENT OF ARG 2 0433 07415 127366 JMP UNPAK,I 0434** 0435*** MULTIPLY TWO FLOATING POINT NUMBERS ** 0436** 0437 07416 000000 .FMP NOP UNPACK THE 0438 07417 017366 JSB UNPAK ARGUMENTS 0439 07420 040154 ADA EXP ADD EXPONENTS 0440 07421 002004 INA PLUS 1 FOR 0441 07422 070154 STA EXP NORMALIZATION 0442 07423 005300 RBR POSITION LOW PART OF ARG 2 0443 07424 060001 LDA 1 COMPUTE A 0444 07425 015236 JSB MPY CROSS PRODUCT 0445 07426 006074 DEF A1 0446 07427 072163 STA C2 SAVE RESULT 0447 07430 062147 LDA C1 LOAD AND POSITION 0448 07431 001300 RAR LOW PART OF ARG 1 0449 07432 076147 STB C1 SAVE REST OF PRIOR RESULT 0450 07433 015236 JSB MPY COMPUTE SECOND 0451 07434 006105 DEF A2 CROSS PRODUCT 0452 07435 046147 ADB C1 ADD 0453 07436 000040 CLE CROSS 0454 07437 042163 ADA C2 PRODUCTS 0455 07440 002040 SEZ CORRECT 0456 07441 006004 INB FOR CARRY 0457 07442 076163 STB C2 SAVE RESULT 0458 07443 062074 LDA A1 COMPUTE 0459 07444 015236 JSB MPY HIGH PART 0460 07445 006105 DEF A2 OF PRODUCT 0461 07446 000065 CLE,ERA POSITION LOW PART 0462 07447 042163 ADA C2 ADD IN CROSS TERMS 0463 07450 000066 CLE,ELA REPOSITION 0464 07451 002041 SEZ,RSS CARRY FROM LOW PART? 0465 07452 027456 JMP *+4 NO 0466 07453 102201 SOC YES, POSITIVE CARRY? 0467 07454 006005 INB,RSS YES 0468 07455 044431 ADB M1 NO 0469 07456 072074 STA A1 EXCHANGE 0470 07457 060001 LDA 1 0471 07460 066074 LDB A1 REGISTERS 0472 07461 015020 JSB .PACK NORMALIZE AND PACK 0473 07462 127416 JMP .FMP,I PAGE 0105 #07 EXECUTE THE PROGRAM 0475** 0476*** PERFORM FLOATING DIVIDE ** 0477** 0478 07463 000000 .FDV NOP 0479 07464 017366 JSB UNPAK UNPACK ARGUMENTS 0480 07465 066105 LDB A2 DIVISOR 0481 07466 006003 SZB,RSS ZERO? 0482 07467 027546 JMP .FDV2 YES 0483 07470 066074 LDB A1 NO, DIVIDEND 0484 07471 006003 SZB,RSS ZERO? 0485 07472 027543 JMP .FDV1 YES 0486 07473 003004 CMA,INA NO, COMPUTE 0487 07474 002004 INA EXPONENT 0488 07475 040154 ADA EXP DIFFERENCE 0489 07476 070154 STA EXP PLUS 1 0490 07477 062147 LDA C1 LOAD DIVIDEND 0491 07500 004071 CLE,SLB,BRS ARITHMETIC 0492 07501 002200 CME RIGHT SHIFT 0493 07502 001500 ERA TWICE TO 0494 07503 004071 CLE,SLB,BRS PREVENT 0495 07504 002200 CME DIVISION 0496 07505 001500 ERA OVERFLOW 0497 07506 017552 JSB IDIV DIVIDE 0498 07507 071677 STA OUTLN SAVE QUOTIENT 0499 07510 005100 BRS DIVIDE REMAINDER BY 2 TO 0500 07511 002400 CLA PREVENT DIVISION OVERFLOW 0501 07512 017552 JSB IDIV DIVIDE REMAINDER AND 0502 07513 070615 STA NUMCK SAVE LOW PART OF QUOTIENT 0503 07514 066163 LDB C2 0504 07515 002500 CLA,CLE SCALE TO 0505 07516 005521 ERB,BRS PREVENT 0506 07517 005100 BRS OVERFLOW 0507 07520 017552 JSB IDIV COMPUTE B2/A2 = Q 0508 07521 003004 CMA,INA COMPUTE 0509 07522 015236 JSB MPY -HIGH QUOTIENT*Q 0510 07523 001677 DEF OUTLN 0511 07524 005066 BLS,CLE,ELB SHIFT SIGN TO (E) 0512 07525 060615 LDA NUMCK LOW QUOTIENT 0513 07526 002020 SSA NEGATIVE? 0514 07527 003401 CCA,RSS YES, SET (A)=-1 (EXTEND 0515 07530 002400 CLA NO, SET (A)=0 SIGN) 0516 07531 003040 CMA,SEZ IF (E)=1 SUBTRACT 0517 07532 002004 INA 1 AS EXTENSION 0518 07533 003100 CMA,CLE OF PRODUCT 0519 07534 044615 ADB NUMCK ADD IN LOW QUOTIENT 0520 07535 002040 SEZ CARRY 0521 07536 002004 INA INTO (A) 0522 07537 004066 CLE,ELB POSITION 0523 07540 001600 ELA REGISTERS 0524 07541 041677 ADA OUTLN ADD IN HIGH QUOTIENT 0525 07542 002001 RSS 0526 07543 002400 .FDV1 CLA SET MANTISSA TO ZERO 0527 07544 015020 JSB .PACK NORMALIZE AND PACK 0528 07545 127463 JMP .FDV,I 0529 07546 014477 .FDV2 JSB ERROR DIVIDE-BY-ZERO 0530 07547 062074 DBYZR LDA A1 PAGE 0106 #07 EXECUTE THE PROGRAM 0531 07550 015103 JSB OVFLW RETURN INFINITY 0532 07551 127463 JMP .FDV,I 0533** 0534*** INTEGER DIVIDE ** 0535** 0536 07552 000000 IDIV NOP DIVIDEND IN (B) AND (A) 0537 07553 076074 STB A1 SAVE HIGH DIVIDEND 0538 07554 066105 LDB A2 0539 07555 006120 CLE,SSB SET (B) TO ABS(B) 0540 07556 007204 CMB,CME,INB AND (E) TO SIGN(B) 0541 07557 077343 STB .FAD SAVE POSITIVE DIVISOR 0542 07560 007004 CMB,INB SAVE 0543 07561 077347 STB .FSB NEGATIVE DIVISOR 0544 07562 064445 LDB M16 SET 0545 07563 076147 STB C1 COUNTER 0546 07564 064432 LDB M2 SET 0547 07565 074153 STB SIGN 0548 07566 077416 STB .FMP SIGNS 0549 07567 066074 LDB A1 RETRIEVE HIGH DIVIDENED 0550 07570 006021 SSB,RSS POSITIVE? 0551 07571 027577 JMP IDIV1 YES 0552 07572 037416 ISZ .FMP NO, SET REMAINDER SIGN 0553 07573 007200 CMB,CME NEGATIVE AND COMPLEMENT 0554 07574 002002 SZA THE DIVISOR 0555 07575 003005 CMA,INA,RSS AND (E) 0556 07576 006004 INB 0557 07577 002040 IDIV1 SEZ QUOTIENT POSITIVE? 0558 07600 034153 ISZ SIGN NO 0559 07601 000066 IDIV2 CLE,ELA SHIFT 0560 07602 005600 ELB DIVIDEND 0561 07603 047347 ADB .FSB SUBTRACT DIVISOR 0562 07604 006021 SSB,RSS OK? 0563 07605 002005 INA,RSS YES 0564 07606 047343 ADB .FAD NO, RESTORE DIVIDEND 0565 07607 036147 ISZ C1 DONE? 0566 07610 027601 JMP IDIV2 NO 0567 07611 003004 CMA,INA YES, NEGATE QUOTIENT 0568 07612 034153 ISZ SIGN RESULT TO BE POSITIVE? 0569 07613 003004 CMA,INA YES 0570 07614 037416 ISZ .FMP NO, REMAINDER POSITIVE? 0571 07615 127552 JMP IDIV,I YES 0572 07616 007004 CMB,INB NO 0573 07617 127552 JMP IDIV,I PAGE 0107 #07 EXECUTE THE PROGRAM 0575* ****************************** 0576* SYMBOL TABLE SEARCH SUBROUTINE 0577* ****************************** 0578* 0579* THE SUBROUTINE IS CALLED WITH THE IDENTIFIER TO BE 0580* SEARCHED FOR IN A . THE SUBROUTINE RETURNS WITH 0581* THE ADDRESS OF THE MATCHING ENTRY IN B OR -1 IN 0582* B IF THERE IS NO MATCHING ENTRY 0583* THE FOLLOWING RULES APPLY WHEN SEARCHING FOR ARRAYS 0584* 0585* TYPE 1 (1 DIMENSION) SEARCH FOR CORRESPONDING TYPE 1 0586* OR TYPE 3 ARRAY. IF TYPE 3 IS FOUND CHANGE THE ENTRY 0587* TYPE TO TYPE 1 0588* 0589* TYPE 2 (2 DIMENSIONS) SEARCH FOR CORRESPONDING TYPES 0590* OR TYPE 3 ARRAY. IF TYPE 3 IS FORND CHANGE THE ENTRY 0591* TYPE TO TYPE 2 0592* 0593* TYPE 3 (UNDIMENSIONED) SEARCH FOR CORRESPONDING 0594* TYPE 3 OR TYPE 1 OR TYPE 2 ARRAY 0595* 0596 07620 000000 SSYMT NOP 0597 07621 070163 STA STEMP STORE IDENTIFIER 0598 07622 010336 AND .15 ISOLATE IDENTIFIER TYPE 0599 07623 040434 ADA M4 0600 07624 002024 SSA,INA 0601 07625 027631 JMP *+4 JUMP IF ARRAY TYPE 0602 07626 060163 LDA STEMP RESTORE A 0603 07627 070001 STA 1 STORE IN B 0604 07630 027643 JMP SYMT1+3 0605 07631 002020 SSA SKIP IF UNDIMENSIONED 0606 07632 027640 JMP SYMT1 0607 07633 060163 LDA STEMP RESTORE A 0608 07634 010437 AND MSK3 177771B SET TYPE TO 1 0609 07635 070001 STA 1 0610 07636 006004 INB SET TYPE IN B TO 2 0611 07637 027643 JMP *+4 0612 07640 007400 SYMT1 CCB SET DIMENSIONED FLAG IN B 0613 07641 060326 LDA .3 0614 07642 030163 IOR STEMP SET TYPE TO UNDEFINED 0615 07643 070164 STA STEMP+1 STORE A 0616 07644 074165 STB STEMP+2 STORE B 0617 07645 064116 LDB SYMTF START OF SYMBOL TABLE 0618 07646 027667 JMP SYMT4 0619 07647 160001 SYMT2 LDA 1,I PICK UP 1ST WORD OF ENTRY 0620 07650 050163 CPA STEMP COMPARE WITH IDENTIFIER 0621 07651 127620 JMP SSYMT,I MATCH ? RETURN 0622 07652 050164 CPA STEMP+1 COMPARE WITH DIFFERENT DIM. 0623 07653 027674 JMP SYMT3 0624 07654 050165 CPA STEMP+2 COMPARE WITH DIFFERENT DIM. 0625 07655 027674 JMP SYMT3 0626 07656 160001 LDA 1,I 0627 07657 010336 AND .15 ISOLATE ENTRY TYPE 0628 07660 050336 CPA .15 FUNCTION ? 0629 07661 027666 JMP *+5 YES 0630 07662 040434 ADA M4 PAGE 0108 #07 EXECUTE THE PROGRAM 0631 07663 002020 SSA ARRAY ? 0632 07664 006004 INB YES INCREMENT POINTER 0633 07665 006004 INB INCREMENT POINTER 0634 07666 044325 ADB .2 ADD 2 TO POINTER 0635 07667 054117 SYMT4 CPB SYMTA SYMBOL TABLE EXHAUSTED? 0636 07670 007401 CCB,RSS YES 0637 07671 027647 JMP SYMT2 NO, CHECK NEXT ENTRY FOR MATCH 0638 07672 060163 LDA STEMP RETRIEVE SYMBOL 0639 07673 127620 JMP SSYMT,I RETURN WITH B NEGATIVE 0640 07674 060163 SYMT3 LDA STEMP RESTORE A 0641 07675 034165 ISZ STEMP+2 DIMENSIONED IDENTIFIER? 0642 07676 002001 RSS NO, SKIP 0643 07677 170001 STA 1,I YES CHANGE 1ST WORD OF ENTRY TO 0644 07700 127620 JMP SSYMT,I APPROPRIATE DIMENSION TYPE 0002** 0003*** ERROR TABLE ** 0004** 0005 07701 000266 ERR DEF EOF+1 PREMATURE STATEMENT END 0006 07702 002066 DEF RTLE INPUT EXCEEDS 71 CHARACTERS 0007 07703 002137 DEF INVSC SYSTEM COMMAND NOT RECOGNIZED 0008 07704 002236 DEF SYNE1 NO STATEMENT TYPE FOUND 0009 07705 000717 DEF NUMER+1 BAD EXPONENT PART 0010 07706 002656 DEF SYE16 NO LETTER WHERE EXPECTED 0011 07707 002346 DEF SYNE2 LET STATEMENT HAS NO STORE 0012 07710 002361 DEF SYNE3 ILLEGAL COM STATEMENT 0013 07711 002406 DEF SYNE4+1 NO FUNCTION IDENTIFIER (OR BAD) 0014 07712 002420 DEF SYNE5 MISSING PARAMETER 0015 07713 002425 DEF SYNE6+1 MISSING ASSIGNMENT OPERATOR 0016 07714 002445 DEF SYNE7 MISSING 'THEN' 0017 07715 002453 DEF SYNE8+1 MISSING OR IMPROPER FOR-VARIABLE 0018 07716 002465 DEF SYNE9 MISSING 'TO' 0019 07717 002500 DEF SYE10 BAD 'STEP' PART IN FOR STATEMENT 0020 07720 001330 DEF CALER CALLED ROUTINE DOES NOT EXIST 0021 07721 002541 DEF SYE11+1 WRONG NUMBER OF CALL PARAMETERS 0022 07722 000614 DEF SYE12 NO CONSTANT WHERE EXPECTED 0023 07723 002561 DEF SYE13 NO VARIABLE WHERE EXPECTED 0024 07724 002613 DEF SYE14 NO CLOSING QUOTE FOR STRING 0025 07725 002625 DEF SYE15 PRINT JUXTAPOSES FORMULAS 0026 07726 002671 DEF SYE17 IMPROPER WORD IN MAT STATEMENT 0027 07727 002702 DEF SYE18 NO COMMA WHERE EXPECTED 0028 07730 002755 DEF SYE19 IMPROPER ARRAY FUNCTION 0029 07731 002775 DEF SYE20 NO SUBSCRIPT WHERE EXPECTED 0030 07732 003007 DEF SYE21 ARRAY INVERSION INTO SELF 0031 07733 003020 DEF SYE22 MISSING MULTIPLICATION OPERATOR 0032 07734 003041 DEF SYE23 IMPROPER ARRAY OPERATOR 0033 07735 003060 DEF SYE24+1 ARRAY MULTIPLICATION INTO SELF 0034 07736 003202 DEF FSCE1+1 MISSING LEFT PARENTHESIS 0035 07737 003256 DEF FSCE2+1 MISSING RIGHT PARENTHESIS 0036 07740 003306 DEF FSCE3+1 UNRECOGNIZED OPERAND 0037 07741 003534 DEF ARRE1 MISSING SUBSCRIPT 0038 07742 003547 DEF ARRE2 MISSING ARRAY IDENTIFIER PAGE 0109 #08 EXECUTE THE PROGRAM 0039 07743 004345 DEF SYE25+1 MISSING OR BAD INTEGER 0040 07744 000267 DEF NOEOF+1 CHARACTERS AFTER STATEMENT END 0041 07745 003402 DEF FSCE4+1 OUT OF CORE DURING SYNTAX 0042 07746 002170 DEF PRERR PHOTO READER NOT READY 0043 07747 005312 DEF MER4 FUNCTION MULTIPLY DEFINED 0044 07750 005413 DEF MER6 UNMATCHED FOR STATEMENT 0045 07751 005264 DEF MER3 UNMATCHED NEXT 0046 07752 005512 DEF MER8 OUT OF STORAGE-SYMBOL TABLE 0047 07753 005541 DEF MSYM INCONSISTENT DIMENSIONS 0048 07754 005301 DEF MLOP6 LAST STATEMENT IS NOT 'END' 0049 07755 005377 DEF MER5 ARRAY DOUBLE DIMENSIONED 0050 07756 005431 DEF MER10 NO OF DIMENSIONS UNSPECIFIED 0051 07757 001352 DEF MER9 ARRAY TOO LARGE 0052 07760 005464 DEF MER7 OUT OF STORAGE-ARRAY ALLOCATION 0053 07761 006760 DEF E6 SUBSCRIPT TOO LARGE 0054 07762 001526 DEF E8 UNDEFINED OPERAND ACCESSED 0055 07763 007057 DEF BASER NEGATIVE BASE POWERED TO REAL 0056 07764 007153 DEF POWER ZERO TO ZERO POWER 0057 07765 006054 DEF XEC5 MISSING STATEMENT 0058 07766 006363 DEF E2 GOSUBS NESTED 10 DEEP 0059 07767 006367 DEF E3 RETURN FINDS NO ADDRESS 0060 07770 006135 DEF E4 OUT OF DATA 0061 07771 001474 DEF E1+1 OUT OF STORAGE - EXECUTION 0062 07772 011766 DEF E7 RE-DIMENSIONED ARRAY TOO LARGE 0063 07773 012036 DEF LERR+1 DIMENSIONS NOT COMPATIBLE 0064 07774 012100 DEF LCHK5 MATRIX UNASSIGNED 0065 07775 012704 DEF LDUM1 NEARLY SINGULAR MATRIX 0066 07776 010420 DEF TRGER ARGUMENT TOO LARGE 0067 07777 010771 DEF SQRER SQRT HAS NEGATIVE ARGUMENT 0068 10000 011077 DEF LOGER LOG OF NEGATIVE ARGUMENT 0069 10001 RCERR EQU * ** RECOVERABLE ERRORS FOLLOW ** 0070 10001 001100 DEF OVRER OVERFLOW 0071 10002 001074 DEF UNDER UNDERFLOW 0072 10003 011151 DEF LNZR LOG OF ZERO 0073 10004 011305 DEF EXPER EXPONENTIAL OVERFLOW 0074 10005 007547 DEF DBYZR DIVIDE BY ZERO 0075 10006 007156 DEF ZRTNG ZERO TO NEGATIVE POWER 0076* 0077* 0078 10007 006412 EBUFF OCT 6412 0079 10010 042522 ASC 3,ERROR 0080 10013 000000 EBFF BSS 2 0081 10015 020111 LBUFF ASC 5, IN LINE 0082 10022 000000 LNBFF BSS 2 PAGE 0110 #08 EXECUTE THE PROGRAM 0084** 0085*** PREDEFINED FUNCTION JUMP TABLE ** 0086** 0087 10024 006605 PDFT DEF ETAB 0088 10025 010647 DEF ESIN 0089 10026 010645 DEF ECOS 0090 10027 010406 DEF ETAN 0091 10030 010532 DEF EATN 0092 10031 011177 DEF EEXP 0093 10032 011070 DEF ELOG 0094 10033 010642 DEF EABS 0095 10034 010765 DEF ESQR 0096 10035 011055 DEF EINT 0097 10036 010736 DEF ERND 0098 10037 011166 DEF ESGN 0099** 0100*** OUTPUT A NUMBER ** 0101** 0102 10040 000000 NUMOT NOP NUMBER IN (A) AND (B) 0103 10041 071603 STA EXPON SAVE NUMBER 0104 10042 002041 SEZ,RSS SIGN? 0105 10043 026055 JMP NS2 NO 0106 10044 002021 SSA,RSS YES, NEGATIVE NUMBER? 0107 10045 026052 JMP NS1 NO 0108 10046 015423 JSB ARINV YES, INVERT IT 0109 10047 071603 STA EXPON 0110 10050 060354 LDA .45 0111 10051 002001 RSS 0112 10052 060345 NS1 LDA .32 STORE 0113 10053 070153 STA SIGN SIGN 0114 10054 061603 LDA EXPON 0115 10055 076344 NS2 STB GETDG SAVE NUMBER 0116 10056 015364 JSB IFIX INTEGERIZE 0117 10057 000000 NOP 0118 10060 162040 LDA NUMOT,I SET 0119 10061 072101 STA NUMO1 END-OF-LINE 0120 10062 072135 STA NUMO3 OPERATION 0121 10063 036040 ISZ NUMOT BUMP RETURN ADDRESS 0122 10064 102201 SOC WAS IT AN INTEGER? 0123 10065 026110 JMP NUMO2 NO 0124** 0125*** OUTPUT AN INTEGER ** 0126** 0127 10066 002400 CLA SAVE 0128 10067 074174 STB B1+1 INTEGER 0129 10070 044462 ADB M1000 5 OR MORE 0130 10071 006021 SSB,RSS CHARACTERS? 0131 10072 040326 ADA .3 YES 0132 10073 040330 ADA .6 COMPUTE 0133 10074 040133 ADA CCNT END-OF-FIELD 0134 10075 003004 CMA,INA SAVE MARKER TO 0135 10076 070172 STA MLBX1+1 END-OF-FIELD 0136 10077 040367 ADA .74 ENOUGH 0137 10100 002020 SSA ROOM? 0138 10101 000000 NUMO1 NOP NO 0139 10102 060153 LDA SIGN PAGE 0111 #08 EXECUTE THE PROGRAM 0140 10103 002002 SZA SIGN? 0141 10104 015715 JSB OUTCR YES, OUTPUT IT 0142 10105 060174 LDA B1+1 OUTPUT 0143 10106 114222 JSB OUTIA,I THE INTEGER 0144 10107 126040 JMP NUMOT,I 0145 10110 003400 NUMO2 CCA SET 'FIXED' 0146 10111 073032 STA FFLAG FLAG FALSE 0147 10112 061603 LDA EXPON LOAD 0148 10113 066344 LDB GETDG NUMBER 0149 10114 114236 JSB .FADA,I IS NUMBER 0150 10115 000472 DEF MAXFX LESS THAN 0151 10116 002021 SSA,RSS 999999.5 ? 0152 10117 026127 JMP NUMO5 NO 0153 10120 061603 LDA EXPON YES, IS 0154 10121 066344 LDB GETDG NUMBER 0155 10122 114236 JSB .FADA,I LESS 0156 10123 000474 DEF MINFX THAN 0157 10124 064335 LDB .12 0..9999995? 0158 10125 002021 SSA,RSS 0159 10126 037032 ISZ FFLAG NO, SET FFLAG = 0 AND SKIP 0160 10127 064336 NUMO5 LDB .15 YES, LOAD 'FLOATING' FIELD WIDTH 0161 10130 044133 ADB CCNT SAVE 0162 10131 007004 CMB,INB END-OF-FIELD 0163 10132 074172 STB MLBX1+1 MARKER 0164 10133 044370 ADB .75 ROOM 0165 10134 006020 SSB ENOUGH? 0166 10135 000000 NUMO3 NOP NO 0167** 0168*** OUTPUT A FLOATING POINT NUMBER ** 0169** 0170 10136 061603 LDA EXPON 0171 10137 071274 STA MANT1 0172 10140 066344 LDB GETDG UNPACK 0173 10141 015456 JSB .FLUN 0174 10142 075336 STB MANT2 NUMBER 0175 10143 070154 STA EXP 0176 10144 060153 LDA SIGN 0177 10145 002002 SZA SIGN? 0178 10146 015715 JSB OUTCR YES, OUTPUT IT 0179 10147 002400 CLA INITIALIZE COUNTER 0180 10150 071603 STA EXPON FOR DECIMAL EXPONENT 0181 10151 050154 CPA EXP EXPONENT ZERO? 0182 10152 026175 JMP EOUT4 YES 0183 10153 015147 EOUT2 JSB MBY10 NO, 0184 10154 060154 LDA EXP MULTIPLY 0185 10155 003004 CMA,INA NUMBER BY 10 0186 10156 002020 SSA UNTIL 0187 10157 026162 JMP *+3 IT IS 0188 10160 035603 ISZ EXPON GREATER 0189 10161 026153 JMP EOUT2 THAN 1 0190 10162 015200 JSB DBY10 DIVIDE BY 10 0191 10163 061603 LDA EXPON 0192 10164 064154 EOUT3 LDB EXP DIVIDE 0193 10165 007004 CMB,INB NUMBER 0194 10166 006021 SSB,RSS BY 10 0195 10167 026175 JMP EOUT4 UNTIL PAGE 0112 #08 EXECUTE THE PROGRAM 0196 10170 071603 STA EXPON IT IS 0197 10171 015200 JSB DBY10 LESS 0198 10172 003400 CCA THAN 0199 10173 041603 ADA EXPON 1 0200 10174 026164 JMP EOUT3 0201 10175 003000 EOUT4 CMA SET EXPONENT 0202 10176 071603 STA EXPON TO TRUE VALUE-1 0203 10177 064437 LDB M7 SET DIGIT 0204 10200 076370 STB RETCR COUNTER 0205 10201 007400 CCB SET DECIMAL 0206 10202 075677 STB OUTLN POINT FLAG 0207 10203 057032 CPB FFLAG FIXED POINT? 0208 10204 026213 JMP EOUT6 NO 0209 10205 003000 CMA YES, SET 0210 10206 071677 STA OUTLN DECIMAL POINT FLAG 0211 10207 050324 CPA .1 .1? 0212 10210 026217 JMP EOUT5 YES 0213 10211 002021 SSA,RSS LEADING DECIMAL POINT? 0214 10212 026225 JMP EOUT7+2 YES 0215 10213 016344 EOUT6 JSB GETDG OUTPUT 0216 10214 040357 ADA .48 A 0217 10215 015715 JSB OUTCR DIGIT 0218 10216 026227 JMP EOUT8 0219 10217 060355 EOUT5 LDA .46 OUTPUT 0220 10220 015715 JSB OUTCR DECIMAL POINT 0221 10221 060357 LDA .48 OUTPUT 0222 10222 026226 JMP EOUT8-1 LEADING ZERO 0223 10223 035677 EOUT7 ISZ OUTLN DECIMAL POINT NEXT? 0224 10224 026213 JMP EOUT6 NO 0225 10225 060355 LDA .46 YES, 0226 10226 015715 JSB OUTCR OUTPUT IT 0227 10227 036370 EOUT8 ISZ RETCR MORE MANTISSA? 0228 10230 026223 JMP EOUT7 YES 0229 10231 060133 LDA CCNT NO, 0230 10232 072101 STA NUMO1 SAVE 0231 10233 060132 LDA BADDR OUTPUT 0232 10234 072135 STA NUMO3 POINTERS 0233 10235 016344 JSB GETDG NEXT DIGIT 0234 10236 040435 ADA M5 FIVE OR 0235 10237 002020 SSA GREATER? 0236 10240 026303 JMP EOUT1 NO 0237 10241 003400 CCA SET DECIMAL 0238 10242 071274 ERND1 STA SYMCK POINT COUNTER 0239 10243 016370 JSB RETCR RETRIEVE CHARACTER 0240 10244 050355 CPA .46 DECIMAL POINT? 0241 10245 026241 JMP ERND1-1 YES, FLAG IT 0242 10246 015570 JSB DIGCK NO, DIGIT? 0243 10247 026262 JMP ERND2 NO 0244 10250 050333 CPA .9 YES, 9? 0245 10251 026254 JMP *+3 YES 0246 10252 040360 ADA .49 NO, BUMP 0247 10253 026276 JMP ERND3 DIGIT 1 0248 10254 060357 LDA .48 OVERLAY 0249 10255 015715 JSB OUTCR A ZERO 0250 10256 016370 JSB RETCR BACKSPACE 0251 10257 003400 CCA DECREMENT PAGE 0113 #08 EXECUTE THE PROGRAM 0252 10260 041274 ADA SYMCK DECIMAL POINT 0253 10261 026242 JMP ERND1 COUNTER 0254 10262 015715 ERND2 JSB OUTCR RESTORE CHARACTER 0255 10263 035603 ISZ EXPON CORRECT 0256 10264 000000 NOP EXPONENT 0257 10265 060360 LDA .49 OVERLAY A 1 0258 10266 067032 LDB FFLAG FIXED 0259 10267 006002 SZB POINT? 0260 10270 026276 JMP ERND3 NO 0261 10271 015715 JSB OUTCR YES, OUTPUT CHARACTER 0262 10272 060357 LDA .48 PREPARE TO OVERLAY A ZERO 0263 10273 035274 ISZ SYMCK DECIMAL POINT NEXT? 0264 10274 026271 JMP *-3 NO 0265 10275 060355 LDA .46 YES 0266 10276 015715 ERND3 JSB OUTCR 0267 10277 062101 LDA NUMO1 RESTORE 0268 10300 070133 STA CCNT OUTPUT 0269 10301 062135 LDA NUMO3 POINTERS 0270 10302 070132 STA BADDR 0271 10303 037032 EOUT1 ISZ FFLAG NO, FIXED POINT? 0272 10304 026333 JMP EOUT9 YES 0273 10305 060364 LDA E NO, 0274 10306 015715 JSB OUTCR OUTPUT 'E' 0275 10307 060354 LDA .45 LOAD '-' 0276 10310 065603 LDB EXPON POSITIVE 0277 10311 006020 SSB EXPONENT? 0278 10312 007005 CMB,INB,RSS NO 0279 10313 060353 LDA .43 YES, LOAD '+' 0280 10314 075603 STB EXPON 0281 10315 015715 JSB OUTCR OUTPUT SIGN 0282 10316 065603 LDB EXPON 0283 10317 060357 LDA .48 COMPUTE 0284 10320 044442 ADB M10 0285 10321 006020 SSB EXPONENT 0286 10322 026325 JMP *+3 0287 10323 002004 INA DIGIT 0288 10324 026320 JMP *-4 0289 10325 044361 ADB .58 COMPUTE 0290 10326 075603 STB EXPON SECOND DIGIT 0291 10327 015715 JSB OUTCR OUTPUT 0292 10330 061603 LDA EXPON 0293 10331 015715 JSB OUTCR EXPONENT 0294 10332 126040 JMP NUMOT,I 0295 10333 016370 EOUT9 JSB RETCR RETRIEVE CHARACTER 0296 10334 050357 CPA .48 ZERO? 0297 10335 026340 JMP EOU10 YES 0298 10336 015715 JSB OUTCR NO, RESTORE CHARACTER 0299 10337 126040 JMP NUMOT,I 0300 10340 060345 EOU10 LDA .32 OVERLAY 0301 10341 015715 JSB OUTCR A BLANK 0302 10342 016370 JSB RETCR BACKSPACE 0303 10343 026333 JMP EOUT9 PAGE 0114 #08 EXECUTE THE PROGRAM 0305** 0306*** GET DIGIT TO OUTPUT ** 0307** 0308 10344 000000 GETDG NOP 0309 10345 015147 JSB MBY10 MULTIPLY BY 10 0310 10346 064154 LDB EXP GET EXPONENT IN (B) 0311 10347 007004 CMB,INB AS NEGATIVE 0312 10350 010430 AND HIMSK KEEP 5 HIGH BITS OF (A) 0313 10351 001200 RAL NORMALIZE TO BIT 15 0314 10352 006024 SSB,INB ROTATE INTEGER 0315 10353 026351 JMP *-2 INTO (A) 0316 10354 010376 AND MSK0 EXTRACT 0317 10355 070615 STA NUMCK DIGIT 0318 10356 064154 LDB EXP ROTATE 0319 10357 007004 CMB,INB 0320 10360 001300 RAR BACK 0321 10361 006024 SSB,INB 0322 10362 026360 JMP *-2 0323 10363 021274 XOR MANT1 REMOVE 0324 10364 065336 LDB MANT2 DIGIT 0325 10365 015113 JSB NORML NORMALIZE REMAINDER 0326 10366 060615 LDA NUMCK LOAD (A) WITH DIGIT 0327 10367 126344 JMP GETDG,I 0328** 0329*** RETRIEVE CHARACTER FROM OUTPUT BUFFER ** 0330** 0331 10370 000000 RETCR NOP 0332 10371 064133 LDB CCNT DECREMENT 0333 10372 044431 ADB M1 CHARACTER 0334 10373 074133 STB CCNT COUNT 0335 10374 160132 LDA BADDR,I POSITION 0336 10375 006011 SLB,RSS AND 0337 10376 001727 ALF,ALF EXTRACT 0338 10377 010376 AND MSK0 CHARACTER 0339 10400 004010 SLB FIRST CHARACTER OF WORD? 0340 10401 126370 JMP RETCR,I NO 0341 10402 064132 LDB BADDR YES, DECREMENT 0342 10403 044431 ADB M1 BUFFER 0343 10404 074132 STB BADDR POINTER 0344 10405 126370 JMP RETCR,I 0345* 0346* 0347 06074 A1 EQU SETDP 0348 06105 A2 EQU STSRH 0349 06147 C1 EQU FLWST 0350 06163 C2 EQU FVSRH PAGE 0115 #08 LIBRARY ROUTINES 0352* ****************************** 0353* SUBROUTINE TO CALCULATE TAN(X) 0354* ****************************** 0355* 0356* CALLED BY A JMP ETAN WITH THE ARGUMENT 0357* IN FLOATING RADIANS IN THE REGISTERS. 0358* THE FLOATING RESULT IS RETURNED IN A & B 0359* 0360 10406 114240 ETAN JSB .FMPA,I 0361 10407 010475 DEF FOPI 4/PI 0362 10410 072501 STA XTEMP 0363 10411 076502 STB XTEMP+1 0364 10412 114236 JSB .FADA,I 0365 10413 010477 DEF K1 0366 10414 017440 JSB .PWR2 0367 10415 177776 DEC -2 0368 10416 017413 JSB .IENT 0369 10417 014477 JSB ERROR 0370 10420 017432 TRGER JSB FLOAT 0371 10421 015423 JSB ARINV 0372 10422 017440 JSB .PWR2 0373 10423 000002 DEC 2 0374 10424 114236 JSB .FADA,I 0375 10425 010501 DEF XTEMP 0376 10426 072501 STA XTEMP 0377 10427 076502 STB XTEMP+1 X=X-4*ENTIER((X+1)/4) 0378 10430 114237 JSB .FSBA,I 0379 10431 010477 DEF K1 0380 10432 073032 STA SBOX TEMPORARY 0381 10433 002020 SSA X<1? 0382 10434 026467 JMP ELSE1 YES 0383 10435 062507 LDA K2 NO 0384 10436 066510 LDB K2+1 0385 10437 114237 JSB .FSBA,I 0386 10440 010501 DEF XTEMP 0387 10441 072503 BOTH1 STA YTEMP 0388 10442 076504 STB YTEMP+1 Y= 2-X 0389 10443 114240 JSB .FMPA,I 0390 10444 010503 DEF YTEMP 0391 10445 114240 JSB .FMPA,I 0392 10446 010507 DEF K2 0393 10447 114237 JSB .FSBA,I 0394 10450 010477 DEF K1 0395 10451 017324 JSB .CHEB 0396 10452 010511 DEF COEFF 0397 10453 114240 JSB .FMPA,I 0398 10454 010503 DEF YTEMP 0399 10455 072503 STA YTEMP 0400 10456 076504 STB YTEMP+1 Y=Y*CHEBY(2*Y**2-1) 0401 10457 063032 LDA SBOX 0402 10460 002020 SSA X<1 ? 0403 10461 026472 JMP ELSE2 YES 0404 10462 062477 LDA K1 0405 10463 066500 LDB K1+1 0406 10464 114241 JSB .FDVA,I 0407 10465 010503 DEF YTEMP PAGE 0116 #08 LIBRARY ROUTINES 0408 10466 124264 JMP FR12A,I ANS = 1/Y 0409 10467 062501 ELSE1 LDA XTEMP 0410 10470 066502 LDB XTEMP+1 0411 10471 026441 JMP BOTH1 Y=X 0412 10472 062503 ELSE2 LDA YTEMP 0413 10473 066504 LDB YTEMP+1 0414 10474 124264 JMP FR12A,I ANS = Y 0415* 0416 10475 050574 FOPI DEC 1.273239545 4/PI 0417 10477 040000 K1 DEC 1. 0418 10501 000000 XTEMP BSS 2 0419 10503 000000 YTEMP BSS 2 0420 10505 000000 UTEMP BSS 2 0421 10507 040000 K2 DEC 2. 0422 10511 076061 COEFF DEC 1.4458E-8 0423 10513 066034 DEC 2.013766E-7 0424 10515 057035 DEC 2.804816E-6 0425 10517 050755 DEC 3.906637E-5 0426 10521 043523 DEC 5.4417038E-4 0427 10523 076112 DEC 7.586101578E-3 0428 10525 066520 DEC .10675392857 0429 10527 070512 DEC 1.7701474227 0430 10531 000000 OCT 0 PAGE 0117 #08 LIBRARY ROUTINES 0432* ****************************** 0433* SUBROUTINE TO CALCULATE ATN(X) 0434* ****************************** 0435* 0436* CALLED BY A JMP EATN WITH THE ARGUMENT 0437* IN FLOATING POINT FORM IN THE REGISTERS. 0438* THE FLOATING RESULT IN THE RANGE -PI/2 0439* TO PI/2 IS RETURNED IN A & B 0440* 0441 10532 072501 EATN STA XTEMP 0442 10533 076502 STB XTEMP+1 0443 10534 060001 LDA 1 0444 10535 010376 AND MSK0 0445 10536 073032 STA SBOX TAN = EXP OF (X) 0446 10537 002002 SZA 0447 10540 000010 SLA ABS (X) > 1 ? 0448 10541 026576 JMP ELS1 NO 0449 10542 062477 LDA K1 0450 10543 066500 LDB K1+1 0451 10544 114241 JSB .FDVA,I 0452 10545 010501 DEF XTEMP U=1/X 0453 10546 072505 BTH1 STA UTEMP 0454 10547 076506 STB UTEMP+1 0455 10550 114240 JSB .FMPA,I 0456 10551 010505 DEF UTEMP 0457 10552 114240 JSB .FMPA,I 0458 10553 010507 DEF K2 0459 10554 114237 JSB .FSBA,I 0460 10555 010477 DEF K1 0461 10556 017324 JSB .CHEB 0462 10557 010615 DEF COEF 0463 10560 114240 JSB .FMPA,I 0464 10561 010505 DEF UTEMP 0465 10562 072503 STA YTEMP 0466 10563 076504 STB YTEMP+1 Y=U*CHEBY(2*U**2-1) 0467 10564 063032 LDA SBOX 0468 10565 002002 SZA 0469 10566 000010 SLA ABS(X)>1 ? 0470 10567 026601 JMP ELS2 NO 0471 10570 062501 LDA XTEMP 0472 10571 002020 SSA X= 15 0022 10661 017432 JSB FLOAT 0023 10662 114240 JSB .FMPA,I 0024 10663 010721 DEF MM4 0025 10664 114236 JSB .FADA,I 0026 10665 010501 DEF XTEMP 0027 10666 072501 STA XTEMP 0028 10667 076502 STB XTEMP+1 X=X-4*ENTIER((X+1)/4) 0029 10670 114237 JSB .FSBA,I 0030 10671 010477 DEF K1 0031 10672 002020 SSA X<1 ? 0032 10673 026702 JMP PAST YES 0033 10674 062507 LDA K2 0034 10675 066510 LDB K2+1 0035 10676 114237 JSB .FSBA,I 0036 10677 010501 DEF XTEMP 0037 10700 072501 STA XTEMP 0038 10701 076502 STB XTEMP+1 X=2-X 0039 10702 062501 PAST LDA XTEMP 0040 10703 066502 LDB XTEMP+1 0041 10704 114240 JSB .FMPA,I 0042 10705 010501 DEF XTEMP 0043 10706 017440 JSB .PWR2 0044 10707 000001 DEC 1 0045 10710 114237 JSB .FSBA,I 0046 10711 010477 DEF K1 0047 10712 017324 JSB .CHEB 0048 10713 010723 DEF COEF1 0049 10714 114240 JSB .FMPA,I 0050 10715 010501 DEF XTEMP 0051 10716 124264 JMP FR12A,I ANS=X+CHEBYI2*X**2-1) 0052* 0053 10717 050574 TOPI DEC .636619772 2/PI 0054 10721 100000 MM4 DEC -4. 0055 10723 047605 COEF1 DEC 1.18496E-6 0056 10725 134143 DEC -1.365875E-4 0057 10727 045261 DEC 9.118016E-3 PAGE 0120 #09 LIBRARY ROUTINES 0058 10731 133371 DEC -.2852615692 0059 10733 050656 DEC 2.5525579248 0060 10735 000000 OCT 0 0062* ***************************** 0063* SUSROUTINE TO COMPUTE RND(X) 0064* ***************************** 0065* 0066* THE ARGUMENT OF RND IS A DUMMY ONE 0067* THE ROUTINE GENERATES A RANDOM NUMBER 0068* IN THE A & B REGISTERS 0069* 0070* R=X/M, X=C*X MOD M, M=2^31, C=2^15 + 3 0071* 0072 10736 002400 ERND CLA X IS INITIALLY 1 0073 10737 070154 STA EXP INITIALIZE EXPONENT 0074 10740 060155 LDA XH COMPUTE 0075 10741 001000 ALS HIGH 0076 10742 040155 ADA XH PART 0077 10743 064156 LDB XL 2*XH 0078 10744 004065 CLE,ERB + XH + 0079 10745 040001 ADA 1 XL*2^15 0080 10746 064156 LDB XL 0081 10747 005275 RBL,CLE,SLB,ERB ADD XL[15] TO 0082 10750 002004 INA (A) (FROM 2*XL) 0083 10751 004066 CLE,ELB 2*XL 0084 10752 044156 ADB XL + XL 0085 10753 001675 ELA,CLE,SLA,ERA ADD OVERFLOW 0086 10754 002104 CLE,INA TO (A) 0087 10755 044470 ADB FLGBT ADD IN TRAILING BIT OF XL*2^15 0088 10756 002040 SEZ ADD OVERFLOW 0089 10757 002004 INA TO (A) 0090 10760 001665 ELA,CLE,ERA ERASE A[15] 0091 10761 070155 STA XH STORE 0092 10762 074156 STB XL INTEGER 0093 10763 015020 JSB .PACK NORMALIZE AND PACK 0094 10764 124264 JMP FR12A,I PAGE 0121 #09 LIBRARY ROUTINES 0096* ****************************** 0097* SUBROUTINE TO CALCULATE SQR(X) 0098* ****************************** 0099* 0100* CALLED BY A JMP ESQR WITH THE ARGUMENT 0101* IN FLOATING POINT FORM IN THE REGISTERS. 0102* THE FLOATING RESULT IS RETURNED IN A & B 0103* 0104 10765 002003 ESQR SZA,RSS X=0 ? 0105 10766 124264 JMP FR12A,I YES, ANS = 0 0106 10767 002020 SSA X0 THEN +1. 0258* IF X=0 THEN 0 0259* IF X<0 THEN -1. 0260* 0261 11166 006400 ESGN CLB 0262 11167 002003 SZA,RSS ZERO? 0263 11170 124264 JMP FR12A,I YES 0264 11171 002021 SSA,RSS NO, POSITIVE? 0265 11172 064325 LDB .2 YES, SET EXPONENT 0266 11173 060470 LDA FLGBT LOAD MANTISSA 0267 11174 006002 SZB POSITIVE? 0268 11175 001300 RAR YES, CORRECT MANTISSA 0269 11176 124264 JMP FR12A,I PAGE 0125 #09 LIBRARY ROUTINES 0271* ****************************** 0272* SUBROUTINE TO CALCULATE EXP(X) 0273* ****************************** 0274* 0275* CALLED BY A JMP EEXP WITH THE ARGUMENT 0276* IN FLOATING POINT FORM IN THE REGISTERS. 0277* THE FLOATING RESULT IS RETURNED IN A & B 0278* 0279 11177 017201 EEXP JSB .EXP 0280 11200 124264 JMP FR12A,I 0281 11201 000000 .EXP NOP 0282 11202 114240 JSB .FMPA,I 0283 11203 011322 DEF L2E 0284 11204 072501 STA XTEMP 0285 11205 076502 STB XTEMP+1 X=Z*LOG2(E) 0286 11206 017413 JSB .IENT 0287 11207 027301 JMP .EXP1 0288 11210 073274 STA INTE INTE = ENTIER(X) 0289 11211 017432 JSB FLOAT 0290 11212 072503 STA YTEMP 0291 11213 076504 STB YTEMP+1 Y=ENTIER(X) 0292 11214 063274 LDA INTE 0293 11215 043310 ADA M124 0294 11216 002021 SSA,RSS INTE >=124 ? 0295 11217 027304 JMP EXPER-1 YES,ERROR 0296 11220 043311 ADA .244 INTE <-120 ? 0297 11221 002020 SSA 0298 11222 027276 JMP ZERE YES,ANS=0 0299 11223 062501 LDA XTEMP 0300 11224 066502 LDB XTEMP+1 0301 11225 114237 JSB .FSBA,I 0302 11226 010503 DEF YTEMP 0303 11227 072501 STA XTEMP 0304 11230 076502 STB XTEMP+1 X=X-ENTIER(X) 0305 11231 114240 JSB .FMPA,I 0306 11232 010501 DEF XTEMP 0307 11233 072505 STA UTEMP 0308 11234 076506 STB UTEMP+1 U=X**2 0309 11235 114236 JSB .FADA,I 0310 11236 011312 DEF AAAA 0311 11237 072503 STA YTEMP 0312 11240 076504 STB YTEMP+1 Y=X**2+AAAA 0313 11241 063314 LDA BBBB 0314 11242 067315 LDB BBBB+1 0315 11243 114241 JSB .FDVA,I 0316 11244 010503 DEF YTEMP 0317 11245 072503 STA YTEMP 0318 11246 076504 STB YTEMP+1 Y=BBBB/Y 0319 11247 063316 LDA CCCC 0320 11250 067317 LDB CCCC+1 0321 11251 114240 JSB .FMPA,I 0322 11252 010505 DEF UTEMP 0323 11253 114236 JSB .FADA,I 0324 11254 011320 DEF DDDD 0325 11255 114237 JSB .FSBA,I 0326 11256 010501 DEF XTEMP PAGE 0126 #09 LIBRARY ROUTINES 0327 11257 114237 JSB .FSBA,I 0328 11260 010503 DEF YTEMP 0329 11261 072503 STA YTEMP 0330 11262 076504 STB YTEMP+1 Y=-X+DDDD+CCCC*X**2-Y 0331 11263 062501 LDA XTEMP 0332 11264 066502 LDB XTEMP+1 0333 11265 114241 JSB .FDVA,I 0334 11266 010503 DEF YTEMP 0335 11267 114236 JSB .FADA,I 0336 11270 000466 DEF HALF 0337 11271 037274 ISZ INTE 0338 11272 000000 NOP 0339 11273 017440 JSB .PWR2 0340 11274 000000 INTE OCT 0 0341 11275 127201 JMP .EXP,I ANS=(0.5+X/Y)*2**INTE 0342 11276 002400 ZERE CLA 0343 11277 006400 CLB 0344 11300 127201 JMP .EXP,I ANS=0 0345 11301 063401 .EXP1 LDA X2TMP 0346 11302 002020 SSA 0347 11303 027276 JMP ZERE 0348 11304 014477 JSB ERROR 0349 11305 060422 EXPER LDA INF 0350 11306 064432 LDB M2 0351 11307 127201 JMP .EXP,I 0352* 0353 11310 177604 M124 DEC -124 0354 11311 000364 .244 DEC 244 0355 11312 053552 AAAA DEC 87.417497202 0356 11314 046477 BBBB DEC 617.9722695 0357 11316 043372 CCCC DEC .03465735903 0358 11320 047643 DDDD DEC 9.9545957821 0359 11322 056125 L2E DEC 1.4426950409 PAGE 0127 #09 LIBRARY ROUTINES 0361* ****************************** 0362* SUBROUTINE TO COMPUTE CHEBY(X) 0363* ****************************** 0364* 0365* CALLING SEQUENCE: 0366* 0367* LDA X (FLOATING) 0368* LDB X+1 0369* JSB .CHEB (RESULT FLOATING) 0370* DEF C (TABLE OF CHEBY.COEFFS.,FLOATING) 0371* 0372 11324 000000 .CHEB NOP 0373 11325 114240 JSB .FMPA,I 0374 11326 010507 DEF K2 0375 11327 073401 STA X2TMP 0376 11330 077402 STB X2TMP+1 X2 =X*2 0377 11331 167324 LDB .CHEB,I 0378 11332 077407 STB CTMP C POINTS TO COEFFICIENT TABLE 0379 11333 160001 LDA 1,I 0380 11334 006004 INB 0381 11335 164001 LDB 1,I GET FIRST COEFF 0382 11336 073411 STA DTMP 0383 11337 077412 STB DTMP+1 D=C(N) 0384 11340 002400 CLA 0385 11341 073405 STA BTMP 0386 11342 073406 STA BTMP+1 B=0 0387 11343 037407 LOPC ISZ CTMP 0388 11344 037407 ISZ CTMP N=N-1 0389 11345 163407 LDA CTMP,I 0390 11346 002003 SZA,RSS C(N)=0 ? 0391 11347 027371 JMP COUT ZERO FLAGS END OF TABLE 0392 11350 063405 LDA BTMP NO 0393 11351 067406 LDB BTMP+1 0394 11352 073403 STA ATMP 0395 11353 077404 STB ATMP+1 A=B 0396 11354 063411 LDA DTMP 0397 11355 067412 LDB DTMP+1 0398 11356 073405 STA BTMP 0399 11357 077406 STB BTMP+1 B=D 0400 11360 114240 JSB .FMPA,I 0401 11361 011401 DEF X2TMP 0402 11362 114237 JSB .FSBA,I 0403 11363 011403 DEF ATMP 0404 11364 114236 JSB .FADA,I 0405 11365 111407 DEF CTMP,I 0406 11366 073411 STA DTMP 0407 11367 077412 STB DTMP+1 D=C(N) -A+B*X2 0408 11370 027343 JMP LOPC 0409 11371 063411 COUT LDA DTMP 0410 11372 067412 LDB DTMP+1 0411 11373 114237 JSB .FSBA,I 0412 11374 011403 DEF ATMP 0413 11375 114240 JSB .FMPA,I 0414 11376 000466 DEF HALF 0415 11377 037324 ISZ .CHEB 0416 11400 127324 JMP .CHEB,I ANS=(D-A)/2 PAGE 0128 #09 LIBRARY ROUTINES 0417* 0418 11401 000000 X2TMP BSS 2 0419 11403 000000 ATMP BSS 2 0420 11405 000000 BTMP BSS 2 0421 11407 000000 CTMP BSS 2 0422 11411 000000 DTMP BSS 2 0424* ******************************************** 0425* SUBROUTINE TO COMPUTE THE ENTIER OF A NUMBER 0426* WHOSE EXPONENT IS LESS THAN 15 0427* ******************************************** 0428* 0429* CALLING SEQUENCE: 0430* 0431* LDA X (FLOATING) 0432* LDA X+1 0433* JSB .IENT. (RESULT INTERGER) 0434* JSB ERROR (EXIT IF EXPO(X)>14) 0435* 0436* 0437 11413 000000 .IENT NOP 0438 11414 073401 STA X2TMP STORE HIGH PART 0439 11415 060001 LDA 1 MOVE LOW PART TO A 0440 11416 010376 AND MSK0 ISOLATE EXPONENT 0441 11417 000033 SLA,RAR 0442 11420 027424 JMP *+4 IF NEGATIVE OK 0443 11421 040444 ADA M15 0444 11422 002021 SSA,RSS EXPO(X) > 14 0445 11423 127413 JMP .IENT,I YES, ERROR RETURN 0446 11424 037413 ISZ .IENT NO BUMP RETURN POINT 0447 11425 063401 LDA X2TMP RESTORE HIGH PART 0448 11426 015364 JSB IFIX CALL ENTIER 0449 11427 000000 NOP 0450 11430 060001 LDA 1 PUT RESULT INTO (A) 0451 11431 127413 JMP .IENT,I PAGE 0129 #09 LIBRARY ROUTINES 0453* ****************************** 0454* SUBROUTINE TO FLOAT AN INTEGER 0455* ****************************** 0456* 0457* CALLED BY JSB FLOAT WITH INTEGER IN A 0458* THE FLUATING POINT EQUIVALENT IS RETURNED 0459* IN A & B 0460* 0461 11432 000000 FLOAT NOP 0462 11433 064336 LDB .15 0463 11434 074154 STB EXP 0464 11435 006400 CLB 0465 11436 015020 JSB .PACK 0466 11437 127432 JMP FLOAT,I 0468* **************************************** 0469* SUBROUTINE TO MULTIPLY BY A POWER OF TWO 0470* **************************************** 0471* 0472* CALLING SEQUENCE 0473* 0474* LDA X (FLOATING) 0475* LDB X+1 0476* JSB .RWR2 (RESULT FLOATING) 0477* DEC N (INTEGER POWER) 0478* 0479* RETURNS WITH X*2^N IN A&B 0480* NO CHECK IS MADE FOR EXPONENT 0481* OVERFLOW OR UNDERFLOW 0482* 0483 11440 000000 .PWR2 NOP 0484 11441 002003 SZA,RSS X=0 ? 0485 11442 027454 JMP .RET YES, ANS=0 0486 11443 073401 STA X2TMP 0487 11444 015456 JSB .FLUN 0488 11445 077402 STB X2TMP+1 0489 11446 143440 ADA .PWR2,I 0490 11447 001200 RAL 0491 11450 010376 AND MSK0 NEW EXPO = (OLD EXPO) +N 0492 11451 070001 STA 1 0493 11452 047402 ADB X2TMP+1 KEEP OLD MANTISSA 0494 11453 063401 LDA X2TMP 0495 11454 037440 .RET ISZ .PWR2 0496 11455 127440 JMP .PWR2,I 0498 07463 TT1 EQU .FDV 0499 07552 TT2 EQU IDIV 0500 00163 TT3 EQU TEMPS+4 0501 00164 TT4 EQU TEMPS+5 0502 11032 FFLAG EQU SBOX PAGE 0130 #10 MATRIX ROUTINES 0002* ***************************** 0003* MATRIX STMT EXECUTION CONTROL 0004* ***************************** 0005 11456 160157 EMAT LDA TEMPS,I 0006 11457 034157 ISZ TEMPS MAT READ 0007 11460 010401 AND MSK1 OR 0008 11461 002002 SZA MAT PRINT? 0009 11462 027610 JMP EMAT7 NO 0010 11463 160157 LDA TEMPS,I YES 0011 11464 010420 AND OPMSK SAVE 0012 11465 070171 STA MLBX1 TYPE 0013 11466 050416 CPA RDOP PRINT? 0014 11467 002001 RSS NO 0015 11470 114250 JSB PRNIA,I YES 0016* 0017 11471 160157 EMAT1 LDA TEMPS,I LOAD 0018 11472 010401 AND MSK1 OPERAND 0019 11473 002003 SZA,RSS NULL? (END OF MAT PRINT) 0020 11474 124256 JMP XEC4A,I YES 0021 11475 114231 JSB SSYMA,I NO, SEARCH SYMBOL TABLE 0022 11476 006007 INB,SZB,RSS FOUND? 0023 11477 124267 JMP E8M1A,I NO 0024 11500 034157 ISZ TEMPS YES 0025 11501 160001 LDA 1,I SAVE ARRAY 0026 11502 070173 STA B1 BASE ADDRESS 0027 11503 060171 LDA MLBX1 0028 11504 050416 CPA RDOP READ? 0029 11505 027561 JMP EMAT5 YES 0030 11506 044325 ADB .2 NO 0031 11507 160001 LDA 1,I SAVE 0032 11510 070174 STA B1+1 DIMENSIONS 0033 11511 010376 AND MSK0 SET 0034 11512 003004 CMA,INA COLUMN 0035 11513 070175 STA B2 COUNTERS 0036 11514 070176 STA B2+1 0037 11515 160001 LDA 1,I SET 0038 11516 001727 ALF,ALF 0039 11517 010376 AND MSK0 ROW 0040 11520 003004 CMA,INA 0041 11521 070177 STA B3 COUNTER 0042 11522 114255 JSB LCK2A,I ENSURE ARRAY IS DEFINED 0043 11523 002400 CLA SET DELIMITER 0044 11524 073767 STA MCKS AS COMMA 0045 11525 060157 LDA TEMPS MORE 0046 11526 050143 CPA PRADD STATEMENT? 0047 11527 027540 JMP EMAT3 NO 0048 11530 160157 LDA TEMPS,I YES 0049 11531 010420 AND OPMSK EXTRACT DELIMITER 0050 11532 050404 CPA B3000 SEMICOLON? 0051 11533 037767 ISZ MCKS YES 0052 11534 027540 JMP EMAT3 0053 11535 006400 EMAT2 CLB COMMA 0054 11536 057767 CPB MCKS DELIMETER? 0055 11537 015656 JSB EDELM YES 0056 11540 160173 EMAT3 LDA B1,I LOAD 0057 11541 034173 ISZ B1 NEXT PAGE 0131 #10 MATRIX ROUTINES 0058 11542 164173 LDB B1,I ELEMENT 0059 11543 034173 ISZ B1 0060 11544 015643 JSB ENOUT OUTPUT IT 0061 11545 034175 ISZ B2 ROW COMPLETE? 0062 11546 027535 JMP EMAT2 NO 0063 11547 015677 JSB OUTLN YES, DO 0064 11550 015677 JSB OUTLN SPACING 0065 11551 060176 LDA B2+1 RESET 0066 11552 070175 STA B2 COLUMN COUNTER 0067 11553 034177 ISZ B3 ARRAY EXHAUSTED? 0068 11554 027540 JMP EMAT3 NO 0069 11555 064157 EMAT4 LDB TEMPS YES, MORE 0070 11556 054143 CPB PRADD STATEMENT? 0071 11557 124256 JMP XEC4A,I NO 0072 11560 027471 JMP EMAT1 YES 0073* 0074 11561 074175 EMAT5 STB B2 SAVE SYMBOL TABLE POINTER 0075 11562 160157 LDA TEMPS,I EXTRACT 0076 11563 010420 AND OPMSK NEXT OPERATOR 0077 11564 064157 LDB TEMPS STATEMENT 0078 11565 054143 CPB PRADD EXHAUSTED? 0079 11566 002400 CLA YES 0080 11567 050412 CPA B2200 'I' ? 0081 11570 017732 JSB REDIM YES, REDIMENSION ARRAY 0082 11571 060175 LDA B2 LOAD 0083 11572 040325 ADA .2 ARRAY 0084 11573 160000 LDA 0,I DIMENSIONS 0085 11574 015336 JSB MDIM SET 0086 11575 001100 ARS ARRAY 0087 11576 003004 CMA,INA ELEMENT 0088 11577 070177 STA B3 COUNTER 0089 11600 114254 EMAT6 JSB FDAT,I FETCH VALUE 0090 11601 170173 STA B1,I STORE 0091 11602 034173 ISZ B1 0092 11603 174173 STB B1,I IT 0093 11604 034173 ISZ B1 0094 11605 034177 ISZ B3 ARRAY EXHAUSTED? 0095 11606 027600 JMP EMAT6 NO 0096 11607 027555 JMP EMAT4 YES 0097* 0098 11610 114231 EMAT7 JSB SSYMA,I SAVE 0099 11611 006004 INB BASE ADDRESS 0100 11612 160001 LDA 1,I OF DESTINATION 0101 11613 070177 STA B3 ARRAY 0102 11614 074175 STB B2 SAVE SYMBOL TABLE ADDRESS 0103 11615 044325 ADB .2 SAVE 0104 11616 160001 LDA 1,I ITS 0105 11617 070200 STA B3+1 DIMENSIONS 0106 11620 002404 CLA,INA ASSUME MAT 0107 11621 071656 STA EDELM REPLACEMENT 0108 11622 160157 EMAT0 LDA TEMPS,I LOAD NEXT 0109 11623 034157 ISZ TEMPS OPERAND 0110 11624 002020 SSA ARRAY FUNCTION? 0111 11625 027711 JMP EMA11 YES 0112 11626 010401 EMAT8 AND MSK1 NO 0113 11627 002003 SZA,RSS SCALAR MULTIPLICATION? PAGE 0132 #10 MATRIX ROUTINES 0114 11630 027701 JMP EMA10 YES 0115 11631 114231 JSB SSYMA,I NO 0116 11632 006004 INB SAVE 0117 11633 160001 LDA 1,I BASE 0118 11634 070173 STA B1 ADDRESS AND 0119 11635 044325 ADB .2 DIMENSIONS 0120 11636 160001 LDA 1,I OF FIRST 0121 11637 070174 STA B1+1 SOURCE ARRAY 0122 11640 064157 LDB TEMPS STATEMENT 0123 11641 054143 CPB PRADD EXHAUSTED? 0124 11642 027662 JMP EMAT9 YES 0125 11643 160157 LDA TEMPS,I NO 0126 11644 001100 ARS EXTRACT 0127 11645 001727 ALF,ALF AND 0128 11646 010362 AND .63 RECORD 0129 11647 040436 ADA M6 EMAT 0130 11650 071656 STA EDELM OPERATOR 0131 11651 160157 LDA TEMPS,I SAVE 0132 11652 010401 AND MSK1 0133 11653 114231 JSB SSYMA,I BASE ADDRESS 0134 11654 006004 INB 0135 11655 160001 LDA 1,I AND DIMENSIONS 0136 11656 070175 STA B2 0137 11657 044325 ADB .2 OF SECOND 0138 11660 160001 LDA 1,I 0139 11661 070176 STA B2+1 SOURCE ARRAY 0140* 0141 11662 061656 EMAT9 LDA EDELM TRANSFER TO 0142 11663 043666 ADA LMAP APPROPRIATE 0143 11664 114000 JSB 0,I ROUTINE 0144 11665 124256 JMP XEC4A,I 0145* 0146 11666 111666 LMAP DEF LBASE-1,I 0147 11667 012123 LBASE DEF REPLC 0148 11670 012103 DEF ADD 0149 11671 012116 DEF SUB 0150 11672 012331 DEF MULT 0151 11673 012170 DEF SZER 0152 11674 012145 DEF LCON 0153 11675 012176 DEF LIDN 0154 11676 012441 DEF LINV 0155 11677 012266 DEF TRAN 0156 11700 012137 DEF SMULT 0157* 0158 11701 060334 EMA10 LDA .10 SET 8MULT 0159 11702 071656 STA EDELM OPERATOR 0160 11703 114232 JSB FETCA,I EVALUATE 0161 11704 070171 STA MLBX1 AND SAVE 0162 11705 074172 STB MLBX1+1 SCALAR 0163 11706 034157 ISZ TEMPS GO TO 0164 11707 034157 ISZ TEMPS PROCESS 0165 11710 027622 JMP EMAT0 SOURCE ARRAY 0166* 0167 11711 001727 EMA11 ALF,ALF EXTRACT 0168 11712 001700 ALF 0169 11713 010344 AND .31 TYPE PAGE 0133 #10 MATRIX ROUTINES 0170 11714 040440 ADA M8 RECORD EMAT 0171 11715 071656 STA EDELM OFERATOR TYPE 0172 11716 040440 ADA M8 INV OR 0173 11717 002020 SSA TRN? 0174 11720 027725 JMP EMA12 NO 0175 11721 160157 LDA TEMPS,I YES, LOAD 0176 11722 034157 ISZ TEMPS SOURCE 0177 11723 034157 ISZ TEMPS ARRAY 0178 11724 027626 JMP EMAT8 SYMBOL 0179* 0180 11725 064157 EMA12 LDB TEMPS REDIMENSIONING 0181 11726 054143 CPB PRADD PART? 0182 11727 027662 JMP EMAT9 NO 0183 11730 017732 JSB REDIM YES 0184 11731 027662 JMP EMAT9 0186* ******************************* 0187* SUBROUTINE TO REDIMENSION ARRAY 0188* ******************************* 0189 11732 000000 REDIM NOP 0190 11733 017767 JSB MCKS EVALUATE 0191 11734 005727 BLF,BLF AND SAVE 0192 11735 074200 STB B3+1 ROW COUNT 0193 11736 006404 CLB,INB LOAD DEFAULT COLUMN COUNT 0194 11737 034157 ISZ TEMPS SINGLE 0195 11740 160157 LDA TEMPS,I DIMENSION 0196 11741 010420 AND OPMSK ARRAY? 0197 11742 050407 CPA LF 0198 11743 027746 JMP REDI1 YES 0199 11744 017767 JSB MCKS NO, EVALUATE COLUMN COUNT 0200 11745 034157 ISZ TEMPS MOVE PAST 0201 11746 034157 REDI1 ISZ TEMPS RIGHT BRACKET 0202 11747 044200 ADB B3+1 PACK 0203 11750 074200 STB B3+1 DIMENSIONS 0204 11751 060175 LDA B2 STORE IN 0205 11752 040325 ADA .2 SYMBOL 0206 11753 174000 STB 0,I TABLE 0207 11754 040431 ADA M1 COMPUTE 0208 11755 160000 LDA 0,I PHYSICAL 0209 11756 015336 JSB MDIM ARRAY SPACE 0210 11757 070172 STA MLBX1+1 SIZE 0211 11760 060200 LDA B3+1 COMPUTE 0212 11761 015336 JSB MDIM NEW SIZE 0213 11762 003004 CMA,INA NEW 0214 11763 040172 ADA MLBX1+1 SIZE 0215 11764 002020 SSA ACCEPTABLE? 0216 11765 014477 JSB ERROR NO 0217 11766 127732 E7 JMP REDIM,I YES PAGE 0134 #10 MATRIX ROUTINES 0219* ****************************************** 0220* SUBROUTINE TO EVALUATE & CHECK A SUBSCRIPT 0221* ****************************************** 0222 11767 000000 MCKS NOP 0223 11770 114232 JSB FETCA,I CALL FOR EVALUATION 0224 11771 015353 JSB SBFIX CONVERT TO INTEGER (ROUNDED) 0225 11772 006004 INB UNBIAS SUBSCRIPT 0226 11773 060001 LDA 1 PUT INTO (A) 0227 11774 040460 ADA M256 LESS THAN 0228 11775 002021 SSA,RSS 256? 0229 11776 124272 JMP E6M1A,I NO 0230 11777 127767 JMP MCKS,I YES, RETURN SUBSCRIPT IN (B) PAGE 0135 #10 MATRIX ROUTINES 0232 12000 ORG 12000B 0233* 0234********************************************* 0235****** MATRIX ROUTINES ******** 0236********************************************* 0237*CALL FOR MATRIX OPERATION IS MADE WITH FOUR* 0238*PARAMETERS,ROUTINE NUMBER AND ADDRESS OF * 0239*SYMBOL TABLE OF THREE MATRICES. FOR SCALAR * 0240*MULT,LAST IS ADDRESS OF SCALAR VALUE * 0241*OPERATION IS OF FORM B3=B1 OP B2 * 0242*THE ADDRESS OF THE BASE ADDRESS OF MATRICES* 0243*IS GIVEN IN B1,B2,B3. THE DIMENSIONS OF A * 0244*MATRIX IS GIVEN IN B(I)+1, ROWS IN MOST SIG* 0245*PART(MSP) AND COLUMN IN LEAST SIG PART(LSP)* 0246********************************************* 0247* 0248* 0249* 0250********************************************* 0251*** SUBROUTINE GENERAL *** 0252********************************************* 0253*B3=B1 OP B2 SUBROUTINE COMPUTES AN ELEMENT* 0254*OF B3 AND INCREMENTS TO NEXT ELEMENT. THE * 0255*OPERATION THAT IS PERFORMED AND * 0256* THE MATRICES INCREMENTED ARE * 0257* MODIFIED BY ROUTINES ADD, SUB, REPL * 0258*SCALAR MULT, CON,ZERO,IDN. ROUTINE CHECKS * 0259*COMPATIBILITY OF THREE MATRICES USING SUB * 0260*COMPARE (PARAMETERS SUPPLIED IN REG A,B) * 0261********************************************* 0262* 0263 12000 000000 GENER NOP SUBROUTINE GENERAL 0264 12001 060176 LDA B2+1 LOAD DIM FOR MATRIX 2 0265 12002 064174 LDB B1+1 LOAD DIM FOR MATRIX 1 0266 12003 016032 JSB COMPR CHECKS ROW AND COL DIM 0267* ARE COMPATIBLE 0268 12004 060174 GEN2 LDA B1+1 LOAD DIM FOR MATRIX 1 0269 12005 064200 LDB B3+1 LOAD DIM FOR MATRIX 3 0270 12006 016032 JSB COMPR CHECK ROW AND COL DIM 0271 12007 015236 JSB MPY COLUMNS IN (A) 0272 12010 013115 DEF T3 ROWS IN T3 0273 12011 003004 CMA,INA 0274 12012 073134 STA LPIV -ROWS*COLUMNS 0275* COMPUTES B3=B1 OP B2 0276 12013 160173 LOOP LDA B1,I LOAD 0277 12014 034173 ISZ B1 NEXT 0278 12015 164173 LDB B1,I SOURCE 0279 12016 034173 ISZ B1 ELEMENT 0280 12017 000000 MOD1 NOP USUALLY A JSB 0281 12020 000000 NOP USUALLY DEF B2,I 0282 12021 170177 STA B3,I STORE 0283 12022 034177 ISZ B3 NEXT 0284 12023 174177 STB B3,I DESTINATION 0285 12024 034177 ISZ B3 ELEMENT 0286 12025 000000 MOD2 NOP ISZ B2 FOR 0287 12026 000000 NOP MAT ADD OR SUB PAGE 0136 #10 MATRIX ROUTINES 0288 12027 037134 ISZ LPIV 0289 12030 026013 JMP LOOP COMPUTE NEXT ELEMENT 0290 12031 126000 JMP GENER,I 0291* 0292* 0293********************************************* 0294**** SUBROUTINE COMPARE **** 0295********************************************* 0296*ROUTINE COMPARES DIM OF TWO MATRICES GIVEN * 0297*THEIR DIM IN REGISTERS A,B * 0298*DIMENSIONS ARE GIVEN IN B(I)+2 * 0299********************************************* 0300* 0301 12032 000000 COMPR NOP 0302 12033 050001 CPA 1 EQUAL? 0303 12034 002001 RSS YES 0304 12035 014477 LERR JSB ERROR NO 0305 12036 001727 ALF,ALF SAVE 0306 12037 010376 AND MSK0 # OF 0307 12040 073115 STA T3 ROWS 0308 12041 060001 LDA 1 0309 12042 010376 AND MSK0 SAVE # 0310 12043 073116 STA T4 OF COLUMNS 0311 12044 126032 JMP COMPR,I 0312* 0313* 0314********************************************* 0315****** SUBROUTINE LCHK ****** 0316********************************************* 0317*TESTS THAT NO ELEMENT IN A MATRIX IS * 0318*UNASSIGNED. ENTRY1 CHECKS MATRICES GIVEN BY* 0319*B1 AND B2 AND ENTRY 2 CHECKS ONLY B1 * 0320********************************************* 0321* 0322 12045 000000 LCHK2 NOP 0323 12046 062045 LDA LCHK2 0324 12047 072051 STA LCHK1 0325 12050 026055 JMP *+5 0326 12051 000000 LCHK1 NOP 0327 12052 064175 LDB B2 BASE ADDR 0328 12053 060176 LDA B2+1 ROW AND COL DIM. 0329 12054 016061 JSB LCHK4 TEST EACH TERM OF B2 0330 12055 064173 LDB B1 BASE ADDR 0331 12056 060174 LDA B1+1 ROW AND COL DIM. 0332 12057 016061 JSB LCHK4 TEST EACH TERM OF B1 0333 12060 126051 JMP LCHK1,I 0334* 0335 12061 000000 LCHK4 NOP SUBROUTINE TO TEST TERMS 0336 12062 077120 STB T6 SAVE 0337 12063 015336 JSB MDIM COMPUTE SIZE OF MATRIX 0338 12064 001100 ARS SET NEGATIVE 0339 12065 003004 CMA,INA 0340 12066 073121 STA T7 COUNTER FOR ELEMENTS 0341 12067 163120 LCHK6 LDA T6,I LOAD 0342 12070 037120 ISZ T6 0343 12071 167120 LDB T6,I ELEMENT PAGE 0137 #10 MATRIX ROUTINES 0344 12072 037120 ISZ T6 0345 12073 050470 CPA MNEG COMPARE WITH PRESET QTY. 0346 12074 026076 JMP *+2 0347 12075 026100 JMP LCHK5 0348 12076 054471 CPB MNEG+1 0349 12077 014477 JSB ERROR ERROR 'MAT UNASSIGNED' 0350 12100 037121 LCHK5 ISZ T7 DONE? 0351 12101 026067 JMP LCHK6 NO 0352 12102 126061 JMP LCHK4,I YES 0353* 0354* 0355********************************************* 0356**** SUBROUTINE MAIRIX ADD **** 0357********************************************* 0358*B1,B2,B3 CONTAIN ADDRESS OF BASE ADDRESS OF* 0359*THREE MATRICES. ROUTINE EXECUTES B3=B1+B2 * 0360*BY MODIFYING INSTR IN ROUTINE GENERAL * 0361********************************************* 0362* 0363 12103 000000 ADD NOP 0364 12104 063135 LDA LPLUS JSB .FAD 0365 12105 072017 ADD1 STA MOD1 SET IN GENER 0366 12106 063136 LDA LPLUS+1 DEF OF B2,I 0367 12107 072020 STA MOD1+1 MODIFY ROUTINE GENERAL 0368 12110 063141 LDA INCB2 ISZ B2 0369 12111 072025 STA MOD2 0370 12112 072026 STA MOD2+1 0371 12113 016051 JSB LCHK1 TEST B1,B2 FOR UNASSIGNED TERMS 0372 12114 016000 JSB GENER ROUTINE GENERAL 0373 12115 126103 JMP ADD,I EXIT TO MAIN PROGRAM 0374* 0375* 0376********************************************* 0377**** SUBROUTINE MATRIX SUBTRACT **** 0378********************************************* 0379*B1,B2,B3 CONTAIN ADDRESS OF BASE ADDRESS OF* 0380*THREE MATRICES. ROUTINE EXECUTES B3=B1-B2 * 0381*BY MODIFYING INSTR IN ROUTINE GENERAL * 0382********************************************* 0383* 0384 12116 000000 SUB NOP LET 0385 12117 062116 LDA SUB ADD DO 0386 12120 072103 STA ADD RETURN 0387 12121 063137 LDA LMIN JSB .FSB 0388 12122 026105 JMP ADD1 PAGE 0138 #10 MATRIX ROUTINES 0390* 0391********************************************* 0392**** SUBROUTINE MATRIX REPLACE **** 0393********************************************* 0394*B1,B3 GIVE ADDRESS OF BASE ADDRESS OF GIVEN* 0395*MATRIX AND RECEIVING MATRIX RESPECTIVELY * 0396********************************************* 0397 12123 000000 REPLC NOP LET 0398 12124 062123 LDA REPLC GENER DO 0399 12125 072000 STA GENER RETURN 0400 12126 002400 CLA NO 0401 12127 006400 CLB OPERATION 0402 12130 072017 REPL1 STA MOD1 SET 0403 12131 076020 STB MOD1+1 OPERATION 0404 12132 002400 CLA B2 0405 12133 072025 STA MOD2 NOT 0406 12134 072026 STA MOD2+1 USED 0407 12135 016045 JSB LCHK2 TEST B1 FOR UNASSIGNED ELEMENTS 0408 12136 026004 JMP GEN2 0409* 0410* 0411********************************************* 0412**** SUBROUTINE MATRIX SCALAR MULT **** 0413********************************************* 0414*B1,B3 GIVE ADDRESS OF BASE ADDRESS OF GIVEN* 0415*MATRIX AND RECEIVING MATRIX RESPECTIVELY * 0416*MBXL HOLDS ADDRESS OF SCALAR VALUE * 0417********************************************* 0418* 0419 12137 000000 SMULT NOP LET 0420 12140 062137 LDA SMULT GENER DO 0421 12141 072000 STA GENER RETURN 0422 12142 063140 LDA LTIME SET FOR 0423 12143 064323 LDB MBXL MULTIPLY 0424 12144 026130 JMP REPL1 0425* 0426* 0427********************************************* 0428**** SUBROUTINE MATRIX CON **** 0429********************************************* 0430*SETS MATRIX TO ALL ONES. B3 IS ADDRESS OF * 0431*BASE ADDRESS OF MATRIX. * 0432********************************************* 0433* 0434 12145 000000 LCON NOP 0435 12146 060466 LDA HONE 0436 12147 064325 LDB .2 0437 12150 070171 LCON1 STA MLBX1 SET 0438 12151 074172 STB MLBX1+1 CONSTANT 0439 12152 060200 LDA B3+1 0440 12153 015336 JSB MDIM SET 0441 12154 001100 ARS ELEMENT 0442 12155 003004 CMA,INA COUNTER 0443 12156 073134 STA LPIV 0444 12157 060171 LDA MLBX1 LOAD 0445 12160 064172 LDB MLBX1+1 CONSTANT PAGE 0139 #10 MATRIX ROUTINES 0446 12161 170177 LCON2 STA B3,I STORE 0447 12162 034177 ISZ B3 IN 0448 12163 174177 STB B3,I NEXT 0449 12164 034177 ISZ B3 ELEMENT 0450 12165 037134 ISZ LPIV DONE? 0451 12166 026161 JMP LCON2 NO 0452 12167 126145 JMP LCON,I YES 0453* 0454* 0455********************************************* 0456**** SUBROUTINE MATRIX ZERO **** 0457********************************************* 0458*SETS MATRIX TO ZERO. B3 IS ADDRESS OF BASE * 0459*ADDRESS OF MATRIX. B1,B2 ARE REDUNDANT * 0460*SET B1=0 AND USE SUBROUTINE CON,ENTRY2 * 0461********************************************* 0462* 0463 12170 000000 SZER NOP 0464 12171 062170 LDA SZER CONVERT 0465 12172 072145 STA LCON 0466 12173 002400 CLA LCON 0467 12174 006400 CLB 0468 12175 026150 JMP LCON1 TO SZER 0469* 0470* 0471********************************************* 0472**** SUBROUTINE MATRIX IDN **** 0473********************************************* 0474*ROUTINE SETS UP IDENTITY MATRIX * 0475*B3 IS ADDRESS OF BASE ADDRESS OF MATRIX * 0476*USE SZER TO SET MATRIX TO ALL ZEROS. ON * 0477*RETURN CHECK FOR SQUARE MATRIX. * 0478********************************************* 0479* 0480 12176 000000 LIDN NOP 0481 12177 060177 LDA B3 0482 12200 073123 STA T9 SAVE BASE ADDRESS 0483 12201 016170 JSB SZER SET ALL MATRIX TO ZERO 0484 12202 060200 LDA B3+1 IS 0485 12203 001727 ALF,ALF ARRAY 0486 12204 050200 CPA B3+1 SQUARE? 0487 12205 001010 ALS,SLA YES 0488 12206 026035 JMP LERR NO 0489 12207 010401 AND MSK1 SAVE ROW 0490 12210 070171 STA MLBX1 LENGTH 0491 12211 001100 ARS SAVE 0492 12212 003004 CMA,INA ROW 0493 12213 070172 STA MLBX1+1 COUNTER 0494 12214 067123 LDB T9 RESTORE 0495 12215 074177 STB B3 B3 0496 12216 060466 LIDN1 LDA HONE STORE 0497 12217 170001 STA 1,I 0498 12220 006004 INB 1.0 ON 0499 12221 060325 LDA .2 0500 12222 170001 STA 1,I DIAGONAL 0501 12223 006004 INB PAGE 0140 #10 MATRIX ROUTINES 0502 12224 044171 ADB MLBX1 MOVE TO NEXT DIAGONAL ELEMENT 0503 12225 034172 ISZ MLBX1+1 DONE? 0504 12226 026216 JMP LIDN1 NO 0505 12227 126176 JMP LIDN,I YES 0506* 0507* 0508********************************************* 0509***** SUBROUTINES DLD AND DST ****** 0510********************************************* 0511* 0512* 0513* 0514 12230 000000 .DLD NOP 0515 12231 016250 JSB GETAD GET ADDRESS 0516 12232 112230 DEF .DLD,I 0517 12233 036230 ISZ .DLD BUMP RETURN ADDRESS 0518 12234 162264 LDA ADRES,I LOAD HIGH PART. 0519 12235 036264 ISZ ADRES 0520 12236 166264 LDB ADRES,I LOAD LOW PART. 0521 12237 126230 JMP .DLD,I 0522* 0523 12240 000000 .DST NOP 0524 12241 016250 JSB GETAD GET ADDRESS. 0525 12242 112240 DEF .DST,I 0526 12243 036240 ISZ .DST BUMP RETURN ADDRESS. 0527 12244 172264 STA ADRES,I STORE HIGH PART. 0528 12245 036264 ISZ ADRES 0529 12246 176264 STB ADRES,I STORE LOW PART. 0530 12247 126240 JMP .DST,I 0531* 0532 12250 000000 GETAD NOP COMPUTES EFFECTIVE ADDRESS. 0533 12251 072265 STA TINY SAVE A REGISTER. 0534 12252 162250 LDA GETAD,I GET POINTER TO ADDRESS. 0535 12253 072264 GET STA ADRES STORE IN ADRES. 0536 12254 062265 LDA TINY RESTORE A REGISTER. 0537 12255 162264 LDA ADRES,I 0538 12256 001275 RAL,CLE,SLA,ERA TEST FOR INDIRECT 0539 12257 026253 JMP GET IT IS INDIRECT. 0540 12260 072264 STA ADRES EFFECTIVE ADDRESS. 0541 12261 062265 LDA TINY 0542 12262 036250 ISZ GETAD RETURN 0543 12263 126250 JMP GETAD,I 0544 12264 000000 ADRES BSS 1 0545 12265 000000 TINY BSS 1 PAGE 0141 #10 MATRIX ROUTINES 0547* 0548********************************************* 0549**** SUBROUTINE TRANSPOSE ***** 0550********************************************* 0551*TRANSPOSE OF FORM B3(M,N)=T(B1(N,M)) * 0552*B1,B3 GIVE ADDRESS OF BASE ADDRESS OF GIVEN* 0553*AND RECEIVING MATRICES RESPECTIVELY. * 0554********************************************* 0555* 0556 12266 000000 TRAN NOP 0557 12267 016045 JSB LCHK2 TEST B1 FOR UNASSIGNED TERMS 0558* CHECK DIMENSIONS 0559 12270 060200 LDA B3+1 PARAMETERS OF B3 0560 12271 001727 ALF,ALF INTERCHANGE ROW AND COLUMN 0561 12272 064174 LDB B1+1 PARAMETERS OF B1 0562 12273 016032 JSB COMPR SUBROUTINE COMPARE 0563* DIMENSIONS COMPATIBLE 0564 12274 015236 JSB MPY # OF COLUMNS IN (A) 0565 12275 013115 DEF T3 # OF ROWS IN T3 0566 12276 073134 STA LPIV PRODUCT OF ROW*COL 0567 12277 063116 LDA T4 SET 0568 12300 003004 CMA,INA COLUMN 0569 12301 073117 STA T5 COUNTER 0570* T6 IS INDICATOR TO SELECT 0571* WHICH ELEMENT IN A COL OF 0572* B1 IS TO BE TRANSPOSED 0573 12302 002400 TRAN1 CLA 0574 12303 073120 STA T6 SET T6=0 0575 12304 067120 LNEXT LDB T6 LOAD 0576 12305 005000 BLS 0577 12306 044173 ADB B1 NEXT ELEMENT 0578 12307 160001 LDA 1,I 0579 12310 006004 INB OF COLUMN 0580 12311 164001 LDB 1,I 0581 12312 170177 STA B3,I STORE 0582 12313 034177 ISZ B3 IN 0583 12314 174177 STB B3,I ROW 0584 12315 034177 ISZ B3 0585 12316 063120 LDA T6 SET T6=T6+T4 0586 12317 043116 ADA T4 T6 POINTS TO NEXT TERM IN 0587 12320 073120 STA T6 A COLUMN TO BE TRANSPOSED 0588 12321 053134 CPA LPIV TEST FOR LAST IN COL 0589 12322 026324 JMP *+2 0590 12323 026304 JMP LNEXT 0591* SET BASE ADDRESS TO FIRST 0592* TERM IN NEXT COLUMN 0593 12324 034173 ISZ B1 0594 12325 034173 ISZ B1 0595 12326 037117 ISZ T5 0596 12327 026302 JMP TRAN1 TRANSPOSE NEXT COL 0597 12330 126266 JMP TRAN,I EXIT TO MAIN PROGRAM PAGE 0142 #11 MATRIX ROUTINES 0002* 0003********************************************* 0004**** SUBROUTINE MATRIX MULT **** 0005********************************************* 0006*ROUTINE IS OF FORM B3(M,P)=B1(M,N)*B2(N,P) * 0007*B1,B2,B3 ARE ADDRESSES OF BASE ADDRESSES OF* 0008*THREE MATRICES * 0009********************************************* 0010* 0011 12331 000000 MULT NOP 0012 12332 016051 JSB LCHK1 TEST B1,B2 FOR UNASSIGNED TERMS 0013* CHECK DIMENSIONS 0014 12333 060200 LDA B3+1 PARAMETERS OF B3 0015 12334 010376 AND MSK0 SAVE COLUMN COUNT 0016 12335 073120 STA T6 0017 12336 060176 LDA B2+1 PARAMETERS OF B2 0018 12337 010376 AND MSK0 0019 12340 053120 CPA T6 COLUMNS EQUAL 0020 12341 002001 RSS IN NUMBER? 0021 12342 026035 JMP LERR NO 0022* COMBINE B3,B2 PARAMETERS 0023* INTO (M,N) AND COMPARE 0024* WITH THOSE OF B1 0025 12343 060200 LDA B3+1 PARAMETERS OF B3 0026 12344 010460 AND M256 0027 12345 070001 STA 1 STORE ROW IN MSP OF B 0028 12346 060176 LDA B2+1 PARAMETERS OF B2 0029 12347 001727 ALF,ALF GET ROW COUNT 0030 12350 010376 AND MSK0 IN (A) 0031 12351 040001 ADA 1 COMBINE A AND B 0032 12352 064174 LDB B1+1 PARAMETERS OF B1 0033 12353 016032 JSB COMPR COMPARE ROW AND COL 0034* DIMENSIONS ARE COMPATIBLE 0035* M,N ARE STORED IN T3,T4 0036* SAVE B2 AS DESTROYED IN 0037 12354 060175 LDA B2 MULT 0038 12355 073117 STA T5 0039 12356 063115 LDA T3 SET 0040 12357 003004 CMA,INA ROW 0041 12360 073123 STA T9 COUNTER 0042 12361 063120 MULT4 LDA T6 0043 12362 003004 CMA,INA 0044 12363 073124 STA T10 SET COUNTER 0045 12364 063117 LDA T5 0046 12365 070175 STA B2 RESTORE BASE ADDRESS B2 0047 12366 002400 MULT3 CLA 0048 12367 073125 STA T11 COUNTER FOR B2. INCR BY 0049* 2*P AND POINTS TO NEXT TERM 0050* IN COL TO BE MULTIPLIED 0051 12370 073126 STA T12 COUNTER FOR B1. INCR BY 2 0052* AND POINTS TO NEXT TERM 0053* IN ROW TO BE MULTIPLIED 0054 12371 006400 CLB 0055 12372 016240 JSB .DST CLEAR TO ZERO 0056 12373 100177 DEF B3,I 0057 12374 064173 MULT2 LDB B1 COMPUTE PROD OF ONE TERM PAGE 0143 #11 MATRIX ROUTINES 0058 12375 047126 ADB T12 IN ROW BY ONE TERM IN COL 0059 12376 077132 STB T18 0060 12377 064175 LDB B2 0061 12400 047125 ADB T11 0062 12401 016230 JSB .DLD 0063 12402 100001 DEF 1,I 0064 12403 114240 JSB .FMPA,I 0065 12404 113132 DEF T18,I 0066 12405 114236 JSB .FADA,I COMPUTES RUNNING SUM 0067 12406 100177 DEF B3,I 0068 12407 016240 JSB .DST 0069 12410 100177 DEF B3,I 0070 12411 037126 ISZ T12 SELECT NEXT TERM IN ROW 0071 12412 037126 ISZ T12 0072 12413 063120 LDA T6 SELECT NEXT TERM IN COL 0073 12414 001000 ALS 0074 12415 043125 ADA T11 0075 12416 073125 STA T11 0076* TEST IF HAVE MULT ONE ROW 0077* BY ONE COLUMN 0078 12417 063116 LDA T4 0079 12420 001000 ALS 0080 12421 053126 CPA T12 0081 12422 026424 JMP *+2 0082 12423 026374 JMP MULT2 MULT AND ADD IN NEXT TERM 0083* SUMMATION OF PRODUCTS FOR 0084* ONE TERM OF B3 IS DONE 0085* MULT SAME ROW BY NEXT COL 0086 12424 034177 ISZ B3 INCR RECEIVING MAT 0087 12425 034177 ISZ B3 0088 12426 034175 ISZ B2 BASE ADDRESS OF NEXT COL 0089 12427 034175 ISZ B2 0090* TEST IF HAVE MULT ONE ROW 0091* BY ALL COLUMNS 0092 12430 037124 ISZ T10 SKIP IF INNERPRODUCT DONE 0093 12431 026366 JMP MULT3 COMPUTE SAME ROW*NEXT COL 0094* SELECT NEXT ROW 0095 12432 063116 LDA T4 0096 12433 001000 ALS 0097 12434 040173 ADA B1 0098 12435 070173 STA B1 ADDRESS OF NEXT ROW 0099 12436 037123 ISZ T9 0100 12437 026361 JMP MULT4 MULT ROW BY ALL COLUMNS 0101 12440 126331 JMP MULT,I EXIT TO MAIN PROGRAM PAGE 0144 #11 MATRIX ROUTINES 0103* 0104********************************************* 0105**** SUBROUTINE MATRIX INVERT **** 0106********************************************* 0107*OPERATION OF FORM MAT B3 = INV B1 * 0108*B1,B3 ARE ADDRESSES OF BASE ADDRESS OF * 0109*MATRIX TO BE INVERTED AND RECEIVING MATRIX * 0110*RESPECTIVELY. B2 IS REDUNDANT. METHOD USED * 0111*IS GAUSSIAN ELIMINATION WITH COLUMN * 0112*PIVOTING * 0113********************************************* 0114* 0115 12441 000000 LINV NOP SUBROUTINE MATRIX INVERT 0116 12442 016045 JSB LCHK2 TEST B1 FOR UNASSIGNED TERMS 0117 12443 060174 LDA B1+1 DIMENSIONS OF MATRIX B1 0118 12444 064200 LDB B3+1 DIMENSIONS OF MATRIX B3 0119 12445 016032 JSB COMPR CHECK DIMENSIONS 0120* ROW AND COL VALUES T3,T4 0121* MAKE COPY OF MATRIX B1 0122* IN FREE CORE 0123 12446 060177 LDA B3 SAVE 0124 12447 073127 STA T13 B3 0125 12450 060174 LDA B1+1 COMPUTE SIZE 0126 12451 015336 JSB MDIM OF MATRIX 0127 12452 003004 CMA,INA 0128 12453 001100 ARS SAVE 0129 12454 073114 STA T2 ELEMENT 0130 12455 001000 ALS COUNTER 0131 12456 064141 LDB LSTPT SAVE 0132 12457 006004 INB ADDRESS OF 0133 12460 074175 STB B2 FREE CORE 0134 12461 074177 STB B3 0135 12462 007004 CMB,INB COMPUTE SIZE OF 0136 12463 044142 ADB HSTPT FREE CORE AREA 0137 12464 040001 ADA 1 ENOUGH 0138 12465 002020 SSA CORE LEFT? 0139 12466 025473 JMP E1 NO 0140 12467 016123 JSB REPLC YES, COPY SOURCE MATRIX 0141 12470 063127 LDA T13 RESTORE 0142 12471 070177 STA B3 B3 0143 12472 016176 JSB LIDN SET DESTINATION TO IDENTITY 0144 12473 063127 LDA T13 RESTORE ITS 0145 12474 070177 STA B3 BASE ADDRESS 0146 12475 002400 CLA INITIALIZE 0147 12476 073126 STA T12 MAXIMUM 0148 12477 073127 STA T13 ELEMENT 0149 12500 060175 LDA B2 COPY B2 INTO B1 AS 0150 12501 070173 STA B1 B2 NEEDED LATER 0151 12502 160173 LIN11 LDA B1,I LOAD 0152 12503 034173 ISZ B1 NEXT 0153 12504 164173 LDB B1,I ELEMENT 0154 12505 034173 ISZ B1 0155 12506 002020 SSA GET ABSOLUTE VALUE 0156 12507 015423 JSB ARINV IF NUMBER IS NEGATIVE 0157 12510 073132 STA T18 SAVE NUMBER 0158 12511 077133 STB T19 PAGE 0145 #11 MATRIX ROUTINES 0159 12512 114237 JSB .FSBA,I SUBTRACT EXISTING MAX. 0160 12513 013126 DEF T12 VALUE 0161 12514 002020 SSA SKIP AND SWAP IF POSITIVE 0162 12515 026522 JMP LIN10 0163 12516 063132 LDA T18 SWAP 0164 12517 067133 LDB T19 0165 12520 073126 STA T12 0166 12521 077127 STB T13 0167 12522 037114 LIN10 ISZ T2 ALL ELEMENTS EXHAUSTED? 0168 12523 026502 JMP LIN11 NO 0169 12524 063126 LDA T12 COMPUTE RELATIVE TOLERANCE 0170 12525 067127 LDB T13 TOL=ABSOLUTE TOL * MAX VALUE 0171 12526 114240 JSB .FMPA,I 0172 12527 013130 DEF T16 ABSOLUTE TOLERANCE 0173 12530 070171 STA MLBX1 RELATIVE 0174 12531 074172 STB MLBX1+1 TOLERANCE 0175 12532 002400 CLA INITIALIZE PIVOT 0176 12533 073134 STA LPIV 0177 12534 037116 ISZ T4 REQUIRE CONSTANT (ROW+1) 0178 12535 037134 LINV1 ISZ LPIV SELECT NEXT PIVOT 0179 12536 063134 LDA LPIV TEST IF HAVE PROCESSED 0180 12537 053116 CPA T4 LAST PIVOT 0181 12540 126441 JMP LINV,I NORMAL EXIT TO MAIN PROG 0182* SCAN PIVOTAL COLUMN FOR 0183* LARGEST ELEMENT 0184 12541 063134 LDA LPIV COMPUTE ADDRESS OF PIVOT 0185 12542 067134 LDB LPIV COLUMN USING ROUTINE LWHR 0186 12543 073114 STA T2 ROW COUNTER 0187 12544 017067 JSB LWHR ON RETURN, ADDRESS IN A 0188 12545 073113 STA T1 0189 12546 002400 CLA 0190 12547 073126 STA T12 T12,T13 IS STORE 0191 12550 073127 STA T13 FOR GREATEST VALUE 0192 12551 016230 LINV2 JSB .DLD LOAD FP NUMBER 0193 12552 113113 DEF T1,I 0194 12553 002020 SSA OBTAIN ABSOLUTE VALUE 0195 12554 015423 JSB ARINV IF NUMBER IS NEGATIVE 0196 12555 073132 STA T18 STORE VALUE OF FP NUMBER 0197 12556 077133 STB T19 0198 12557 114237 JSB .FSBA,I SUBTR EXISTING LARGEST VALUE 0199 12560 013126 DEF T12 0200 12561 002020 SSA SKIP AND SWAP IF POSITIVE 0201 12562 026571 JMP LINV7 T2 STILL CONTAINS MAX VALUE 0202 12563 063132 LDA T18 STORE NEW MAX VALUE 0203 12564 067133 LDB T19 0204 12565 073126 STA T12 0205 12566 077127 STB T13 0206 12567 063114 LDA T2 SET T5 TO POSITION IN 0207 12570 073117 STA T5 COLUMN OF MAX VALUE 0208 12571 037114 LINV7 ISZ T2 0209 12572 063114 LDA T2 TEST FOR LAST TERM IN COL 0210 12573 053116 CPA T4 0211 12574 026602 JMP LINV8 SWAP ROWS 0212 12575 063115 LDA T3 COMPUTE 0213 12576 001000 ALS NEXT ADDRESS 0214 12577 043113 ADA T1 IN PIVOT PAGE 0146 #11 MATRIX ROUTINES 0215 12600 073113 STA T1 COLUMN 0216 12601 026551 JMP LINV2 SELECT NEXT TERM 0217* SWAP ROWS LPIV AND T5 0218 12602 063134 LINV8 LDA LPIV COMPUTE ADDRESS 0219 12603 006404 CLB,INB OF PIVOTAL ROW 0220 12604 017067 JSB LWHR 0221 12605 073113 STA T1 ADDRESS OF PIVOTAL ROW 0222 12606 063117 LDA T5 0223 12607 006404 CLB,INB 0224 12610 017067 JSB LWHR 0225 12611 073114 STA T2 ADDR OF ROW TO BE SWAPPED 0226 12612 063134 LDA LPIV 0227 12613 006404 CLB,INB COMPUTE ADDRESS OF 0228 12614 017101 JSB LWHR2 PIVOTAL ROW IN I-MATRIX 0229 12615 073123 STA T9 0230 12616 073124 STA T10 KEEP COPY 0231 12617 063117 LDA T5 0232 12620 006404 CLB,INB COMPUTE ADDR OF ROW TO 0233 12621 017101 JSB LWHR2 BE SWAPPED IN I-MATRIX 0234 12622 073125 STA T11 0235 12623 063115 LDA T3 0236 12624 003004 CMA,INA 0237 12625 073126 STA T12 COUNTER FOR TERMS IN A ROW 0238 12626 016230 LINV3 JSB .DLD SWAP ONE ELEMENT OF ROW 0239 12627 113113 DEF T1,I 0240 12630 073132 STA T18 0241 12631 077133 STB T19 0242 12632 016230 JSB .DLD 0243 12633 113114 DEF T2,I 0244 12634 173113 STA T1,I 0245 12635 037113 ISZ T1 0246 12636 177113 STB T1,I 0247 12637 037113 ISZ T1 0248 12640 063132 LDA T18 0249 12641 067133 LDB T19 0250 12642 173114 STA T2,I 0251 12643 037114 ISZ T2 0252 12644 177114 STB T2,I 0253 12645 037114 ISZ T2 0254 12646 016230 JSB .DLD SWAP ONE ELEMENT IN A ROW 0255 12647 113123 DEF T9,I OF I-MATRIX 0256 12650 073132 STA T18 0257 12651 077133 STB T19 0258 12652 016230 JSB .DLD 0259 12653 113125 DEF T11,I 0260 12654 173123 STA T9,I 0261 12655 037123 ISZ T9 0262 12656 177123 STB T9,I 0263 12657 037123 ISZ T9 0264 12660 063132 LDA T18 0265 12661 067133 LDB T19 0266 12662 173125 STA T11,I 0267 12663 037125 ISZ T11 0268 12664 177125 STB T11,I 0269 12665 037125 ISZ T11 0270 12666 037126 ISZ T12 SKIP IF DONE PAGE 0147 #11 MATRIX ROUTINES 0271 12667 026626 JMP LINV3 SWAP NEXT ELEMENT 0272* HAVE LARGEST ELEMENT IN 0273* PIVOTAL POSITION. FIND 0274* VALUE AND TEST TO ZERO 0275* FOR SINGULAR MATRIX 0276 12670 063134 LDA LPIV COMPUTE 0277 12671 067134 LDB LPIV ADDRESS OF 0278 12672 017067 JSB LWHR PIVOT 0279 12673 073113 STA T1 ELEMENT 0280 12674 016230 JSB .DLD PIVOT VALUE 0281 12675 113113 DEF T1,I 0282 12676 002020 SSA OBTAIN ABSOLUTE VALUE 0283 12677 015423 JSB ARINV IF NUMBER IS NEGATIVE 0284 12700 114237 JSB .FSBA,I SUBTRACT TOLERANCE AND 0285 12701 000171 DEF MLBX1 0286 12702 002020 SSA COMPARE TO ZERO 0287 12703 014477 JSB ERROR PRINT'NEARLY SING MATRIX' 0288* DIVIDE PIVOT ROW AND ROW 0289* IN I-MAT BY PIVOT VALUE 0290 12704 063113 LDUM1 LDA T1 ADDRESS OF PIOT ELEMENT 0291 12705 073114 STA T2 0292 12706 060466 LDA HONE LOAD 0293 12707 064325 LDB .2 1.0 0294 12710 114241 JSB .FDVA,I 0295 12711 113113 DEF T1,I 0296 12712 073132 STA T18 INVERSE OF PIVOT 0297 12713 077133 STB T19 0298* MULT ROW BY 1/PIVOT 0299* STARTING AT PIVOT+1 0300 12714 063134 LDA LPIV 0301 12715 073125 STA T11 COUNTER FOR ROW 0302 12716 037125 LINV6 ISZ T11 INCREMENT COUNTER 0303 12717 063125 LDA T11 0304 12720 053116 CPA T4 TEST FOR END OF ROW 0305 12721 026733 JMP LIN12 0306 12722 037114 ISZ T2 ADDRESS OF NEXT ELEMENT 0307 12723 037114 ISZ T2 0308 12724 016230 JSB .DLD 0309 12725 113114 DEF T2,I 0310 12726 114240 JSB .FMPA,I 0311 12727 013132 DEF T18 0312 12730 016240 JSB .DST 0313 12731 113114 DEF T2,I 0314 12732 026716 JMP LINV6 0315* MULT ROW IN I-MATRIX BY 0316* 1/PIVOT. SKIP IF ELEMENT=0 0317 12733 063124 LIN12 LDA T10 ADDRESS OF PIVOT ROW 0318 12734 073117 STA T5 IN I-MATRIX 0319 12735 063115 LDA T3 0320 12736 003004 CMA,INA SET 0321 12737 073125 STA T11 ROW COUNTER 0322 12740 016230 LIN13 JSB .DLD 0323 12741 113117 DEF T5,I 0324 12742 002003 SZA,RSS SKIP MULTIPLICATION IF ZERO 0325 12743 006002 SZB 0326 12744 026746 JMP *+2 NOT ZERO PAGE 0148 #11 MATRIX ROUTINES 0327 12745 026752 JMP LIN14 ZERO 0328 12746 114240 JSB .FMPA,I 0329 12747 013132 DEF T18 0330 12750 016240 JSB .DST 0331 12751 113117 DEF T5,I 0332 12752 037117 LIN14 ISZ T5 NEXT ELEMENT IN I-MATRIX 0333 12753 037117 ISZ T5 0334 12754 037125 ISZ T11 DONE? 0335 12755 026740 JMP LIN13 NO 0336* PERFORM ROW MANIPULATIONS 0337* AND SUBTRACTIONS TO REDUCE 0338* PIVOT COLUMN TO ZERO 0339 12756 002400 CLA 0340 12757 070173 STA B1 0341 12760 034173 LINV4 ISZ B1 SELECT NEXT ROW 0342 12761 060173 LDA B1 0343 12762 053116 CPA T4 TEST FOR LAST ROW 0344 12763 026535 JMP LINV1 SELECT NEXT PIVOT 0345 12764 053134 CPA LPIV TEST TO SKIP PIVOTAL ROW 0346 12765 026760 JMP LINV4 SKIP PIVOTAL ROW 0347 12766 060173 LDA B1 0348 12767 006404 CLB,INB 0349 12770 017101 JSB LWHR2 ADDRESS OF ROW TO BE TRANSFORMED 0350 12771 073125 STA T11 IN I-MATRIX 0351* COMPUTE MULTIPLIER WHICH 0352* IS THAT ELEMENT IN ROW TO 0353* BE TRANSFORMED WHICH LIES 0354* IN THE PIVOTAL COLUMN 0355 12772 060173 LDA B1 0356 12773 067134 LDB LPIV 0357 12774 017067 JSB LWHR 0358 12775 073123 STA T9 SAVE ADDRESS 0359 12776 016230 JSB .DLD 0360 12777 100000 DEF 0,I 0361 13000 073121 STA T7 VALUE OF MULTIPLIER 0362 13001 077122 STB T8 0363* DO ELIMINATION OF ROWS IN 0364* ORIGINAL MATRIX. START AT 0365* COLUMN LPIV+1 0366 13002 063134 LDA LPIV 0367 13003 073127 STA T13 COUNTER 0368 13004 063113 LDA T1 0369 13005 073114 STA T2 0370 13006 037127 LINV5 ISZ T13 0371 13007 063127 LDA T13 0372 13010 053116 CPA T4 TEST FOR LAST TERM IN ROW 0373 13011 027033 JMP LIN15 0374 13012 037123 ISZ T9 T9 IS ADDRESS OF 0375 13013 037123 ISZ T9 ELEMENT TO BE CHANGED 0376 13014 037114 ISZ T2 T2 IS ADDR OF CORRESPONDING 0377 13015 037114 ISZ T2 ELEMENT IN PIVOTAL ROW 0378 13016 063121 LDA T7 0379 13017 067122 LDB T8 0380 13020 114240 JSB .FMPA,I 0381 13021 113114 DEF T2,I 0382 13022 073132 STA T18 MULTIPLIER*VALUE IN PAGE 0149 #11 MATRIX ROUTINES 0383 13023 077133 STB T19 PIVOT ROW 0384 13024 016230 JSB .DLD 0385 13025 113123 DEF T9,I 0386 13026 114237 JSB .FSBA,I 0387 13027 013132 DEF T18 0388 13030 016240 JSB .DST TRANSFORMED ELEMENT 0389 13031 113123 DEF T9,I 0390 13032 027006 JMP LINV5 SELECT NEXT TERM 0391* DO ELIMINATION OF ROWS IN 0392* IDENTITY MATRIX. START AT 0393* BEGINNING OF ROW AND LEAVE 0394* ELEMENT UNCHANGED WHEN ZERO 0395* IN PIVOTAL ROW. 0396 13033 063124 LIN15 LDA T10 ADDRESS OF 0397 13034 073117 STA T5 PIVOTAL ROW 0398 13035 063115 LDA T3 0399 13036 003004 CMA,INA SET 0400 13037 073127 STA T13 COUNTER 0401 13040 163117 LIN18 LDA T5,I 0402 13041 037117 ISZ T5 0403 13042 167117 LDB T5,I 0404 13043 037117 ISZ T5 0405 13044 002003 SZA,RSS SKIP IF ZERO 0406 13045 006002 SZB 0407 13046 027050 JMP *+2 NOT ZERO 0408 13047 027062 JMP LIN17 ZERO 0409 13050 114240 JSB .FMPA,I MULTIPLY BY 0410 13051 013121 DEF T7 MULTIPLIER 0411 13052 073132 STA T18 0412 13053 077133 STB T19 0413 13054 016230 JSB .DLD 0414 13055 113125 DEF T11,I 0415 13056 114237 JSB .FSBA,I 0416 13057 013132 DEF T18 0417 13060 016240 JSB .DST 0418 13061 113125 DEF T11,I 0419 13062 037125 LIN17 ISZ T11 0420 13063 037125 ISZ T11 0421 13064 037127 ISZ T13 0422 13065 027040 JMP LIN18 SELECT NEXT TERM 0423 13066 026760 JMP LINV4 ELIMINATE NEXT ROW 0424* 0425* 0426********************************************* 0427***** SUBROUTINE LWHR ***** 0428********************************************* 0429*SUBROUTINE COMPUTES ADDRESS OF AN ELEMENT * 0430*IN MATRIX GIVEN BY B2. ROW AND COL VALUES * 0431*ARE SUPPLIED IN A,B. ADDRESS IS LEFT IN A * 0432*ENTRY LWHR2 COMPUTES ADDR IN MAT B3 * 0433********************************************* 0434* 0435 13067 000000 LWHR NOP 0436 13070 077121 STB T7 SAVE COLUMN # 0437 13071 040431 ADA M1 0438 13072 015236 JSB MPY PAGE 0150 #11 MATRIX ROUTINES 0439 13073 013115 DEF T3 (A-1)*T3 0440 13074 043121 ADA T7 0441 13075 040431 ADA M1 +(B-1) 0442 13076 001000 ALS 0443 13077 040175 ADA B2 DDR=B2+2((A-1)*T3+(B-1)) 0444 13100 127067 JMP LWHR,I 0445 13101 000000 LWHR2 NOP 0446 13102 077121 STB T7 0447 13103 040431 ADA M1 0448 13104 015236 JSB MPY 0449 13105 013115 DEF T3 0450 13106 043121 ADA T7 0451 13107 040431 ADA M1 0452 13110 001000 ALS 0453 13111 040177 ADA B3 0454 13112 127101 JMP LWHR2,I 0455* 0456* 0457********************************************* 0458* CONSTANTS * 0459********************************************* 0460* 0461 13113 000000 T1 BSS 1 TEMPORARY CONSTANTS 0462 13114 000000 T2 BSS 1 0463 13115 000000 T3 BSS 1 0464 13116 000000 T4 BSS 1 0465 13117 000000 T5 BSS 1 0466 13120 000000 T6 BSS 1 0467 13121 000000 T7 BSS 1 0468 13122 000000 T8 BSS 1 0469 13123 000000 T9 BSS 1 0470 13124 000000 T10 BSS 1 0471 13125 000000 T11 BSS 1 0472 13126 000000 T12 BSS 1 0473 13127 000000 T13 BSS 1 0474 13130 041433 T16 DEC +1E-6 ABSOLUTE TOLERANCE 0475 13132 000000 T18 BSS 1 0476 13133 000000 T19 BSS 1 0477 13134 000000 LPIV BSS 1 0478 13135 114236 LPLUS JSB .FADA,I GENERATES CODE 0479 13136 100175 DEF B2,I 0480 13137 114237 LMIN JSB .FSBA,I GENERATES CODE 0481 13140 114240 LTIME JSB .FMPA,I GENERATES CODE 0482 13141 034175 INCB2 ISZ B2 GENERATES CODE 0483 13142 FINIS EQU * 0484 END ** NO ERRORS*