From: Philipp Hachtmann Date: Thu, 1 Oct 2015 17:52:51 +0000 (+0200) Subject: software: Added more and more X-Git-Url: http://gitweb.hachti.de/?a=commitdiff_plain;h=7af5ad59491ddf2066641aef1e0025a337c0f247;p=pdp8.git software: Added more and more Signed-off-by: Philipp Hachtmann --- diff --git a/sw/SPACE/SPACE.PA b/sw/SPACE/SPACE.PA new file mode 100644 index 0000000..8543c5a --- /dev/null +++ b/sw/SPACE/SPACE.PA @@ -0,0 +1,1703 @@ +CLZE=6130 +CLSK=6131 +CLOE=6132 +CLAB=6133 +CLEN=6134 +CLSA=6135 +CLBA=6136 +CLCA=6137 +CREXT=0100 +CR2=0200 +CR3=0300 +CR4=0400 +CR5=0500 +CR6=0600 +COVSTAT=4000 +CMFREE=0000 +CMPROG=1000 +CADC=0040 +CINH=0020 +CION=0010 +CEV3=0004 +CEV2=0002 +CEV1=00001 +DIXY=6055 +DILX=6053 +DILY=6054 +DILE=6056 +DISD=6052 +XRIN=NOP +XRCL=NOP +/DSB=XXXX +DXC=JMS I IVCLDX +DYC=JMS I IVCLDY +DXL=0000 +DYL=0000 +DIS=0000 +/CRF=NOP +/CCF=NOP + *0 + 0 + JMP I 2 + INTSER +EMPTY, 0 +ODT1, 0 +ODT2, 0 +ODT3, 0 + *10 +AUTO10, 0 +AUTO11, 0 +AUTO12, 0 +AUTO13, 0 +AUTO14, 0 +AUTO15, 0 +AUTO16, 0 +AUTO17, 0 + *20 +ONEOUT, 0 +ONECNT, 0 +ONEFLG, 0 +ONETHE, 0 +ONEVEX, 0 +ONEVEY, 0 +ONEPEX, 0 +ONEPEY, 0 +ONESIN, 0 +ONECOS, 0 +ONEFIN, 0 +TWOOUT, 0 +TWOCNT, 0 +TWOFLG, 0 +TWOTHE, 0 +TWOVEX, 0 +TWOVEY, 0 +TWOPEX, 0 +TWOPEY, 0 +TWOSIN, 0 +TWOCOS, 0 +TWOFIN, 0 +XONEDS, 0 +YONEDS, 0 +XTWODS, 0 +YTWODS, 0 +DIXTEM, 0 +DIYTEM, 0 +DISCNT, 0 +T10SIN, 0 +T20SIN, 0 +T30SIN, 0 +T10COS, 0 +T20COS, 0 +T30COS, 0 +CALSIN, 0 +CALCOS, 0 +SINE, SINEIN +COSINE, COSINI +MULT, MULTI +RSHIFT, SHIFTR +VECTOR, DISPLY +CALPOS, POSCAL +INTWRD, 0 +INTCNT, 0 +HYPER, HYPSET +MESOUT, CHARS +THEADJ, THEAJI +VEESCL, VEELIM +ISHFT, DISHFT +RESET1, RESE1 +GAMOVR, 0 +ACCFLG, 0 +ACCPER, -30 +MEXP, -400 +PROX, 0 +PROY, 0 +PROLIF, -360 +BUFTMP, 0 +ONEFIL, DISBUF +TWOFIL, DISBUF+40 +P5, 5 +P10, 10 +P17, 17 +P20, 20 +P37, 37 +P40, 40 +P100, 100 +P132, 132 +P200, 200 +P400, 400 +P550, 550 +P3777, 3777 +M4, -4 +M6, -6 +M10, -10 +M11, -11 +M264, -264 +M200, -200 +M400, -400 +M550, -550 +IVCLDX, VCLDX +IVCLDY, VCLDY + *200 +START, CLA CLL + DIXY + LAS + TAD SWRD + TAD XROPT + DCA COLDST +RESTRT, CLA CMA + XRCL + CLA CLL + TAD P17 + DCA AUTO10 + TAD TABLEN + DCA AUTO11 + DCA I AUTO10 + ISZ AUTO11 + JMP .-2 + TAD STRT1 + DCA ONEPEX + TAD STRT2 + DCA TWOPEX + TAD P37 + DCA ONECOS + TAD P37 + DCA TWOCOS + TAD ACCPER + DCA ACCFLG + DCA ONEFIN + DCA TWOFIN + DCA GAMOVR + JMS I BUFSET + TCF + PCF + RRB + CLA CMA + CLZE + CLA + TAD CDELY + CLAB + CLA + TAD CCNF + CLOE + CLA CLL + JMP COLDST + +CCNF, CR4+CMPROG+CION+COVSTAT +CDELY, -310 +UPDATE, CLA CLL + +COLDST, 0 + LAS + DCA INTWRD + TAD INTWRD + RTR + RTR + AND LFTHAF + DCA INTTEM + TAD INTWRD + AND RYTHAF + TAD INTTEM + JMP .+3 +CODST, XRIN + XRCL + DCA INTWRD + TAD M550 + DCA INTCNT + ION + TAD ACCFLG + IAC + SMA SZA + TAD ACCPER + DCA ACCFLG + JMP I .+1 + ONEUP +BUFSET, SETBUF +TABLEN, AUTO17-CALCOS +INTTEM, 0 +LFTHAF, 0360 +RYTHAF, 0017 +STRT1, 1000 +STRT2, -1000 +SWRD, 2000-CODST +XROPT, JMP CODST +INTSER, DCA INTACC + RAR + DCA INTLNK + CLSK + JMP INTBUS + CLA IAC RTR + CLSA + CLA CLL + JMP UPDATE +INTBUS, KSF + JMP .+5 + KCC + TAD GAMOVR + SZA CLA + JMP RESTRT +/ TCF + ISZ INTGLH + SKP + HLT +INTRET, CLA CLL + TAD INTLNK + RAL + TAD INTACC + ION + JMP I 0 +INTACC, 0 +INTLNK, 0 +INTGLH, 0 + *400 +ONEUP, TAD ONEFLG + SNA + JMP ONEOK + IAC + SNA + TAD ONEFIN + DCA ONEFLG + JMP I ITWOUP +ONEOK, TAD ONEOUT + SZA CLA + JMP ONEFIG + TAD TWOFIN + SZA CLA + JMS I ONEWN + TAD INTWRD + AND OP300 + TAD OM300 + SZA CLA + JMP ONELEF + CMA + JMP I HYPER +ONELEF, TAD INTWRD + AND P200 + SNA CLA + JMP ONERYT + CLA CLL CMA + JMP ONEFIG +ONERYT, TAD INTWRD + AND P100 + SZA CLA + IAC +ONEFIG, TAD ONETHE + JMS I THEADJ + DCA ONETHE + TAD ONETHE + JMS I SINE + DCA ONESIN + TAD ONETHE + JMS I COSINE + DCA ONECOS + TAD ONEOUT + SZA CLA + JMP ONEVEL +ONEMOV, TAD ACCFLG + SZA CLA + JMP ONEVEL + TAD INTWRD + AND P40 + SNA CLA + JMP ONEVEL + TAD ONECOS + TAD ONEVEY + JMS I VEESCL + DCA ONEVEY + TAD ONESIN + TAD ONEVEX + JMS I VEESCL + DCA ONEVEX +ONEVEL, TAD ONEVEX + JMS I ISHFT + JMS I ISHFT + TAD ONEPEX + DCA ONEPEX + TAD ONEVEY + JMS I ISHFT + JMS I ISHFT + TAD ONEPEY + DCA ONEPEY + TAD ONEOUT + SZA CLA + JMP I ITWOUP +ONELNC, TAD LNC1FG + SNA CLA + JMP .+3 + ISZ LNC1FG + JMP I ITWOUP + TAD INTWRD + AND P20 + SNA CLA + JMP I ITWOUP + + TAD PROLIF + DCA I AUTO16 + TAD ONEVEX + JMS I ISHFT + JMS I RSHIFT + TAD ONESIN + JMS I RSHIFT + DCA I AUTO16 + TAD ONESIN + CLL RTL + TAD ONEPEX + DCA I AUTO16 + TAD ONEVEY + JMS I ISHFT + JMS I RSHIFT + TAD ONECOS + JMS I RSHIFT + DCA I AUTO16 + TAD ONECOS + CLL RTL + TAD ONEPEY + DCA I AUTO16 + TAD M200 + DCA LNC1FG + JMS I RESET1 + JMP I .+1 +ITWOUP, TWOUP +LNC1FG, 0 +OP300, 300 +OM300, -300 +ONEWN, ONEWIN + *600 +TWOUP, TAD TWOFLG + SNA + JMP TWOOK + IAC + SNA + TAD TWOFIN + DCA TWOFLG + JMP I IONEST +TWOOK, TAD TWOOUT + SZA CLA + JMP TWOFIG + TAD ONEFIN + SZA CLA + JMS I TWOWN + TAD INTWRD + AND OP14 + TAD OM14 + SNA CLA + JMP I HYPER + +TWOLEF, TAD INTWRD + AND P10 + SNA CLA + JMP TWORYT + CLA CLL CMA + JMP TWOFIG +TWORYT, CLA CLL IAC RTL + AND INTWRD + SZA CLA + IAC +TWOFIG, TAD TWOTHE + JMS I THEADJ + DCA TWOTHE + TAD TWOTHE + JMS I SINE + DCA TWOSIN + TAD TWOTHE + JMS I COSINE + DCA TWOCOS + TAD TWOOUT + SZA CLA + JMP TWOVEL +TWOMOV, TAD ACCFLG + SZA CLA + JMP TWOVEL + CLL IAC RAL + AND INTWRD + SNA CLA + JMP TWOVEL + TAD TWOSIN + TAD TWOVEX + JMS I VEESCL + DCA TWOVEX + TAD TWOCOS + TAD TWOVEY + JMS I VEESCL + DCA TWOVEY +TWOVEL, TAD TWOVEX + JMS I ISHFT /COMPONENTS + JMS I ISHFT + TAD TWOPEX + DCA TWOPEX + TAD TWOVEY + JMS I ISHFT + JMS I ISHFT + TAD TWOPEY + DCA TWOPEY + TAD TWOOUT + SZA CLA + JMP I IONEST +TWOLNC, TAD LNC2FG + SNA CLA + JMP .+3 + ISZ LNC2FG + JMP I IONEST + IAC + AND INTWRD + SNA CLA + JMP I IONEST + TAD PROLIF + DCA I AUTO16 + TAD TWOVEX + JMS I ISHFT + JMS I RSHIFT + TAD TWOSIN + JMS I RSHIFT + DCA I AUTO16 + TAD TWOSIN + CLL RTL + TAD TWOPEX + DCA I AUTO16 + TAD TWOVEY + JMS I ISHFT + JMS I RSHIFT + TAD TWOCOS + JMS I RSHIFT + DCA I AUTO16 + TAD TWOCOS + CLL RTL + TAD TWOPEY + DCA I AUTO16 + TAD M200 + DCA LNC2FG + JMS I RESET1 + JMP I .+1 +IONEST, ONESET +LNC2FG, 0 +OP14, 14 +OM14, -14 +TWOWN, TWOWIN + *1000 +ONESET, CLA CLL + TAD ONEFLG + SZA CLA + JMP I ITWOST + TAD ONESIN + DCA CALSIN + TAD ONECOS + DCA CALCOS + JMS I CALPOS + TAD ONEFIL + DCA AUTO10 + TAD ONEPEX + TAD T30SIN + DCA I AUTO10 + TAD ONEPEY + TAD T30COS + DCA I AUTO10 + TAD T10COS + CIA + TAD ONEPEX + DCA I AUTO10 + TAD T10SIN + TAD ONEPEY + DCA I AUTO10 + TAD T30SIN + TAD T30COS + CIA + TAD ONEPEX + DCA I AUTO10 + TAD T30COS + CIA + TAD T30SIN + TAD ONEPEY + DCA I AUTO10 + TAD T10SIN + CIA + TAD ONEPEX + DCA I AUTO10 + TAD T10COS + CIA + TAD ONEPEY + DCA I AUTO10 +FLAM1, TAD INTWRD + AND P40 + SNA CLA + JMP ONECON + TAD ONEOUT + SZA CLA + JMP ONECON + TAD ONFG1 + SNA + CLA CLL CMA RAL + DCA ONFG1 + ISZ ONFG1 + JMP ONECON + TAD ONFG2 + CMA + DCA ONFG2 + TAD ONFG2 + SNA CLA + TAD T10SIN + TAD T30SIN + CIA + TAD ONEPEX + DCA I AUTO10 + TAD ONFG2 + SNA CLA + TAD T10COS + TAD T30COS + CIA + TAD ONEPEY + DCA I AUTO10 + TAD T10SIN + CIA + TAD ONEPEX + DCA I AUTO10 + TAD T10COS + CIA + TAD ONEPEY + DCA I AUTO10 + CLA CLL CMA RAL +ONECON, TAD M6 + DCA ONECNT + TAD T30SIN + CIA + TAD T30COS + TAD ONEPEX + DCA I AUTO10 + TAD T30SIN + TAD T30COS + CIA + TAD ONEPEY + DCA I AUTO10 + TAD T10COS + TAD ONEPEX + DCA I AUTO10 + TAD T10SIN + CIA + TAD ONEPEY + DCA I AUTO10 + TAD T30SIN + TAD ONEPEX + DCA I AUTO10 + TAD T30COS + TAD ONEPEY + DCA I AUTO10 + JMP I ITWOST +ITWOST, TWOSET +ONFG1, 0 +ONFG2, 0 + *1200 +TWOSET, CLA CLL + TAD TWOFLG + SZA CLA + JMP I IFILDS + TAD TWOSIN + DCA CALSIN + TAD TWOCOS + DCA CALCOS + JMS I CALPOS + TAD TWOFIL + DCA AUTO10 + TAD T30SIN + TAD TWOPEX + DCA I AUTO10 + TAD T30COS + TAD TWOPEY + DCA I AUTO10 + TAD T20COS + CIA + TAD T20SIN + TAD TWOPEX + DCA I AUTO10 + TAD T20SIN + TAD T20COS + TAD TWOPEY + DCA I AUTO10 + TAD T20COS + CIA + TAD TWOPEX + DCA I AUTO10 + TAD T20SIN + TAD TWOPEY + DCA I AUTO10 + TAD T20COS + TAD T30SIN + CIA + TAD TWOPEX + DCA I AUTO10 + TAD T30COS + CIA + TAD T20SIN + TAD TWOPEY + DCA I AUTO10 + TAD T20SIN + CIA + TAD TWOPEX + DCA I AUTO10 + TAD T20COS + CIA + TAD TWOPEY + DCA I AUTO10 +FLAM2, CLA CLL IAC RAL + AND INTWRD + SNA CLA + JMP TWOCON + TAD TWOOUT + SZA CLA + JMP TWOCON + TAD TWFG1 + SNA + CLA CLL CMA RAL + DCA TWFG1 + ISZ TWFG1 + JMP TWOCON + TAD TWFG2 + CMA + DCA TWFG2 + + TAD TWFG2 + SNA CLA + TAD T20SIN + TAD T30SIN + CIA + TAD TWOPEX + DCA I AUTO10 + TAD TWFG2 + SNA CLA + TAD T20COS + TAD T30COS + CIA + TAD TWOPEY + DCA I AUTO10 + TAD T20SIN + CIA + TAD TWOPEX + DCA I AUTO10 + TAD T20COS + CIA + TAD TWOPEY + DCA I AUTO10 + CLA CLL CMA RAL +TWOCON, TAD M10 + DCA TWOCNT + TAD T30SIN + CIA + TAD T20COS + TAD TWOPEX + DCA I AUTO10 + TAD T30COS + TAD T20SIN + CIA + TAD TWOPEY + DCA I AUTO10 + TAD T20COS + TAD TWOPEX + DCA I AUTO10 + TAD T20SIN + CIA + TAD TWOPEY + DCA I AUTO10 + TAD T20COS + TAD T20SIN + TAD TWOPEX + DCA I AUTO10 + TAD T20SIN + CIA + TAD T20COS + TAD TWOPEY + DCA I AUTO10 + TAD T30SIN + TAD TWOPEX + DCA I AUTO10 + TAD T30COS + TAD TWOPEY + DCA I AUTO10 + JMP I IFILDS +IFILDS, FILDIS +TWFG1, 0 +TWFG2, 0 + *1400 +FILDIS, CLA CLL + JMS I COLIDE +/ DSB 1 + TAD ONEFLG + SZA CLA + JMP TWODIS + TAD ONEFIL + DCA AUTO10 + TAD ONECNT + DCA AUTO11 + TAD I AUTO10 + DCA XONEDS + TAD I AUTO10 + DCA YONEDS + TAD ONEOUT + SZA CLA + JMP I IONEEX +FILONE, TAD I AUTO10 + DCA XTWODS + TAD I AUTO10 + DCA YTWODS + JMS I VECTOR + ISZ AUTO11 + SKP + JMP TWODIS + TAD XTWODS + DCA XONEDS + TAD YTWODS + DCA YONEDS + JMP FILONE +TWODIS, TAD TWOFLG + SZA CLA + JMP I IPRODS + TAD TWOFIL + DCA AUTO10 + TAD TWOCNT + DCA AUTO11 + TAD I AUTO10 + DCA XONEDS + TAD I AUTO10 + DCA YONEDS + TAD TWOOUT + SZA CLA + JMP I ITWOEX +TWDLOP, TAD I AUTO10 + DCA XTWODS + TAD I AUTO10 + DCA YTWODS + JMS I VECTOR + ISZ AUTO11 + JMP .+3 + JMP I .+1 +IPRODS, PRODIS + TAD XTWODS + DCA XONEDS + TAD YTWODS + DCA YONEDS + JMP TWDLOP +COLIDE, COLLID +IONEEX, ONEEXP +ITWOEX, TWOEXP +DISPLY, 0 + CLA + TAD XONEDS + CIA + TAD XTWODS + JMS DISHFT + DCA DIXTEM + TAD YONEDS + CIA + TAD YTWODS + JMS DISHFT + DCA DIYTEM + TAD M4 + DCA DISCNT +DISLOP, TAD XONEDS + TAD DIXTEM + DCA XONEDS + TAD YONEDS + TAD DIYTEM + DCA YONEDS + TAD XONEDS +/ RTR + DXC DXL + CLA + TAD YONEDS + DYC DYL DIS + CLA + ISZ DISCNT + JMP DISLOP + JMP I DISPLY +DISHFT, 0 + CLL + SPA + CML IAC + RAR + CLL + SPA + CML IAC + RAR + JMP I DISHFT + *1600 +PRODIS, CLA CLL + TAD BUFST + DCA BUFTMP +/ DSB 2 +PROLOP, TAD I BUFTMP + SNA + JMP EXPIRE + IAC + DCA I BUFTMP + ISZ BUFTMP + TAD I BUFTMP + ISZ BUFTMP + TAD I BUFTMP + DCA I BUFTMP + TAD I BUFTMP + DCA PROX + ISZ BUFTMP + TAD I BUFTMP + ISZ BUFTMP + TAD I BUFTMP + DCA I BUFTMP + TAD I BUFTMP + DCA PROY + TAD PROX +/ RTR +/ RAR + DXC DXL + CLA + TAD PROY +/ RTR + DYC DYL DIS + CLA + JMS I CHKOUT + ISZ BUFTMP + TAD BUFTMP + TAD BUFLIM + SZA CLA + JMP PROLOP +/ BEGIN. TURNS OUT THAT ROUGHLY 2 +FINISH, TAD GAMOVR + SZA CLA + JMP I ENDGAM +/ TAD M400 + CLA CLL + TAD INTCNT + CIA + JMP . +ENDGAM, JOBLOP +EXPIRE, TAD BUFTMP + TAD P5 + DCA BUFTMP + TAD BUFTMP + TAD BUFLIM + SZA CLA + JMP PROLOP + JMP FINISH +BUFST, DISBUF+101 +BUFLIM, -DISBUF-175 +CHKOUT, CHECK +RESE1, 0 + TAD MRES + DCA RESCNT +RESLOP, TAD RESPNT + TAD P5 + DCA RESPNT + TAD RESPNT + TAD BUFLIM + SZA CLA + JMP RESCON + TAD BUFST + DCA RESPNT +RESCON, TAD I RESPNT + SNA CLA + JMP RESFND + ISZ RESCNT + JMP RESLOP + HLT +RESFND, CMA + TAD RESPNT + DCA AUTO16 + JMP I RESE1 +MRES, -14 +RESCNT, 0 +RESPNT, 0 +SETBUF, 0 + CMA + TAD BUFST + DCA AUTO16 + TAD BUFST + DCA BUFTMP + TAD BUFST + DCA RESPNT + TAD BUFST + DCA SETPNT +SETLOP, DCA I SETPNT + ISZ SETPNT + TAD SETPNT + TAD BUFLIM + SZA CLA + JMP SETLOP + JMP I SETBUF +SETPNT, 0 + *2000 +CHECK, 0 + TAD ONEFLG + SZA CLA + JMP CHECK2 + TAD ONEOUT + SZA CLA + JMP CHECK2 + TAD PROX + CIA + TAD ONEPEX + SPA + CIA + TAD LIMIT + SMA CLA + JMP CHECK2 + TAD PROY + CIA + TAD ONEPEY + SPA + CIA + TAD LIMIT + SMA CLA + JMP CHECK2 + TAD MEXP + DCA ONEOUT + JMS CUTOUT +CHECK2, TAD TWOFLG + SZA CLA + JMP I CHECK + TAD TWOOUT + SZA CLA + JMP I CHECK + TAD PROX + CIA + TAD TWOPEX + SPA + CIA + TAD LIMIT + SMA CLA + JMP I CHECK + TAD PROY + CIA + TAD TWOPEY + SPA + CIA + TAD LIMIT + SMA CLA + JMP I CHECK + TAD MEXP + DCA TWOOUT + JMS CUTOUT + JMP I CHECK +LIMIT, -120 +CUTOUT, 0 + TAD M4 + TAD BUFTMP + DCA CUTPNT + DCA I CUTPNT + JMP I CUTOUT +CUTPNT, 0 +COLLID, 0 + TAD ONEFLG + SZA CLA + JMP I COLLID + TAD TWOFLG + SZA CLA + JMP I COLLID + TAD ONEOUT + SZA CLA + JMP I COLLID + TAD TWOOUT + SZA CLA + JMP I COLLID + TAD ONEPEX + CIA + TAD TWOPEX + SPA + CIA + TAD COLLIM + SMA CLA + JMP I COLLID + TAD ONEPEY + CIA + TAD TWOPEY + SPA + CIA + TAD COLLIM + SMA CLA + JMP I COLLID + TAD MEXP + DCA ONEOUT + TAD MEXP + DCA TWOOUT + JMP I COLLID +COLLIM, -300 + *2200 +HYPSET, DCA RTNFLG + TAD RTNFLG + SZA CLA + TAD ONEDIF + TAD TWOLST + DCA AUTO15 + CLCA + + DCA AUTO17 + TAD I AUTO17 + AND TIMOUT + CIA + DCA I AUTO15 + TAD I AUTO17 + JMS I THEADJ + DCA I AUTO15 + TAD I AUTO17 + JMS VEESET + DCA I AUTO15 + TAD I AUTO17 + JMS VEESET + DCA I AUTO15 + TAD I AUTO17 + DCA I AUTO15 + TAD I AUTO17 + DCA I AUTO15 + TAD I AUTO17 + AND TIMOUT + TAD MHYP /ABOUT 3 + SMA CLA + JMP HYPRET + TAD RTNFLG + SZA CLA + TAD ONEDIF + TAD OUTLOC + DCA VEESET + TAD MEXP + DCA I VEESET +HYPRET, ISZ RTNFLG + JMP I TWORTN + JMP I ONERTN +TIMOUT, 777 +ONEDIF, ONEFLG-TWOFLG +TWOLST, TWOFLG-1 +RTNFLG, 0 +ONERTN, TWOUP +TWORTN, ONESET +OUTLOC, TWOOUT +MHYP, -200 +VEESET, 0 + CLL + SPA + CML + AND HM177 + SZL CLL + CIA + JMP I VEESET +HM177, 177 +ONEEXP, CLA CLL + TAD ONETHE + TAD INCONE + DCA ONETHE + JMS I IXPDIS + ISZ ONEOUT + JMP I NOWTWO + IAC + DCA ONEFLG + IAC + DCA ONEFIN + TAD TWOFIN + SNA CLA + JMP I NOWTWO + JMP I TIEUP +TWOEXP, CLA CLL + TAD TWOTHE + TAD INCTWO + DCA TWOTHE + JMS I IXPDIS + ISZ TWOOUT + JMP I NOWPRO + IAC + DCA TWOFLG + IAC + DCA TWOFIN + + TAD ONEFIN + SZA CLA + JMP I TIEUP + JMP I NOWPRO +NOWTWO, TWODIS +NOWPRO, PRODIS +TIEUP, NOWIN +IXPDIS, EXPDIS +INCONE, 55 +INCTWO, 55 + *2400 +EXPDIS, 0 + TAD I AUTO10 + DCA XTWODS + TAD I AUTO10 + DCA YTWODS + TAD XTWODS + CIA + TAD XONEDS + DCA DIXTEM + TAD YTWODS + CIA + TAD YONEDS + DCA DIYTEM + TAD M4 + DCA DISCNT + +EXPLOP, TAD XONEDS + TAD DIXTEM + DCA XONEDS + TAD YONEDS + TAD DIYTEM + DCA YONEDS + TAD XONEDS +/ RTR +/ RAR + JMS I IVCLDX + CLA + TAD YONEDS + JMS I IVCLDY + CLA + ISZ DISCNT + JMP EXPLOP + ISZ AUTO11 + SKP + JMP I EXPDIS + TAD XTWODS + DCA XONEDS + TAD YTWODS + DCA YONEDS + JMP EXPDIS+1 +VEELIM, 0 + DCA VEEHLD + TAD VEEHLD + SMA + JMP VEEPOS + TAD VEEMAX + SMA CLA + JMP VEECLR + TAD VEEMIN + JMP I VEELIM +VEEPOS, TAD VEEMIN + SPA CLA + JMP VEECLR + TAD VEEMAX + JMP I VEELIM +VEECLR, TAD VEEHLD + JMP I VEELIM +VEEHLD, 0 +VEEMIN, -140 +VEEMAX, 140 +THEAJI, 0 + SMA + JMP .+3 + TAD P550 + JMP .-3 + TAD M550 + SMA + JMP .-2 + TAD P550 + JMP I THEAJI +ONEWIN, 0 + TAD MES1 + DCA MESS + IAC + DCA GAMOVR + JMP I ONEWIN +TWOWIN, 0 + TAD MES2 + DCA MESS + IAC + DCA GAMOVR + JMP I TWOWIN +NOWIN, TAD MES4 + DCA MESS + IAC + DCA GAMOVR + +JOBLOP, +/ DSB 1 + TAD MES0 + JMS I MESOUT + TAD MESS + JMS I MESOUT + TAD MES5 + JMS I MESOUT + TAD MES3 + JMS I MESOUT +FINITO, JMP JOBLOP +MES0, MESS0 +MES1, MESS1 +MES2, MESS2 +MES3, MESS3 +MES4, MESS4 +MES5, MESS5 +MESS, 0 + *6400 +SINEIN, 0 + DCA SINARG + TAD SINEIN + DCA I SINPSH + ISZ SINPSH + TAD SINARG + SZA + JMP SINNG2 +SINPOP, CLA CLL CMA + TAD SINPSH + DCA SINPSH + TAD I SINPSH + DCA SINEIN + TAD SINARG + JMP I SINEIN +SINNG2, SMA + JMP SINPOS + CIA + JMS SINEIN +SINNEG, CIA + DCA SINARG + JMP SINPOP +SINPOS, TAD M264 + SPA + JMP .+2 + JMP SINNEG-1 + TAD P132 + SPA + JMP SINELK + SZA CLA + JMP .+3 + TAD P37 + JMP SINNEG+1 + TAD SINARG + TAD M264 + JMP SINNEG-1 +SINELK, TAD P132 + TAD SINTAB + DCA SINEIN + TAD I SINEIN + DCA SINARG + JMP SINPOP +SINARG, 0 +SINPSH, SINLST +SINLST, 0 + 0 + 0 + 0 + 0 + 0 +SINTAB, SINES-1 +COSINI, 0 + CIA + TAD P132 + JMS SINEIN + JMP I COSINI +SINES, 00 + 01 + 01 + 02 + 02 + 03 + 03 + 04 + 05 + 05 + 06 + 06 + 07 + 07 + 10 + 10 + 11 + 11 + 12 + 12 + 13 + 13 + 14 + 15 + 15 + 16 + 16 + 17 + 17 + 20 + 20 + 20 + 21 + 21 + 22 + 22 + 23 + 23 + 24 + 24 + 25 + 25 + 25 + 26 + 26 + 27 + 27 + 27 + 30 + 30 + 30 + 31 + 31 + 31 + 32 + 32 + 32 + 33 + 33 + 33 + 33 + 34 + 34 + 34 + 35 + 35 + 35 + 35 + 35 + 36 + 36 + 36 + 36 + 36 + 36 + 37 + 37 + 37 + 37 + 37 + 37 + 37 + 37 + 37 + 37 + 37 + 37 + 37 + 37 +MULTI, 0 + CLL + SPA + CMA CML IAC + DCA MULMP1 + DCA MULMP5 + TAD I MULTI + SNA + JMP MULPSN+2 + SPA + CMA CML IAC + DCA MULMP2 + TAD MULTHR + DCA MULMP3 +MULMP4, TAD MULMP1 + RAR + DCA MULMP1 + TAD MULMP5 + SZL + TAD MULMP2 + CLL RAR + DCA MULMP5 + ISZ MULMP3 + JMP MULMP4 + TAD MULMP1 + RAR +MULPSN, SZL + JMP MULCMP + DCA MULMP1 + TAD MULMP5 +MULMPZ, ISZ MULTI + JMP I MULTI +MULCMP, CMA CLL IAC + DCA MULMP1 + TAD MULMP5 + CMA + SZL + IAC + JMP MULMPZ +MULTHR, 7764 +MULMP1, 0 +MULMP5, 0 +MULMP2, 0 +MULMP3, 0 +SHIFTR, 0 + CLL + SPA + CML IAC + RAR + JMP I SHIFTR +POSCAL, 0 + TAD CALSIN + DCA T10SIN + TAD T10SIN + CLL RAL + DCA T20SIN + TAD T10SIN + TAD T20SIN + DCA T30SIN + TAD CALCOS + DCA T10COS + TAD T10COS + CLL RAL + DCA T20COS + TAD T10COS + TAD T20COS + DCA T30COS + JMP I POSCAL +VDIV, 0 + SMA + JMP VPLUS +VMINUS, CMA IAC + RTR + AND P1777 + CMA IAC + JMP I VDIV +VPLUS, RTR + AND P1777 + JMP I VDIV +VCLDX, 0 + JMS VDIV + DISD + JMP .-1 + DIXY + DILX + JMP I VCLDX +VCLDY, 0 + JMS VDIV + DILY + JMP I VCLDY +P1777, 1777 + *7000 +CHARS, 0 + DCA ADDR + TAD I ADDR + RTR + RTR + RTR + JMS CHAR + SKP + JMP I CHARS + TAD I ADDR + ISZ ADDR + JMS CHAR + JMP CHARS+2 + JMP I CHARS +CHAR, 0 + AND K77 + CLL RAL + TAD TABLE + DCA POINT + CMA + DCA COUNT2 + TAD I POINT + ISZ POINT + SNA + JMP SPCHAR + DCA CURPLT +XPLOT, TAD KM6 + DCA COUNT6 + TAD YVALUE + DCA YTEMP + TAD XVALUE + DILX + TAD XINCR + DCA XVALUE +YPLOT, TAD CURPLT + CLL RAL + DCA CURPLT + SNL + JMP CNTINU + TAD YTEMP + DILY + DISD + JMP .-1 + DIXY + CLA CLL + TAD CURPLT + SNA CLA + JMP WRDEND +CNTINU, TAD YTEMP + TAD YINCR + DCA YTEMP + ISZ COUNT6 + JMP YPLOT + JMP XPLOT +WRDEND, ISZ COUNT2 + JMP EXIT + TAD I POINT + SZA + JMP XPLOT-1 +EXIT, TAD XVALUE + TAD XINCR + DCA XVALUE + JMP I CHAR +SPCHAR, TAD I POINT + DCA POINT + JMP I POINT +SPACE, TAD XINCR + CLL RTL + JMP EXIT +CRLF, TAD INITX + DCA XVALUE +LF, TAD YINCR + CLL RTL + CLL CIA RAL + TAD YVALUE + DCA YVALUE + JMP I CHAR +RESET, TAD INITX + DCA XVALUE + TAD INITY + JMP RESET-2 +TERM, ISZ CHAR + JMP I CHAR +INITX, 0 +INITY, 327 +XVALUE, 0 +YVALUE, 0 +XINCR, 6 +YINCR, 10 +YTEMP, 0 +CURPLT, 0 +ADDR, 0 +COUNT6, 0 +COUNT2, 0 +KM6, -6 +K77, 77 +POINT, 0 +TABLE, .+1 + 0 + TERM + 7611 + 1176 + 7745 + 4532 + 3641 + 4122 + 7741 + 4136 + 7745 + 4541 + 7705 + 501 + 7741 + 5173 + 7710 + 1077 + 4177 + 4100 + 2040 + 4037 + 7714 + 2241 + 7740 + 4040 + 7702 + 277 + 7706 + 3077 + 7741 + 4177 + 7705 + 502 + 3641 + 6176 + 7715 + 2542 + 2245 + 5122 + 177 + 100 + 3740 + 4037 + 1720 + 4037 + 7730 + 3077 + 4136 + 3641 + 374 + 7403 + 6151 + 4543 + 7741 + 0 + 204 + 1020 + 4177 + 0 + 436 + 400 + 0 + RESET + 0 + SPACE + 5600 + 0 + 303 + 0 + 1477 + 7714 + 2277 + 2200 + 2313 + 6462 + 7777 + 7777 + 300 + 0 + 3641 + 0 + 4136 + 0 + 4040 + 4040 + 1034 + 1000 + 0 + LF + 1010 + 1000 + 4000 + 0 + 2010 / + 402 + 3641 + 4136 + 4442 + 7740 + 4261 + 5146 + 2145 + 5321 + 1710 + 1077 + 4745 + 4531 + 7750 + 5070 + 6111 + 503 + 2255 + 5522 + 705 + 577 + 2400 + 0 + 0 + CRLF + 1024 + 4200 + 1212 + 1200 + 4224 + 1000 + 255 + 300 +MESS0, 3773 +MESS5, 7340 + 4040 + 4040 + 4000 +MESS1, 1716 + 0500 +MESS2, 2427 + 1700 +MESS3, 2711 + 1623 + 4100 +MESS4, 1617 + 0217 + 0431 + 0000 + *7400 +DISBUF, 0 + $ +/////////////////////////// +////////////////////////// diff --git a/sw/SPACE/original-space.pal b/sw/SPACE/original-space.pal new file mode 100644 index 0000000..2d216a4 --- /dev/null +++ b/sw/SPACE/original-space.pal @@ -0,0 +1,2262 @@ +/ SPACE WAR +/ +/ INTERPLANETARY DEATH AND DESTRUCTION ON YOUR +/ LAB-8 +/ +/ EVAN SUITS +/ +/ THIS VERSION WORKS OFF EITHER THE BLUE RIBBON CONNECTOR OR THE +/ SR. WHEN THE PROGRAM IS STARTED (AT 0200) OR RESTARTED THE +/ SR WILL BE TESTED AND IF =0000 WILL BE USED FOR THE COMMAND +/ INPUT. OTHERWISE, THE BLUE RIBBON CONNECTOR (AX08 * C0-C7 * +/ XR OPTION ONLY) CONTINGENCY INPUTS WILL BE USED. +/ +/ WHEN THE PROGRAM IS STARTED THE TWO SHIPS SHOULD +/ APPEAR ON THE SCREEN WITH SHIP 'ONE' ON THE LEFT, SHIP +/ 'TWO' ON THE RIGHT. +/ +/ THE COMMAND WORD BIT ASSIGNMENTS ARE: +/ +/ SR BIT: C: FUNCTION: +/ +/ 0 0 SHIP ONE ROTATES LEFT +/ +/ 1 1 SHIP ONE ROTATES RIGHT +/ +/ 2 2 SHIP ONE ACCELERATES +/ +/ 3 3 SHIP ONE FIRES +/ +/ +/ +/ 8 4 SHIP TWO ROTATES LEFT +/ +/ 9 5 SHIP TWO ROTATES RIGHT +/ +/ 10 6 SHIP TWO ACCELERATES +/ +/ 11 7 SHIP TWO FIRES +/ +/ +/ +/ NOTE THAT TURNING RIGHT AND LEFT SIMULTANEOUSLY THROWS +/ THE SHIP INTO HYPERSPACE. IN THE CURRENT VERSION THE ODDS +/ ARE IN FAVOR OF YOUR MAKING IT BACK SAFELY. THE GAME IS OVER +/ WHEN ONE OR BOTH OF THE SHIPS HAVE BEEN DESTROYED AND THE +/ WINNER (IF ANY) IS IN NORMAL SPACE. WHEN THE WINNER +/ HAS BEEN ANNOUNCED, HIT ANY TTY KEY TO RESTART. +/ + + + +/ SYMBOL DEFINITIONS FOR PAL8-PAL10 + +ZTEN=6342 +OTEN=6344 + +XRIN=6331 +XRCL=6334 + +SKXK=6321 +CLXK=6352 + +DSB=6324 + +DXC=6301 +DYC=6311 +DXL=6302 +DYL=6312 +DIS=6304 + +CRF=6072 +CCF=6052 + + / +/ THIS PROGRAM RELIES ON THE PROGRAM INTERUPT FACILITY FOR +/ REAL WORLD TIMING PURPOSES. +/ + + *0 + + 0 /EFFECTIVE JMS 0 ON PROGRAM INTERUPT + JMP I 2 /EXIT IMMEDIATLY TO SERVICE ROUTINE + INTSER + +EMPTY, 0 /THESE LOCATIONS ARE RESERVED FOR +ODT1, 0 /DEBUGGERS, ETC. +ODT2, 0 +ODT3, 0 + +/ +/ ALL THE AUTO INDEX REGISTERS ARE NAMED BUT NOT ALL OF +/ THEM ARE USED. THE STATUS OF ANY GIVEN REGISTER CANNOT +/ BE DETERMINED AT ANY TIME EXCEPT BY CAREFUL INSPECTION OF +/ THE CODE. +/ + + *10 + +AUTO10, 0 +AUTO11, 0 +AUTO12, 0 +AUTO13, 0 +AUTO14, 0 +AUTO15, 0 +AUTO16, 0 +AUTO17, 0 + +/ +/ THE FOLLOWING ARE THE DATA FILES FOR THE TWO SPACE SHIPS +/ AS WELL AS CERTAIN OTHER PARAMETERS FOR CALCULATING POSITIONS +/ AND SO ON. THE ORDER OF THE LOCATIONS MUST BE PRESERVED +/ ALTHOUGH THE SIZE OF THE TABLES MAY BE VARIED +/ + + *20 + +ONEOUT, 0 /IF NON-ZERO CONTAINS REAMINING TIME OF EXPLOSION +ONECNT, 0 /NUMBER OF POINTS IN FIGURE TO BE DISPLAYED +ONEFLG, 0 /IN OR OUT OF NORMAL SPACE +ONETHE, 0 /ANGLE OF ORIENTATION ON SCREEN +ONEVEX, 0 /X COMPONENT OF VELOCITY +ONEVEY, 0 /Y COMPONENT OF VELOCITY +ONEPEX, 0 /X POSITION (12 BITS) +ONEPEY, 0 /Y POSITION (12 BITS) +ONESIN, 0 /SINE OF ANGLE +ONECOS, 0 /COSINE OF ANGLE +ONEFIN, 0 /SET WHEN EXPLOSION DIES OUT + +TWOOUT, 0 /SAME CONTENT AND ORDER +TWOCNT, 0 /AS ABOVE +TWOFLG, 0 +TWOTHE, 0 +TWOVEX, 0 +TWOVEY, 0 +TWOPEX, 0 +TWOPEY, 0 +TWOSIN, 0 +TWOCOS, 0 +TWOFIN, 0 + + +/ +/ THESE LOCATIONS ARE USED BY THE "VECTOR GENERATOR" IN +/ DISPLAYING THE FIGURES. A FOUR DOT VECTOR WILL BE DRAWN +/ FROM XONE,YONE TO XTWO,YTWO WITH STEPS OF SIZE DIXTEM,DIYTEM +/ + +XONEDS, 0 +YONEDS, 0 +XTWODS, 0 +YTWODS, 0 +DIXTEM, 0 +DIYTEM, 0 +DISCNT, 0 + + +/ +/ THE NEXT LOCATIONS ARE USED BY CALPOS TO DO A FAST +/ MULTIPLY TO HELP CALCULATE THE DISPLAY FILES. +/ +T10SIN, 0 +T20SIN, 0 +T30SIN, 0 +T10COS, 0 +T20COS, 0 +T30COS, 0 + +CALSIN, 0 +CALCOS, 0 + + +/ +/ NOW COME THE VARIOUS ODDS AND ENDS ONE USUALLY FINDS ON +/ PAGE ZERO +/ + +SINE, SINEIN +COSINE, COSINI +MULT, MULTI +RSHIFT, SHIFTR +VECTOR, DISPLY +CALPOS, POSCAL +INTWRD, 0 +INTCNT, 0 +CLOCK, 0 +HYPER, HYPSET +MESOUT, CHARS +THEADJ, THEAJI +VEESCL, VEELIM +ISHFT, DISHFT +RESET1, RESE1 +GAMOVR, 0 +ACCFLG, 0 +ACCPER, -30 +MEXP, -400 + +PROX, 0 +PROY, 0 +PROLIF, -360 +BUFTMP, 0 +ONEFIL, DISBUF +TWOFIL, DISBUF+40 + +P5, 5 +P10, 10 +P17, 17 +P20, 20 +P37, 37 +P40, 40 +P100, 100 +P132, 132 +P200, 200 +P400, 400 +P550, 550 +P3777, 3777 + +M4, -4 +M6, -6 +M10, -10 +M11, -11 +M264, -264 +M200, -200 +M400, -400 +M550, -550 + + +/ +/ THE PROGRAM MAY BE STARTED OR RESTARTED AT ANYTIME AT 0200. +/ THE DATA FILE ON PAGE ZERO IS CLEARED, ALL FLAGS INITIALIZED, +/ AND THE SR EXAMINED. IF THE SR=0 THE DISPLAY UPDATE ROUTINES +/ ARE SET TO PICK UP THE STATUS WORD FROM THE SR. IF THE SR +/ DOES NOT EQUAL ZERO, THE STATUS WORD IS READ FROM THE EIGHT +/ CONTINGENCY INPUTS ON THE BLUE RIBBON CONNECTOR OF THE AX08 +/ (XR OPTION ONLY). JUMP IS THEN TO THE DISPLAY +/ FILE UPDATE TO START OFF THE GAME. +/ + + *200 + +START, CLA CLL /START OR RESTART HERE ANY OLD TIME + LAS /SR + SNA CLA + TAD SWRD /USE THE SR + TAD XROPT /USE THE BLUE RIBBON CONNECTOR + DCA COLDST /AND LEAVE IN THE TRAP LOCATION + +RESTRT, CLA CMA + XRCL + CLA CLL + + TAD P17 /FIRST CLEAR THE POSITION AND DATA + DCA AUTO10 /TABLES OF THE TWO SHIPS + TAD TABLEN + DCA AUTO11 + DCA I AUTO10 + ISZ AUTO11 + JMP .-2 + + TAD STRT1 /SET THE STARTING POSITIONS OF THE + DCA ONEPEX /TWO SHIPS + TAD STRT2 + DCA TWOPEX + TAD P37 /SET TRIG FUNCTIONS JUST IN CASE + DCA ONECOS + TAD P37 + DCA TWOCOS /ZERO DEGREES IS POINTING STRAIGHT UP + TAD ACCPER /SET COUNT FOR VELOCITY INCREASE + DCA ACCFLG + DCA ONEFIN /CLEAR ALL GAME END FLAGS + DCA TWOFIN + DCA GAMOVR + JMS I BUFSET /RESET ALL PROJECTILE DISPLAY BUFFERS + TAD P400 /START UP THE CRYSTAL CLOCK IN THE AX08 + ZTEN + OTEN + TCF /CLEAR OTHER REMAINING LIKELY FLAGS + PCF + RRB + CRF + CCF + CLA + JMP COLDST /AND GO TO IT + + +/ +/ UPDATE IS REACHED WHENEVER THE PROGRAM IS STARTED OR THE +/ CLOCK COUNT OVERFLOWS INDICATING TIME TO RECALCULATE THE +/ THE DISPLAY FILES AND REFRESH THE DISPLAY. THE INTERUPT +/ COUNT IS RESTORED, THE STATUS WORD IS PICKED UP FROM EITHER +/ THE SR OR BRC, AND THE RECALCULATION PROCESS BEGUN. +/ + +UPDATE, CLA CLL /HERE ON CLOCK COUNT OVERFLOW. + /START NEXT SWEEP +COLDST, 0 /TRAP TO READ SR OR BRC + LAS /HERE FOR SR + DCA INTWRD /STORE TEMPORARILY + TAD INTWRD /MASK OUT LEFTMOST 4 BITS + RTR /FOR NUMBER ONE + RTR + AND LFTHAF + DCA INTTEM /AND STORE + TAD INTWRD /MASK OUT RIGHTMOST BITS FOR NUMBER TWO + AND RYTHAF + TAD INTTEM /ADD TOGETHER + JMP .+3 /AND CONTINUE + +CODST, XRIN /HERE FOR BRC - PICK UP AND CLEAR + XRCL + DCA INTWRD /CONTINUE + TAD M550 /RESTORE INTERUPT COUNT BEFORE NEXT + DCA INTCNT /UPDATE + ION /GET READY FOR THE NEXT CYCLE + TAD ACCFLG /ALLOW VELOCITY INCREASE THIS TIME? + IAC /ONLY WHEN ACCFLG=0 + SMA SZA + TAD ACCPER /IF ZERO, RESET COUNT + DCA ACCFLG + + JMP I .+1 /NOW GET DOWN TO WORK. + ONEUP + +BUFSET, SETBUF +TABLEN, AUTO17-CALCOS +INTTEM, 0 +LFTHAF, 0360 +RYTHAF, 0017 +STRT1, 1000 +STRT2, -1000 +SWRD, 2000-CODST +XROPT, JMP CODST + + +/ +/ THIS IS THE INTERUPT SERVICE ROUTINE. MOST OF THE +/ INTERUPTS WILL BE FROM THE CRYSTAL CLOCK WHICH WILL BE +/ COUNTED AND UNLESS THE COUNT OVERFLOWS THE INTERUPT IS +/ DISMISSED IMMEDIATLY. IF THE COUNT OVER FLOWS, JMP IS TO +/ UPDATE WITH IOF. +/ +/ SPECIAL CASE IS KEYBOARD INTERUPT WHEN THE GAMOVR FLAG IS +/ SET IN WHICH CASE THE GAME IS RESTARTED. +/ +/ UNEXPECTED INTERUPTS ARE COUNTED AND AFTER ENOUGH OF THEM +/ HAPPEN THE PROGRAM HALTS. IF THIS HAPPENS RELOAD OR FIND THE +/ STRANGE FLAG +/ + +INTSER, DCA INTACC /HERE RIGHT AFTER INTERUPT - STORE + RAR /AC AND LINK + DCA INTLNK /FOR POSSIBLE CONTINUATION + SKXK /WAS IT THE CRYSTAL CLOCK? + JMP INTBUS /NO TRY SOMETHING ELSE + CLXK /YES CLEAR THE FLAG + ISZ CLOCK /AND BUMP CLOCK COUNTER + NOP /IGNORE OVERFLOW + ISZ INTCNT /TIME FOR AN UPDATE? + JMP INTRET /NO, DISMISS THE INTERUPT + JMP UPDATE /YES, GO TO IT + +INTBUS, KSF /HERE ON NON-CLOCK INTERUPT + JMP .+5 /NOT THE KEYBOARD + KCC /CLEAR KEYBOARD FLAG + TAD GAMOVR /IS THE GAMEOVER + SZA CLA + JMP RESTRT /YES, RESTART + TCF /NO, HELL WITH IT + ISZ INTGLH /COUNT ONE BADDIE + SKP + HLT /HALT IF TOO MANY BADDIES + +INTRET, CLA CLL /HERE TO DISMISS THE INTERUPT + TAD INTLNK + RAL + TAD INTACC + ION + JMP I 0 + +INTACC, 0 +INTLNK, 0 +INTGLH, 0 + + +/ +/ NOW BEGINS THE GREAT UPDATE PROCEEDURE, FIRST FOR SHIP +/ NUMBER ONE (THE DELTA SHAPED SHIP WHICH APPEARS ON +/ THE LEFT AT THE START OF THE GAME). IF ALIVE THE STATUS +/ WORD (INTWRD) IS TESTED FOR REQUESTS FOR LEFT TURN, +/ RIGHT TURN, THRUST ON, AND LAUNCH PROJECTILE. THESE ACTIONS +/ MAY OR MAY NOT BE ACTED UPON DEPENDING ON COUNTS AND FLAGS. +/ WHEN THIS IS COMPLETE THE SAME OPERATION IS PERFORMED FOR +/ NUMBER TWO. +/ + + *400 + +ONEUP, TAD ONEFLG /FIRST SEE IF IT'S IN NORMAL SPACE + SNA + JMP ONEOK /YES IT IS + IAC /NO, BUT IS IT JUST COMING OUT? + SNA + TAD ONEFIN /YES, THROW BACK IN IF ALREADY DESTROYED + DCA ONEFLG /OTHERWISE JUST COUNT ONE + JMP I ITWOUP /AND GO TO FIX UP NUMBER TWO + +ONEOK, TAD ONEOUT /IN NORMAL SPACE - IS IT EXPLODING? + SZA CLA + JMP ONEFIG /IF YES, ALLOW NO CONTROLS + TAD TWOFIN /HAS THE ENEMY BEEN VANQUISHED? + SZA CLA + JMS I ONEWN /YES, SIGNAL VICTORY + TAD INTWRD /NOW BEGIN TEST OF REQUEST + AND OP300 /LEFT AND RIGHT TURN TOGETHER MEAN HYPERSPACE! + TAD OM300 /TEST BITS 4 AND 5 + SZA CLA + JMP ONELEF /NOPE, CONTINUE + CMA /YES, CALL HYPER WITH AC=-1 FOR NUMBER ONE + JMP I HYPER +ONELEF, TAD INTWRD /REQUEST FOR LEFT TURN? + AND P200 /TEST BIT 4 + SNA CLA + JMP ONERYT /NO + CLA CLL CMA /YES DECREMENT ANGLE + JMP ONEFIG + +ONERYT, TAD INTWRD /HOW ABOUT RIGHT TURN + AND P100 /TEST BIT 5 + SZA CLA + IAC /YES, INCREMENT ANGLE + +ONEFIG, TAD ONETHE /PICK UP AND ADJUST ANGLE (MAYBE) + JMS I THEADJ /BRING BACK WITHIN LIMITS OF TRIG FUNCTIONS + DCA ONETHE /AND STORE + TAD ONETHE /FIND THEM TRIG FUNCTIONS + JMS I SINE /AND STORE ONCE AND FOR ALL + DCA ONESIN /IN THE APPROPRIATE PLACES + TAD ONETHE + JMS I COSINE + DCA ONECOS + TAD ONEOUT /DO NOT ALLOW THRUST IF EXPLODING + SZA CLA + JMP ONEVEL + + + +ONEMOV, TAD ACCFLG /ALLOW ANY VELOCITY INCREASE THIS CYCLE? + SZA CLA + JMP ONEVEL /NOPE + TAD INTWRD /YES, ANY REQUESTED? + AND P40 /TEST BIT 6 + SNA CLA + JMP ONEVEL /NONE REQUESTED + TAD ONECOS /YES, ADD IN VELOCITY INCREMENT DEPENDING + TAD ONEVEY /ON ORIENTATION + JMS I VEESCL /BUT DO NOT ALLOW TO EXCEED MAXIMUM + DCA ONEVEY /AND STORE + TAD ONESIN /DO THE SAME FOR THE OTHER (X) COMPONENT + TAD ONEVEX + JMS I VEESCL + DCA ONEVEX + + + +ONEVEL, TAD ONEVEX /NOW UPDATE THE POSITION WITH THE + JMS I ISHFT /VELOCITY COMPONENTS DIVIDED BY 4 + JMS I ISHFT /THIS MAINTAINS MAXIMUM RESOLUTION + TAD ONEPEX + DCA ONEPEX /IGNORE ANY OVERFLOW + TAD ONEVEY /DO THE SAME FOR Y COORDINATE + JMS I ISHFT /AND VELOCITY COMPONENT + JMS I ISHFT + TAD ONEPEY + DCA ONEPEY + TAD ONEOUT /DO NOT ALLOW PROJECTILE LAUNCH IF + SZA CLA /EXPLODING + JMP I ITWOUP + + + +ONELNC, TAD LNC1FG /OTHERWISE, SEE IF RELOAD IS FINISHED + SNA CLA + JMP .+3 + ISZ LNC1FG /NO, CONTINUE RELOADING + JMP I ITWOUP /AND EXIT + TAD INTWRD /YES, READY TO LAUNCH, TRIGGER BEEN PULLED? + AND P20 /TEST BIT7 + SNA CLA + JMP I ITWOUP /NO, WAIT FOR A BETTER SHOT + /.....I GUESS..... + TAD PROLIF /YES, SET CYCLE COUNT FOR THIS LAUNCH + DCA I AUTO16 /AUTO16 ALWAYS POINTS AT THE NEXT SLOT IN THE FILE + TAD ONEVEX /ADD SHIPS VELOCITY (SCALED OF COURSE) + JMS I ISHFT /TO ORIENTATION TO EXTABLISH X VELOCITY + JMS I RSHIFT /COMPONENT OF PROJECTILE + TAD ONESIN + JMS I RSHIFT /AND STICK IT IN THE FILE + DCA I AUTO16 + TAD ONESIN /MOVE THE LAUNCH POINT OUTSIDE THE + CLL RTL /SHIP OF ORIGIN + TAD ONEPEX + DCA I AUTO16 /AND STORE X POSITION + TAD ONEVEY /NOW DO THE SAME FOR THE Y VELOCITY AND + JMS I ISHFT /POSITION + JMS I RSHIFT + TAD ONECOS + JMS I RSHIFT + DCA I AUTO16 + TAD ONECOS + CLL RTL + TAD ONEPEY + DCA I AUTO16 + TAD M200 /START RELOAD CYCLE + DCA LNC1FG + JMS I RESET1 /RESET AUTO16 TO NEXT HOLE + + JMP I .+1 /NOW TO FIX IT UP WITH NUMBER TWO +ITWOUP, TWOUP + +LNC1FG, 0 /PROJECTILE LAUNCH ENABLE + +OP300, 300 /HYPERSPACE REQUEST CODE BITS 4 AND 5 +OM300, -300 +ONEWN, ONEWIN /POINTER TO VICTORY MESSAGE + + +/ +/ HERE BEGINS THE UPDATE PROCEEDURE FOR SHIP NUMBER TWO. +/ OPERATION IS THE SAME AS FOR NUMBER ONE ABOVE. +/ + + *600 + +TWOUP, TAD TWOFLG /FIRST SEE IF IT'S IN NORMAL SPACE + SNA + JMP TWOOK /YES, CONTINUE + IAC /NO, BUMP COUNT AND TEST FOR REENTRY + SNA + TAD TWOFIN /IF RE-ENTERING THROW BACK OUT IF FINISHED + DCA TWOFLG /AND CONTINUE + JMP I IONEST + +TWOOK, TAD TWOOUT /HERE WHEN READY TO UPDATE IN NORMAL SPACE + SZA CLA /IS IT EXPLODING? + JMP TWOFIG /YES DO NOT ALLOW HYPERSPACE + TAD ONEFIN /DID WE JUST WIN? + SZA CLA + JMS I TWOWN /YES ENABLE END OF GAME MESSAGE + TAD INTWRD /TEST FOR HYPERSPACE REQUEST + AND OP14 + TAD OM14 /BITS 8 AND 9 MUST BE SET + SNA CLA + JMP I HYPER /8 AND 9 SET. ENTER HYPER ROUTINE WITH AC=0 + /FOR SHIP NUMBER 2 +TWOLEF, TAD INTWRD /TEST FOR LEFT TURN - BIT 8 + AND P10 + SNA CLA + JMP TWORYT /NOT SET + CLA CLL CMA /SET, DECREMENT TWOTHE BY 1 DEGREE + JMP TWOFIG /SKIP TEST FOR RIGHT TURN + +TWORYT, CLA CLL IAC RTL /TEST FOR RIGHT TURN - BIT 9 + AND INTWRD + SZA CLA + IAC /IF SET INCREMENT TWOTHE BY 1 DEGREE + +TWOFIG, TAD TWOTHE /UPDTAE TWOTHE + JMS I THEADJ /BRING TO WITHIN LIMITS OF SINE,COSINE + DCA TWOTHE /AND STORE + TAD TWOTHE + JMS I SINE /CALCULATE SINE AND COSINE FUNCTIONS + DCA TWOSIN /AND STORE IN DATA TABLE + TAD TWOTHE + JMS I COSINE + DCA TWOCOS + TAD TWOOUT /DO NOT ALLOW VELOCITY CHANGE IF EXPLODING + SZA CLA + JMP TWOVEL + + + +TWOMOV, TAD ACCFLG /NOW FOR ACCELERATION. TEST TO SEE IF ALLOWED + SZA CLA /DURING THIS UPDATE CYCLE + JMP TWOVEL /NOPE + CLL IAC RAL /YES, TEST FOR BIT 2 SET + AND INTWRD + SNA CLA + JMP TWOVEL /NOT SET + + TAD TWOSIN /UPDATE X VELOCITY COMPONENT BY SINE OF + TAD TWOVEX /ANGLE OF ORIENTATION + JMS I VEESCL /AND SCALE TO NOT EXCEED MAX + DCA TWOVEX /UPDATE Y COMPONENT WITH COSINE + + TAD TWOCOS + TAD TWOVEY + JMS I VEESCL + DCA TWOVEY + + + +TWOVEL, TAD TWOVEX /NOW UPDATE THE POSITION WITH THE VELOCITY + JMS I ISHFT /COMPONENTS/16 + JMS I ISHFT + TAD TWOPEX + DCA TWOPEX + TAD TWOVEY + JMS I ISHFT + JMS I ISHFT + TAD TWOPEY + DCA TWOPEY + TAD TWOOUT + SZA CLA + JMP I IONEST + + + +TWOLNC, TAD LNC2FG /NOW CHECK FOR PROJECTILE LAUNCH. FIRST + SNA CLA /TEST TO SEE IF RELOAD COMPLETE + JMP .+3 + ISZ LNC2FG /NO, COUNT ONE CYCLE AND EXIT + JMP I IONEST + IAC /YES, TEST TRIGGER BIT 11 + AND INTWRD + SNA CLA + JMP I IONEST /NOT SET, HELL WITH IT + + TAD PROLIF /OK, SET PROJECTILE LIFE + DCA I AUTO16 /AUTO16 IS ALWAYS POINTING AT THE NEXT SLOT + TAD TWOVEX /ADD SHIPS VELOCITY + JMS I ISHFT /(ADJUSTED) + JMS I RSHIFT + TAD TWOSIN /TO THAT OF PROJECTILE - AGAIN X COMPONENT + JMS I RSHIFT /FROM SINE OF ANGLE OF ORIENTATION + DCA I AUTO16 + TAD TWOSIN /SET INITIAL POSITION TO BE JUST AHEAD + CLL RTL /OF THE SHIP + TAD TWOPEX /X COMPONENT + DCA I AUTO16 + TAD TWOVEY /NOW THE Y COMPONENTS FROM Y VELOCITY + JMS I ISHFT /Y POSITION AND COSINE + JMS I RSHIFT + TAD TWOCOS + JMS I RSHIFT + DCA I AUTO16 + TAD TWOCOS + CLL RTL + TAD TWOPEY + DCA I AUTO16 + TAD M200 + DCA LNC2FG /200 CYCLES OF RELOAD + JMS I RESET1 /DRINK LEADEN DEATH, NUMBER ONE! + + JMP I .+1 /FINAL EXIT TO DISPLAY FILE CALCULATIONS +IONEST, ONESET + +LNC2FG, 0 /RELOAD COUNT + +OP14, 14 /HYPERSPACE CODE +OM14, -14 +TWOWN, TWOWIN + + +/ +/ HERE BEGINS THE DISPLAY CALCULATIONS FOR THE TWO SHIPS. AT +/ THIS POINT ONLY THE POSITION AND ORIENTATION OF EACH VESSEL +/ IS ONF INTEREST SINCE THE VELOCITY AND ALL THAT HAVE ALREADY +/ BEEN TAKEN CARE OF. FOR THE BOTH SHIPS THE DISPLAY FILES ARE +/ CALCULATED AS A SERIES OF PAIRS OF X,Y COORDINATES. BETWEEN +/ EACH PAIR OF POINTS A FOUR POINT VECTOR WILL BE DRAWN. THE +/ ACTUAL COORDINATES ARE CALCULATED AS DISPLACEMENTS +/ FROM THE CENTRAL PSOTION OF THE SHIP, TAKING INTO ACCOUNT THE +/ ANGLE OF ORIENTATION. THE FORMULAS FOLLOWED ARE: +/ +/ X(POINT)=X(BASE)+X(REL)*COS[THE]+Y(REL)*SINE[THE] +/ +/ Y(POINT)=Y(BASE)+Y(REL)*COS[THE]-X(REL)*SINE[THE] +/ +/ WHERE SINE[THE] AND COS[THE] ARE THE FUNCTIONS OF THE +/ ANGLE OF ORIENTATION, X(BASE) AND Y(BASE) ARE THE +/ COORDINATES OF THE SHIPS POSITION AND X(REL) AND Y(REL) +/ CORRESPOND TO DISPLACEMENT PAIRS DEPENDING ON THE SHAPE +/ OF THE FIGURE. ALL X AND Y RELS LIE WITHIN THE RANGE 0-3 AND +/ THERE FORE ALL NECESSARY DISPLACEMENTS FROM BASE COORDINATES +/ MAY BE CALCULATEDFROM DIFFERENT COMBINATIONS OF T10SIN, T20COS +/ ETC. THESE VALUES ARE CALCULATED BY A CALL TO POSCAL WITH THE SINE +/ AND COSINE OF THE ANGLE OF INTEREST IN CALSIN AND CALCOS. +/ +/ FOLLOWING THIS METHOD ANY FIGURE DESCRIBABLE WITH A 7 BY 7 +/ MATRIX OF POINTS MAY BE QUICKLY CALCULATED. +/ +/ BEGINNING AT ONESET DIFFERENT DISPLACEMENT PAIRS ARE CALCULATED +/ AND DEPOSITIED THROUGH AUTO10 TO FORM THE DISPLAY FILE FOR SHIP NUMBER ONE. +/ + + + *1000 + +ONESET, CLA CLL /BEGIN DISPLAY FILE FOR NUMBER ONE + TAD ONEFLG /DONT BOTHER IF NOT IN NORMAL SPACE + SZA CLA + JMP I ITWOST + TAD ONESIN /SET UP FOR MATRIX COMPONENT CALCULATIONS + DCA CALSIN + TAD ONECOS + DCA CALCOS + JMS I CALPOS /CALL THE CALCULATOR + +/ +/ CONSIDER THE 7 BY 7 MATRIX OF DISPLACEMENT POINTS WITH THE +/ CENTER AT 0,0 CORRESPONDING TO THE SHIPS POSITION. A SERIES +/ OF POINTS IS NOW DESCRIBED AROUND THIS CENTER USING THE +/ MULTIPLES OF THE TRIG FUNCTIONS JUST CALCULATED +/ SO THAT ANY POINT ON THE OUTLINE IS DESCRIBABLE AS X,Y +/ DISPLACED BY X,Y OF THE SHIP ITSELF +/ + + TAD ONEFIL /SET UP AUTO10 AS THE DISPLAY FILE + DCA AUTO10 /POINTER + TAD ONEPEX /THE FIRST POINT OF THE OUTLINE IS + TAD T30SIN + DCA I AUTO10 / 0,3 OR TOP CENTER + TAD ONEPEY + TAD T30COS + DCA I AUTO10 + + TAD T10COS + CIA /THE SECOND IS + TAD ONEPEX + DCA I AUTO10 / -1,0 + TAD T10SIN /OR JUST LEFT OF DEAD CENTER + TAD ONEPEY /AND SO ON + DCA I AUTO10 + + TAD T30SIN + TAD T30COS /THE THIRD POINT IS + CIA + TAD ONEPEX / -3,-3 + DCA I AUTO10 + TAD T30COS /OR BOTTOM LEFT HAND CORNER + CIA + TAD T30SIN + TAD ONEPEY + DCA I AUTO10 + + + + TAD T10SIN + CIA /FOURTH POINT + TAD ONEPEX + DCA I AUTO10 / 0,-1 + TAD T10COS + CIA /OR JUST BELOW CENTER + TAD ONEPEY + DCA I AUTO10 + +FLAM1, TAD INTWRD /TEST FOR POWER ON. IF ON, DRAW THE + AND P40 /FLAME WITH AN EXTRA POINT SOME + SNA CLA /DISTANCE DIRECTLY BELOW THE SHIP + JMP ONECON /POWER NOT ON - CONTINUE + TAD ONEOUT /DO NOT ALLOW IF EXPLODING + SZA CLA + JMP ONECON + + TAD ONFG1 /USE ONFG1 TO TURN THE FLAME ON AND + SNA /OFF TO MAKE IT FLICKER. DISPLAY THE + CLA CLL CMA RAL /FLAME ONE TIME OUT OF THREE + DCA ONFG1 + + ISZ ONFG1 + JMP ONECON /ONE OUT OF THREE TIMES THIS WILL SKIP + + TAD ONFG2 /VARY ALSO THE LENGHT OF THE FLAME + CMA /WITH LONG SHORT LONG SHORT + DCA ONFG2 + + TAD ONFG2 /TIP OF FLAME AT EITHER + SNA CLA + TAD T10SIN / 0,-4 OR + TAD T30SIN / 0,-3 + CIA + TAD ONEPEX + DCA I AUTO10 + TAD ONFG2 + SNA CLA + TAD T10COS + TAD T30COS + CIA + TAD ONEPEY + DCA I AUTO10 + + TAD T10SIN + CIA + TAD ONEPEX /RETURN DISPLAY TO 0,-1 + DCA I AUTO10 + TAD T10COS + CIA + TAD ONEPEY + DCA I AUTO10 + CLA CLL CMA RAL /ADD -2 TO POINT COUNT + + + +ONECON, TAD M6 /SET POINT COUNT TO -6 OR -8 + DCA ONECNT + + TAD T30SIN /CONTINUE WITH DISPLAY FILE - THIS POINT + CIA + TAD T30COS / AT 3,-3 + TAD ONEPEX / + DCA I AUTO10 /OR LOWER RIGHT HAND CORNER + TAD T30SIN + TAD T30COS + CIA + TAD ONEPEY + DCA I AUTO10 + + TAD T10COS /NEXT + TAD ONEPEX / + DCA I AUTO10 / 1,0 + TAD T10SIN / + CIA / OR JUST RIGHT OF CENTER + TAD ONEPEY + DCA I AUTO10 + + TAD T30SIN /FINALLY BACK TO + TAD ONEPEX / + DCA I AUTO10 / 0,3 + TAD T30COS / + TAD ONEPEY / TOP CENTE + DCA I AUTO10 + + JMP I ITWOST /NOW FOR NUMBER TWO +ITWOST, TWOSET + +ONFG1, 0 /USED TO COUNT FLICKERS +ONFG2, 0 /SHORT OR LONG FLAG + + +/ +/ HERE BEGINS THE DISPLAY FILE GENERATOR FOR SHIP TWO. +/ IT WORKS JUST LIKE THE ONE FOR NUMBER ONE BUT WITH +/ DIFFERENT DISPLACEMENT PAIRS AND TWO EXTRA POINTS +/ + + *1200 + +TWOSET, CLA CLL /DONT BOTHER IF NOT IN NORMAL SPACE + TAD TWOFLG + SZA CLA + JMP I IFILDS + TAD TWOSIN /SET UP TO HAVE DISPLACEMENT INCREMENTS + DCA CALSIN /CALCULATED + TAD TWOCOS + DCA CALCOS + JMS I CALPOS + + TAD TWOFIL /SET AUTO10 TO POINT TO SECOND DISPLAY + DCA AUTO10 /FILE + TAD T30SIN /FIRST POINT AT + TAD TWOPEX / + DCA I AUTO10 / 0,3 + TAD T30COS / + TAD TWOPEY / OR TOP CENTER + DCA I AUTO10 + + TAD T20COS + CIA + TAD T20SIN + TAD TWOPEX + DCA I AUTO10 + TAD T20SIN + TAD T20COS /SECOND POINT + TAD TWOPEY / -2,2 + DCA I AUTO10 + + TAD T20COS /THIRD POINT + CIA / -2,0 + TAD TWOPEX + DCA I AUTO10 + TAD T20SIN + TAD TWOPEY + DCA I AUTO10 + + + + TAD T20COS + TAD T30SIN + CIA + TAD TWOPEX /FOURTH POINT + DCA I AUTO10 / -2,-3 + TAD T30COS + CIA + TAD T20SIN + TAD TWOPEY + DCA I AUTO10 + + + + TAD T20SIN + CIA /NEXT + TAD TWOPEX / 0,-2 + DCA I AUTO10 + TAD T20COS + CIA + TAD TWOPEY + DCA I AUTO10 + +FLAM2, CLA CLL IAC RAL /NOW THE FLAME BIT. CHECK FOR POWER ON + AND INTWRD + SNA CLA + JMP TWOCON /NO, FORGET IT + TAD TWOOUT /NOT ALLOWED IF EXPLODING + SZA CLA + JMP TWOCON + + TAD TWFG1 /SET THE 1-3 FLICKER AS WITH #1 + SNA + CLA CLL CMA RAL + DCA TWFG1 + + ISZ TWFG1 /ALSO THE LENGHT VARIATION + JMP TWOCON + + TAD TWFG2 /EVERY OTHER TIME LONG + CMA + DCA TWFG2 + /FLAME TIP AT EITHER + TAD TWFG2 / 0,-3 + SNA CLA /OR + TAD T20SIN / 0,-5 + TAD T30SIN + CIA + TAD TWOPEX + DCA I AUTO10 + TAD TWFG2 + SNA CLA + TAD T20COS + TAD T30COS + CIA + TAD TWOPEY + DCA I AUTO10 + + TAD T20SIN /NOW BACK UP TO THE SHIP + CIA + TAD TWOPEX + DCA I AUTO10 + TAD T20COS + CIA + TAD TWOPEY + DCA I AUTO10 + + CLA CLL CMA RAL /ADD -2 TO POINT COUNT + + + +TWOCON, TAD M10 /SET POINT COUNT TO -8 OR -10 + DCA TWOCNT + + TAD T30SIN /CONTINUE WITH DISPLAY FILE + CIA /NEXT POINT AT 2,-3 + TAD T20COS + TAD TWOPEX + DCA I AUTO10 + TAD T30COS + TAD T20SIN + CIA + TAD TWOPEY + DCA I AUTO10 + + + + TAD T20COS /NEXT POINT + TAD TWOPEX / + DCA I AUTO10 / 2,0 + TAD T20SIN + CIA + TAD TWOPEY + DCA I AUTO10 + + TAD T20COS /AND THE NEXT AT + TAD T20SIN + TAD TWOPEX / 2,2 + DCA I AUTO10 + TAD T20SIN + CIA + TAD T20COS + TAD TWOPEY + DCA I AUTO10 + + TAD T30SIN + TAD TWOPEX + DCA I AUTO10 + TAD T30COS /AND THE LAST AT + TAD TWOPEY / + DCA I AUTO10 / 0,3 + + JMP I IFILDS /NOW TO DISPLAY THE WHOLE MESS +IFILDS, FILDIS + +TWFG1, 0 /FLIK THE FLAME +TWFG2, 0 /LONG OR SHORT + + +/ +/ HERE TO DISPLAY THE TWO SHIPS. CHECK FIRST FOR COLLISION +/ AND THEN SET THE TWO PAIRS OF COORDENATES FOR THE END +/ POINTS AND CALL THE "VECTOR GENERATOR" TO DRAW THE DOTS +/ IN BETWEEN. WHEN THE COUNT OVERFLOWS DO THE SAME FOR +/ NUMBER TWO. THEN EXIT TO DISPLAY ALL THE PROJECTILES. +/ + + *1400 + +FILDIS, CLA CLL /ALL SET TO GO + JMS I COLIDE /TEST FOR COLLISION FIRST + DSB 1 /IF NO COLLISION + TAD ONEFLG /SKIP NUMBER ONE IF NOT IN NORMAL + SZA CLA /SPACE + JMP TWODIS + + TAD ONEFIL /SET UP POINTERS TO DISPLAY FILE + DCA AUTO10 /FOR NUMBER ONE + TAD ONECNT /ALONG WITH VECTOR COUNT + DCA AUTO11 + TAD I AUTO10 /SET OUT THE FIRST POINT PAIR + DCA XONEDS + TAD I AUTO10 + DCA YONEDS + TAD ONEOUT /NORMAL DISPLAY OR EXPLOSION? + SZA CLA + JMP I IONEEX /GO ELSE WHERE FOR EXPLOSION + +FILONE, TAD I AUTO10 /STEP TO NEXT PAIR OF POINTS + DCA XTWODS /SET X AND Y TO NEW POINT + TAD I AUTO10 + DCA YTWODS + JMS I VECTOR /CALL THE DOT DRAWING MACHINE + ISZ AUTO11 + SKP /COUNT + JMP TWODIS /DO NUMBER TWO ON OVERFLOW + TAD XTWODS /SWAP POINTS FOR NEXT PAIR + DCA XONEDS + TAD YTWODS /THE GENERATOR DRAWS FROM ONE + DCA YONEDS /TOWARDS TWO + JMP FILONE + + + +TWODIS, TAD TWOFLG /HERE TO DO NUMBER TWO + SZA CLA /BUT NOT IF IN HYPER SPACE + JMP I IPRODS + + TAD TWOFIL /SET UP FILE POINTER AS IN ONE + DCA AUTO10 + TAD TWOCNT /AND THE COUNT + DCA AUTO11 + TAD I AUTO10 /I SUPPOSE THIS COULD BE A SUBROUTINE TOO + DCA XONEDS + TAD I AUTO10 + DCA YONEDS + TAD TWOOUT /IS IT EXPLODING? + SZA CLA + JMP I ITWOEX /YES, HOW EXCITING + +TWDLOP, TAD I AUTO10 /NO HOW DULL, STICK IN NEXT PAIR OF + DCA XTWODS /POINTS + TAD I AUTO10 + DCA YTWODS /AND CALL THE VECTOR SEQUENCE + JMS I VECTOR + ISZ AUTO11 + JMP .+3 + + JMP I .+1 /WHEN COUNT OVERFLOWS GO ON TO +IPRODS, PRODIS /DO THE PROJECTILE THING + + TAD XTWODS /OTHERWISE SWAP ON TO THE NEXT PAIR + DCA XONEDS /OF POINTS + TAD YTWODS + DCA YONEDS + JMP TWDLOP + +COLIDE, COLLID +IONEEX, ONEEXP +ITWOEX, TWOEXP + + +/ +/ THIS IS THE SO CALLED "VECTOR GENERATOR" WHICH DRAWS A +/ SERIES OF DOTS FROM XONEDS,YONEDS TO XTWODS,YTWODS. +/ THE COORDINATE COMPONENTS ARE DIVIDED INTO FOURTHS AND +/ FOUR DOTS DRAWN ON THE SCOPE SCREEN. NOTE THAT NO DOT +/ IS DRAWN AT XONEDS,YONEDS. THIS IS COMPENSATED FOR ELSEWHERE. +/ + + +DISPLY, 0 /ENTER TO DRAW A FOUR POINT VECTOR + TAD XONEDS /FROM XONEDS,YONEDS + CIA /TO XTWODS,YTWODS + TAD XTWODS /DIVIDE COORDINATE DIFERENCES INTO + JMS DISHFT /FOURTHS + DCA DIXTEM /AND STORE INCREMENT + TAD YONEDS + CIA + TAD YTWODS + JMS DISHFT + DCA DIYTEM + TAD M4 /FOR FOUR DOTS + DCA DISCNT + +DISLOP, TAD XONEDS /ADD INCREMENT TO CURRENT X AND Y + TAD DIXTEM + DCA XONEDS /NOTE THAT THIS ROUTINE DESTROYS + TAD YONEDS /XONEDS AND YONEDS + TAD DIYTEM + DCA YONEDS + TAD XONEDS + RTR /DIVIDE BY 8 TO FIT SCREEN SIZE + RAR + DXC DXL /SET X VALUE + CLA + TAD YONEDS /DO THE SAME FOR Y + RTR + RAR + DYC DYL DIS /AT LAST SOMETHING TO SEE!! + CLA + ISZ DISCNT /DONE YET? + JMP DISLOP /NOPE + JMP I DISPLY /YUP + + +DISHFT, 0 /A GENERALIZED SHIFT ROUTINE CALLED + CLL /FROM EVERYWHERE TO DIVIDE THE + SPA /AC BY FOUR WITH AN ASR RIGHT + CML IAC /NOTE THAT NEGATIVE NUMBERS ARE + RAR /ROUNDED UPWARDS (TOWARD ZERO) + CLL /TO MAKE IT COME OUT RIGHT + SPA + CML IAC /EVEN SO THERE ARE SOME ROUNDING ERRORS + RAR /SOMEWHERE. SO MUCH FOR 12 BIT MACHINES + JMP I DISHFT + + +/ +/ HERE TO DISPLAY ALL THE PROJECTILES AND TEST FOR HITS. +/ THE PROJECTILE DISPLAY FILE IS SEARCHED FOR PROJECTILES WITH +/ NON-ZERO COUNTS AND WHEN ONE IS FOUND THE POSITION IS +/ UPDATED BY THE VELOCITY, THE POINT DISPLAYED AND TESTED FOR +/ A HIT. +/ + + *1600 + +PRODIS, CLA CLL / BEGIN DISPLAY OF THE PROJECTILES + TAD BUFST /POINT TO BEGINNING OF DISPLAY FILE + DCA BUFTMP + DSB 2 /SET EXTRA BRIGHT FOR SINGLE POINTS + +PROLOP, TAD I BUFTMP /PICK UP NEXT COUNT + SNA + JMP EXPIRE /THIS ONE IS DEAD - GO TO THE NEXT + IAC /INCREMENT COUNT AND REPLACE + DCA I BUFTMP + ISZ BUFTMP /BUMP POINTER TO X VELOCITY + TAD I BUFTMP + ISZ BUFTMP /THEN TO XPOSITION AND UPDATE X POSITION + TAD I BUFTMP /WITH THE VELOCITY WHICH IS CONSTANT + DCA I BUFTMP + TAD I BUFTMP + DCA PROX /AND STORE X POSITION FOR DISPLAY AND TEST + ISZ BUFTMP /NOW TO Y POSITION AND VELOCITY + TAD I BUFTMP + ISZ BUFTMP + TAD I BUFTMP /SAME LITTLE GAME + DCA I BUFTMP + TAD I BUFTMP + DCA PROY /STORE THE NEW Y VALUE + + TAD PROX /DISPLAY THE POINT WITH + RTR /THE SAME SHIFT AS FOR THE SHIPS + RAR /FOR THE SMALL SCREEN + DXC DXL + CLA + TAD PROY + RTR / + RAR + DYC DYL DIS /THERE IT IS!! + CLA + JMS I CHKOUT /TEST FOR A HIT + ISZ BUFTMP /MOVE POINTER ON AND TEST FOR END + TAD BUFTMP /OF BUFFER + TAD BUFLIM + SZA CLA + JMP PROLOP /NOT AT END - CONTINUE + + / +/ HERE AT THE END OF THE PROJECTILE DISPLAY. IF THE GAMOVR +/ FLAG IS SET, GO ON TO THE MESSAGE DISPLAY - VICTORY LAP +/ SECTION. OTHERWISE PICK UP THE REMAINING CLOCK COUNT +/ TO GIVE THE FANS SOMETHING TO LOOK AT, AND MOVE THE +/ ELECTRON BEAM TO A LOWER CORNER. THE COUNT DISPLAYED +/ IN THE AC IS THE NUMBER OF 100 USEC CLOCK TICKS REMAINING +/ WHEN THIS CODE IS REACHED BEFORE THE NEXT UPDATE WOULD +/ BEGIN. TURNS OUT THAT ROUGHLY 2/3 OF THE CPU IS LEFT +/ OVER SHOULD ANYONE WANT TO DO ANYTHING VERY FANCY. +/ + + +FINISH, TAD GAMOVR /IS THIS THE VICTORY LAP OR WHAT? + SZA CLA + JMP I ENDGAM /YES, GO TO PUT UP THE MESSAGE + TAD M400 /MOVE THE BEAM OFF SCREEN + DYC DYL + CLA CLL + DXC DXL + TAD INTCNT /PICK UP THE COUNT + CIA + JMP . + +ENDGAM, JOBLOP + + + +EXPIRE, TAD BUFTMP /HERE TO ADVANCE THE BUFFER + TAD P5 /POINTER TO THE NEXT PROJECTILE + DCA BUFTMP /UNLESS THE END + TAD BUFTMP /OF THE BUFFER + TAD BUFLIM /IS REACHED + SZA CLA /IN WHICH CASE + JMP PROLOP /IT + JMP FINISH /QUITS + +BUFST, DISBUF+101 +BUFLIM, -DISBUF-175 +CHKOUT, CHECK + +RESE1, 0 /THIS IS CALLED TO SET THE POINTER + TAD MRES /(AUTO16) TO THE NEXT FREE SLOT + DCA RESCNT /FOR A PROJECTILE LAUNCH. 12 POSSIBLE + +RESLOP, TAD RESPNT /MOVE THE POINTER TO THE NEXT SLOT + TAD P5 + DCA RESPNT + TAD RESPNT /RESTE IF AT END OF BUFFER + TAD BUFLIM + SZA CLA + JMP RESCON + TAD BUFST + DCA RESPNT + +RESCON, TAD I RESPNT /FIND A HOLE YET? + SNA CLA + JMP RESFND /YES, SET UP AUTO16 + ISZ RESCNT /NO COUNT + JMP RESLOP /AND TRY AGAIN + HLT /NO HOLES AT ALL? + +RESFND, CMA /BACK THE POINTER FOR AUTO INDEXING + TAD RESPNT + DCA AUTO16 + JMP I RESE1 + +MRES, -14 +RESCNT, 0 +RESPNT, 0 + +SETBUF, 0 + CMA /THIS ROUTINE IS CALLED FROM THE + TAD BUFST /STARTING SEQUENCE TO INITIALIZE ALL + DCA AUTO16 /THE BUFFER POINTERS AND SO ON + TAD BUFST + DCA BUFTMP + TAD BUFST + DCA RESPNT + TAD BUFST + DCA SETPNT +SETLOP, DCA I SETPNT + ISZ SETPNT + TAD SETPNT + TAD BUFLIM + SZA CLA + JMP SETLOP + JMP I SETBUF + +SETPNT, 0 + + +/ +/ THIS HERE NOW THING CHECKS THE COORDINATES OF THE MOST RECENTLY +/ DISPLAYED PROJECTILE AGAINST THOSE OF THE SHIPS ON THE SCREEN. +/ IF WITH A COLLISION LIMIT A HIT IS RECORDED AND THE LIFE +/ COUNT OF THE PROJECTILE ZEROED TO REMOVE IT. A HIT SHIP +/ IS SUITABLY FLAGGED +/ + + *2000 + +CHECK, 0 /HERE TO TEST FOR A PROJECTILE HIT + TAD ONEFLG /CANT HIT SOMETHING IN HYPERSPACE + SZA CLA + JMP CHECK2 + TAD ONEOUT /OR SOMETHING THAT'S BEEN HIT + SZA CLA + JMP CHECK2 + + TAD PROX /CHECK X COORDINATES OF SHIP ONE + CIA /AND PROJECTILE + TAD ONEPEX /THIS SORT OF THING IS WHY THE + SPA /COORDINATES HAVE TO BE MAINTAINED TO 12 + CIA /BITS + TAD LIMIT /CLOSE ENOUGH? + SMA CLA + JMP CHECK2 /IF X ISN' CLOSE ENOUGH THEN NO HIT + TAD PROY /X WAS CLOSE ENOUGH, HOW ABOUT Y? + CIA + TAD ONEPEY + SPA + CIA + TAD LIMIT + SMA CLA + JMP CHECK2 /NO HIT + + TAD MEXP /DEPOSIT EXPLOSION COUNT IN ONEOUT + DCA ONEOUT /ALL THAT IS NECESSARY + JMS CUTOUT /REMOVE PROJECTILE + + + +CHECK2, TAD TWOFLG /NO HIT ON NUMBER ONE, TRY NUMBER TWO + SZA CLA + JMP I CHECK /BUT NOT IF IN HYPERSPACE + TAD TWOOUT /OR IF ALREADY HIT + SZA CLA + JMP I CHECK + + TAD PROX /CHECK X'S FIRST + CIA + TAD TWOPEX + SPA /GET ABSOLUTE VALUE OF DIFFERENCE + CIA + TAD LIMIT /AND TEST MAGNITUDE AGAINST PROXIMITY + SMA CLA /LIMIT + JMP I CHECK /NOWHERE NEAR CLOSE + + TAD PROY /NYAH, NYAH + CIA /TRY THE Y'S + TAD TWOPEY + SPA + CIA /ABSOLUTE VALUE OF DIFFERENCE + TAD LIMIT + SMA CLA + JMP I CHECK /CLEAN MISS! + + TAD MEXP /HIT ON TWO - END EVERYTHING BY SETTING + DCA TWOOUT /TWOOUT TO NON-ZERO EXPLOSION COUNT + JMS CUTOUT + JMP I CHECK /EXIT AFTER DESTOYING PROJECTILE + +LIMIT, -120 /PROXIMITY LIMIT FOR WHAT CONSTITUTES A HIT + +CUTOUT, 0 /THIS ROUTINE ZEROES OUT THE MOST RECENTLY + TAD M4 /DISPLAYED PROJECTILE BY ZEROEING THE + TAD BUFTMP /COUNT + DCA CUTPNT + DCA I CUTPNT + JMP I CUTOUT + +CUTPNT, 0 + + +/ +/ THIS ROUTINE IS CALLED TO TEST FOR A COLLISION BETWEEN THE +/ TWO SHIPS. THE COORDINATES OF BOTH ARE COMPARED +/ AND IFF SUFFICIENTLY CLOSE BOTH ARE DESTROYED BY SETTING +/ THEIR EXPLOSION COUNTS NON-ZERO. +/ + + +COLLID, 0 /HERE TO TEST FOR COLLISION + TAD ONEFLG /NO TEST IF EITHER SHIP IS IN + SZA CLA /HYPERSPACE OR EXPLODING + JMP I COLLID + TAD TWOFLG + SZA CLA + JMP I COLLID + TAD ONEOUT + SZA CLA + JMP I COLLID + TAD TWOOUT + SZA CLA + JMP I COLLID + + TAD ONEPEX /BOTH SHIPS AVAILABLE FOR COLLISION + CIA /CHECK X COORDINATES FIRST + TAD TWOPEX + SPA /GET ABSOLUTE VALUE OF DIFFERENCE + CIA + TAD COLLIM /CLOSE ENOUGH? + SMA CLA + JMP I COLLID /NOPE, FORGET IT + + TAD ONEPEY /YES, NOW TRY THE Y COORDINATES + CIA + TAD TWOPEY + SPA + CIA /GET MAGNITUDE ONLY + TAD COLLIM + SMA CLA /CLOSE ENOUGH? + JMP I COLLID + TAD MEXP /YES, SET BOTH EXPLOSION COUNTS + DCA ONEOUT + TAD MEXP + DCA TWOOUT + JMP I COLLID + +COLLIM, -300 + +/ +/ THIS ROUTINE IS CALLED TO SET ONE OF THE TWO SHIPS INTO +/ HYPERSPACE. ON ENTRY THE AC=-1 FOR SHIP #1, 0 FOR SHIP +/ NUMBER 2. THE LOCATION CLOCK IS USED FOR A RANDOM +/ ADDRESS POINTER FROM WHICH WILL BE DRAWN THE +/ VARIOUS PARAMETERS FOR REENTRY. +/ + + *2200 + +HYPSET, DCA RTNFLG /HERE WITH AC=-1 OR 0 + TAD RTNFLG /SET UP LIST POINTER + SZA CLA + TAD ONEDIF /TO APPROPRIATE SHIP FILE + TAD TWOLST + DCA AUTO15 + + TAD CLOCK /SET UP "RANDOM NUMBER GENERATOR" + DCA AUTO17 + TAD I AUTO17 /PICK UP FIRST THE AMOUNT OF TIME + AND TIMOUT /OUT OF NOMAL SPACE LIMITED TO -777 + CIA /UPDATE CYCLES ( ABOUT 15 SECONDS) + DCA I AUTO15 /AND STORE IN ONEOUT OR TWO OUT + + TAD I AUTO17 /THE NEXT RANDOM NUMBER BECOMES THE + JMS I THEADJ /ANGLE OR ORIENTATION ON REENTRY + DCA I AUTO15 + TAD I AUTO17 /AND THE NEXT BECOMES THE X VELOCITY + JMS VEESET /COMPONENT + DCA I AUTO15 + TAD I AUTO17 /AND THEN THE Y COMPONENT + JMS VEESET + DCA I AUTO15 + TAD I AUTO17 + DCA I AUTO15 + + TAD I AUTO17 + DCA I AUTO15 + + TAD I AUTO17 /FINALLY SEE IF RETURN WILL BE SUCCESSFLY + AND TIMOUT + TAD MHYP /ABOUT 3/4 CHANCE + SMA CLA + JMP HYPRET /OK + TAD RTNFLG /THIS IS THE ONE TIME IN FOUR. SET + SZA CLA /UP FOR EXPLOSION ON REENTRY + TAD ONEDIF + TAD OUTLOC + DCA VEESET + TAD MEXP + DCA I VEESET + +HYPRET, ISZ RTNFLG + JMP I TWORTN + JMP I ONERTN + +TIMOUT, 777 +ONEDIF, ONEFLG-TWOFLG +TWOLST, TWOFLG-1 +RTNFLG, 0 +ONERTN, TWOUP +TWORTN, ONESET +OUTLOC, TWOOUT +MHYP, -200 + + + +VEESET, 0 /HERE TO LIMIT VELOCITY COMPONENTS + CLL + SPA /GET MAGNITUDE + CML + AND HM177 /LIMIT TO 177 + SZL CLL + CIA + JMP I VEESET /AND EXIT + +HM177, 177 + +ONEEXP, CLA CLL /HERE TO DISPLAY SHIP NUMBER ONE AS + TAD ONETHE /AN EXPLOSION + TAD INCONE /FIRST ROTATE IT BY A GOOD DOLLOP + DCA ONETHE + JMS I IXPDIS /THEN CALL THE EXPLOSION GENERATOR + ISZ ONEOUT /DONE WITH THE EXPLOSION? + JMP I NOWTWO /NO, NORMAL RETURN + + IAC /YES, SET INTO PSEUDO HYPER SPACE + DCA ONEFLG + IAC /DISABLE RETURN FROM HYPER SPACE + DCA ONEFIN + + TAD TWOFIN /IS NUMBER TWO STILL AROUND? + SNA CLA + JMP I NOWTWO /YES, RETURN + JMP I TIEUP /NO, TIE BALL GAME + + +TWOEXP, CLA CLL /HERE TO DISPLAY SHIP NUMBER TWO + TAD TWOTHE /AS AN EXPLOSION. BASH IT AROUND + TAD INCTWO + DCA TWOTHE + JMS I IXPDIS /THEN DISPLAY IT + ISZ TWOOUT /DONE WITH EXPLOSION? + JMP I NOWPRO /NO, NORMAL RETURN + + IAC /YES, SEND INTO PSEUDO HYPER SPACE + DCA TWOFLG + IAC /DISABLE NORMAL RETURN FROM HYPERSPACE + DCA TWOFIN + /CHECK NUMBER ONE + TAD ONEFIN + SZA CLA /STILL ALIVE AND WELL? + JMP I TIEUP /NO, TIE GAME + JMP I NOWPRO /YES, CONTINUE ON +NOWTWO, TWODIS +NOWPRO, PRODIS +TIEUP, NOWIN +IXPDIS, EXPDIS +INCONE, 55 +INCTWO, 55 + + +/ +/ HERE TO DISPLAY THE FIGURE POINTED TO BY AUTO10 AS +/ AN EXPLOSION. THIS WORKS THE SAME WAY AS THE NORMAL +/ DISPLAY ROUTINE EXCEPT THAT THE COORDINATE INCREMENTS +/ ARE INVERTED TURNING THE FIGURE INSIDE OUT FOR S +/ A SORT OF CLOBBY EXPLOSION. +/ + + *2400 + +EXPDIS, 0 /HERE TO DISPLAY A FIGURE INSIDE OUT + TAD I AUTO10 /WITH THE POINTERS AND COUNTS ALREADY + DCA XTWODS /SET UP BY FILDIS OR TWODIS + TAD I AUTO10 /STICK NEXT TWO POINTS INTO LINE + DCA YTWODS + + TAD XTWODS + CIA /CALCULATE INCREMENT THE WRONG WAY + TAD XONEDS + DCA DIXTEM /AND STORE + TAD YTWODS + CIA + TAD YONEDS + DCA DIYTEM /SAME FOR Y + + TAD M4 /4 DOTS IN THE VECTOR" + DCA DISCNT /COULD HAVE CALLED THE OTHER + /VECTOR GENERATOR I SUPPOSE +EXPLOP, TAD XONEDS + TAD DIXTEM /ADD X AND Y INCREMENTS TO THE RUNNING + DCA XONEDS /TOTALS AND DISPLAY THE RUNNING + TAD YONEDS /TOTALS NORMAL SIZE + TAD DIYTEM + DCA YONEDS + + TAD XONEDS + RTR /COULD MAKE TWICE AS BIG BY NOP-ING + RAR /THE RAR'S BUT THE SCREEN IS SMALL ENOUGH + DXC DXL /AS IT IS + CLA + TAD YONEDS + RTR + RAR + DYC DYL DIS + CLA + ISZ DISCNT /DONE 4 DOTS? + JMP EXPLOP /NO + + ISZ AUTO11 /DONE ALL VECTORS IN THE FILE? + SKP + JMP I EXPDIS /YES, EXIT + + TAD XTWODS /NO SWAP TO NEXT PAIR OF POINTS + DCA XONEDS + TAD YTWODS + DCA YONEDS + JMP EXPDIS+1 + + + +/ +/ VEELIM IS THE SCALING ROUTINE FOR VELOCITY COMPONENTS. +/ THE COMPONENTS ARE SCALED TO REMAIN IN THE RANGE 140 +/ TO -140. THIS IS NECESSARY TO AVOID ASTRONOMICAL SPPED +/ BUILDUP ON THE SMALL SCREEN. UNFORTUNATELY THE X AND Y +/ COMPONENTS ARE SCALED SEPARATELY WHICH GIVES SLIGHT BUT +/ NOTICABLE DISTORTIONS IN DIAGONAL FLIGHT PATHS. IN THE +/ NORMAL HEAT OF THE BATTLE NO ONE WILL REALLY NOTICE. +/ + + +VEELIM, 0 /ENTER TO SCALE VELOCITY HELD IN + DCA VEEHLD /AC + TAD VEEHLD + SMA /BRANCH FOR POSITIVE OR NEGATIV + JMP VEEPOS + TAD VEEMAX + SMA CLA /GREATER THAN MAXIMUM POSITIVE? + JMP VEECLR /NO + TAD VEEMIN /I MEAN MAXIMUM NEGATIVE - YES SET + JMP I VEELIM /TO MAX NEGATIV + +VEEPOS, TAD VEEMIN /GREATER THAN MAX? + SPA CLA + JMP VEECLR /NO + TAD VEEMAX /YES SET TO MAX + JMP I VEELIM + +VEECLR, TAD VEEHLD /IT WAS IN RANGE ALL ALONG + JMP I VEELIM + +VEEHLD, 0 +VEEMIN, -140 +VEEMAX, 140 + +THEAJI, 0 /HERE TO ADJUST THE ANGLE TO A RANGE + SMA /0-550 OR 0-360 DEGREES. THIS IS + JMP .+3 /NECESSARY TO INSURE THAT PUSHDOWN OVERFLOW + TAD P550 /WILL NOT HAPPEN IN THE SINE AND COSINE + JMP .-3 /ROUTINES. THIS SIMPLY TAKES THE AC + TAD M550 /MODULO 360 AND EXITS + SMA + JMP .-2 + TAD P550 /FOLLOW IT THROUGH AND SEE IF IT DOESN'T + JMP I THEAJI + + +/ +/ ONE OF THESE ROUTINE IS ENTERED WHEN A WINNER IS DECLARED. +/ THE ADDRESS OF THE VICTORY MESSAGE IS PLACED IN MESS AND +/ THE GAMOVR FLAG SET TO CAUSE A BRANCH TO JOBLOP WHEN THE +/ DISPLAY CYCLE IS COMPLETED. THE ROUTINE WILL THEN DISPLAY +/ THE APPROPRIATE MESSAGE OVER THE REMAINING SHIPS IF +/ ANY UNTIL THE KEYBOARD IS MOLESTED OR THE CLOCK RUNS OUT +/ AND THE NEXT DISPLAY UPDATE CYCLE IS SET. AT ANY RATE THE +/ PROGRAM WILL REACH HERE ONLY WHEN SOMEONE HAS BITTEN THE +/ INTERGALACTIC DUST. +/ + + +ONEWIN, 0 /THIS IS CALLED WHEN TWOFIN IS SET + TAD MES1 /AND ONE FIN IS NOT. SET ONE TO VICTOR + DCA MESS /AND SET GAMOVR FLAG + IAC + DCA GAMOVR + JMP I ONEWIN /THEN RETURN TO UPDATE CYCLE + +TWOWIN, 0 /THIS IS CALLED WHEN ONEFIN IS SET + TAD MES2 /AND TWO FIN IS NOT + DCA MESS /SET ALSO GAMOVR + IAC + DCA GAMOVR + JMP I TWOWIN + +NOWIN, TAD MES4 /GET HERE WHEN BOTH ONEFIN AND TWOFIN + DCA MESS /ARE SET . + IAC + DCA GAMOVR /NOBODY EVER REALLY WINDS + /UP THE WINNER IN THESE THINGS +JOBLOP, DSB 1 /THIS IS ENTERED FROM FINISH WHEN + TAD MES0 /GAMOVR IS SET AND SERVES TO DISPLAY + JMS I MESOUT /THE VICTORY MESSAGE ON THE SCREEN + TAD MESS /USING THE CHARACTER GENERATOR SOMEWHAT + JMS I MESOUT /FURTHER ON UNTIL THE GAME IS RESTARTED + TAD MES5 /OR UNTIL THE INTERRUPT COUNT OVERFLOWS + JMS I MESOUT /AND THE UPDATE CYCLE IS RESTARTED + TAD MES3 + JMS I MESOUT +FINITO, JMP JOBLOP + +MES0, MESS0 +MES1, MESS1 +MES2, MESS2 +MES3, MESS3 +MES4, MESS4 +MES5, MESS5 +MESS, 0 + + +/ +/ THE FOLLOWING ARE THE SINE AND COSINE ROUTINES CUSTOMIZED +/ FOR THIS PROGRAM FROM ANOTHER I WORKED ON. CALL EITHER +/ SINE OR COSINE WITH ANGLE IN DEGREES IN AC. THE ARGUEMENT +/ IS REDUCED THROUGH RECURSION UNTIL BETWEEN 0-89 DEGREES +/ AND THEN A TABLE LOOKUP DONE TO OBTAIN THE VALUE. IT TAKES +/ UP A FAIR AMOUNT OF SPACE BUT IT WORKS JUST FASTER +/ THAN SHEEP. THE COSINE CALL JUST TRANSFORMS THE ARGUEMENT +/ THROUGH SOME TRIGONOMETRIC GARBAGE AND CALLS THE SINE +/ ROUTINE. NOTE THAT CALLING EITHER ROUTINE WITH TOO +/ LARGE AN ARGUEMENT WILL CAUSE PUSHDOWN OVERFLOW AND THEN +/ ALL HELL WILL BREAK LOOSE. THE ORIGINAL ROUTINE FROM WHICH +/ THIS WAS STOLEN HAD FULL WORD PRECISION. +/ + + *6400 + +SINEIN, 0 /I REALLY CANT BRING MYSELF TO COMMENT + DCA SINARG /THIS. IT'S VERY STRAIGHFORWARD + TAD SINEIN + DCA I SINPSH + ISZ SINPSH + TAD SINARG + SZA + JMP SINNG2 + +SINPOP, CLA CLL CMA + TAD SINPSH + DCA SINPSH + TAD I SINPSH + DCA SINEIN + TAD SINARG + JMP I SINEIN + +SINNG2, SMA + JMP SINPOS + CIA + JMS SINEIN + +SINNEG, CIA + DCA SINARG + JMP SINPOP + +SINPOS, TAD M264 + SPA + JMP .+2 + JMP SINNEG-1 + TAD P132 + SPA + JMP SINELK + SZA CLA + JMP .+3 + TAD P37 + JMP SINNEG+1 + + TAD SINARG + TAD M264 + JMP SINNEG-1 + +SINELK, TAD P132 + TAD SINTAB + DCA SINEIN + TAD I SINEIN + DCA SINARG + JMP SINPOP + + + +SINARG, 0 +SINPSH, SINLST +SINLST, 0 + 0 + 0 + 0 + 0 + 0 + +SINTAB, SINES-1 + +COSINI, 0 + CIA + TAD P132 + JMS SINEIN + JMP I COSINI + + + +SINES, 00 /1 + 01 /2 + 01 /3 + 02 /4 + 02 /5 + 03 /6 + 03 /7 + 04 /8 + 05 /9 + 05 /10 + 06 /11 + 06 /12 + 07 /13 + 07 /14 + 10 /15 + 10 /16 + 11 /17 + 11 /18 + 12 /19 + 12 /20 + 13 /21 + 13 /22 + 14 /23 + 15 /24 + 15 /25 + 16 /26 + 16 /27 + 17 /28 + 17 /29 + 20 /30 + 20 /31 + 20 /32 + 21 /33 + 21 /34 + 22 /35 + 22 /36 + 23 /37 + 23 /38 + 24 /39 + 24 /40 + 25 /41 + 25 /42 + 25 /43 + 26 /44 + 26 /45 + 27 /46 + 27 /47 + 27 /48 + 30 /49 + 30 /50 + 30 /51 + 31 /52 + 31 /53 + 31 /54 + 32 /55 + 32 /56 + 32 /57 + 33 /58 + 33 /59 + 33 /60 + 33 /61 + 34 /62 + 34 /63 + 34 /64 + 35 /65 + 35 /66 + 35 /67 + 35 /68 + 35 /69 + 36 /70 + 36 /71 + 36 /72 + 36 /73 + 36 /74 + 36 /75 + 37 /76 + 37 /77 + 37 /78 + 37 /79 + 37 /80 + 37 /81 + 37 /82 + 37 /83 + 37 /84 + 37 /85 + 37 /86 + 37 /87 + 37 /88 + 37 /89 + + + +MULTI, 0 /THIS IS STANDARD SINGLE PRECISION + CLL /MULTIPLY ROUTINE WHICH WAS ONCE + SPA /USED. I'VE LEFT IT IN SINCE + CMA CML IAC /THERE IS LOTS OF CORE LEFT OVER AND + DCA MULMP1 /MAYBLE SOMEDAY I'LL NEED IT TO PUT + DCA MULMP5 /IN A SUN OR SOMETHING. THIS IS THE + TAD I MULTI /STANDARD DEC SUBROUTINE WITH DIFFERENT + SNA /LABELS + JMP MULPSN+2 + SPA + CMA CML IAC + DCA MULMP2 + TAD MULTHR + DCA MULMP3 + +MULMP4, TAD MULMP1 + RAR + DCA MULMP1 + TAD MULMP5 + SZL + TAD MULMP2 + CLL RAR + DCA MULMP5 + ISZ MULMP3 + JMP MULMP4 + TAD MULMP1 + RAR +MULPSN, SZL + JMP MULCMP + DCA MULMP1 + TAD MULMP5 +MULMPZ, ISZ MULTI + JMP I MULTI + +MULCMP, CMA CLL IAC + DCA MULMP1 + TAD MULMP5 + CMA + SZL + IAC + JMP MULMPZ + +MULTHR, 7764 +MULMP1, 0 +MULMP5, 0 +MULMP2, 0 +MULMP3, 0 + + +/ +/ SHIFTR DIVIDES THE AC BY TWO WHETHER POSITIVE OR NEGATIVE +/ AND IS CALLED FROM VARIOUS PLACES. NOT ENTIRELY MYSTERIOUS +/ + + +SHIFTR, 0 + CLL + SPA + CML IAC + RAR + JMP I SHIFTR + + +/ +/ POSCAL IS CALLED TO CALCULATE THE COORDINATE INCREMENTS +/ NECESSARY TO PRODUCE THE SHIP FIGURES. RATHER THAN DOING +/ A LOT OF EXPENSIVE MATH THIS DOES A QUICK PRODUCTION +/ OF 1, 2, AND 3 TIMES THE SIN AND COSINE VALUES FOUND +/ IN CALSIN AND CALCOS LEAVING THEM IN THE TABLE FOR +/ ONESET AND TWOSET. IF THE SCOPE WERE ANY BETTER +/ THIS PROBABLY WOULDN'T BE NEAR GOOD ENOUGH BUT.... +/ + +POSCAL, 0 + TAD CALSIN + + DCA T10SIN + TAD T10SIN + CLL RAL + DCA T20SIN + TAD T10SIN + TAD T20SIN + DCA T30SIN + + TAD CALCOS + + DCA T10COS + TAD T10COS + CLL RAL + DCA T20COS + TAD T10COS + TAD T20COS + DCA T30COS + JMP I POSCAL + + + *7000 + +/GENERAL PURPOSE SYMBOL GENERATOR +/ +CHARS, 0 /ENTRY TO PLOT CHARACTER STRING + DCA ADDR /STORE STRING ADDRESS + TAD I ADDR /FETCH DOUBLE CHARACTER + RTR /SHIFT + RTR / FOR FIRST + RTR / CHARACTER + JMS CHAR /PLOT CHARACTER + SKP /NORMAL RETURN -- SKIP + JMP I CHARS /TERMINATION RETURN -- EXIT + TAD I ADDR /RECALL DOUBLE CHARACTER + ISZ ADDR /ADVANCE STRING ADDRESS + JMS CHAR /PLOT CHARACTER + JMP CHARS+2 /NORMAL RETURN -- REPEAT + JMP I CHARS /TERMINATION RETURN -- EXIT +/ +CHAR, 0 /ENTRY TO PLOT SINGLE CHARACTER + AND K77 /MASK OUT UPPER BITS + CLL RAL /MULTIPLY CODE BY TWO + TAD TABLE /ADD TABLE BASE ADDRESS + DCA POINT /CONSTRUCT POINTER TO 24-BIT CODE + CMA /INITIALIZE COUNTER FOR + DCA COUNT2 / TWO PLOT WORDS + TAD I POINT /FETCH FIRST PLOT WORD + ISZ POINT /INCREMENT POINTER FOR NEXT ONE + SNA /SKIP IF NOT SPECIAL CHARACTER + JMP SPCHAR /ELSE GO PROCESS IT + DCA CURPLT /SAVE CURRENT PLOT BITS +XPLOT, TAD KM6 /INITIALIZE 6-BIT + DCA COUNT6 / COUNTER + TAD YVALUE /RESET Y TEMPORARY + DCA YTEMP / VALUE FOR CHARACTER + TAD XVALUE /OUTPUT CURRENT + DXC DXL / X-VALUE TO CRT + TAD XINCR /INCREMENT + DCA XVALUE / ABSCISSA +YPLOT, TAD CURPLT /RECALL CURRENT PLOT BITS + CLL RAL /GET NEXT BIT + DCA CURPLT /SAVE REMAINING PLOT BITS + SNL /SKIP IF POINT TO PLOT + JMP CNTINU /ELSE JUMP AHEAD + TAD YTEMP /OUTPUT CURRENT + DYC DYL DIS / Y-VALUE TO CRT + CLA CLL /CLEAR AC + TAD CURPLT /RECALL CURRENT PLOT BITS + SNA CLA /SKIP IF POINTS REMAINING + JMP WRDEND /ELSE WORD IS FINISHED +CNTINU, TAD YTEMP /INCREMENT TEMPORARY + TAD YINCR / Y-VALUE FOR NEXT + DCA YTEMP / CHARACTER STEP + ISZ COUNT6 /SKIP IF 6 BITS PLOTTED + JMP YPLOT /ELSE PLOT NEXT ONE + JMP XPLOT /GO UPDATE X-VALUE +WRDEND, ISZ COUNT2 /SKIP IF ANOTHER BIT WORD + JMP EXIT /ELSE EXIT + TAD I POINT /FETCH SECOND BIT WORD + SZA /SKIP IF NO PLOT POINTS + JMP XPLOT-1 /ELSE GO PLOT THEM +EXIT, TAD XVALUE /INCREMENT ABSCISSA + TAD XINCR / FOR SPACE BETWEEN + DCA XVALUE / SYMBOLS + JMP I CHAR /EXIT FROM CHAR +/ +SPCHAR, TAD I POINT /FETCH TRANSFER VECTOR + DCA POINT /STORE AS INDIRECT ADDRESS + JMP I POINT /GO TO APPROPRIATE ROUTINE +SPACE, TAD XINCR /FETCH BASIC ABSCISSA INCREMENT + CLL RTL /MULTIPLY BY FOUR AND + JMP EXIT / GO CREATE SPACE +CRLF, TAD INITX /"CARRIAGE RETURN" RESETS X + DCA XVALUE / TO ITS ORIGINAL VALUE +LF, TAD YINCR /"LINE FEED" + CLL RTL / DECREMENTS THE + CLL CIA RAL / Y-VALUE BY + TAD YVALUE / EIGHT SCALE + DCA YVALUE / STEPS + JMP I CHAR /EXIT FROM CHAR +RESET, TAD INITX /"RESET" RESETS + DCA XVALUE / X AND Y TO + TAD INITY / THEIR ORIGINAL + JMP RESET-2 / VALUES +TERM, ISZ CHAR /TERMINATE CODE CAUSES + JMP I CHAR / EXIT TO P+2 +/ +INITX, 0 /INITIAL X-VALUE +INITY, 327 /INITIAL Y-VALUE +XVALUE, 0 /CURRENT X-VALUE +YVALUE, 0 /CURRENT Y-VALUE +XINCR, 6 /BASIC X INCREMENT VALUE +YINCR, 10 /BASIC Y INCREMENT VALUE +YTEMP, 0 /TEMPORARY Y-VALUE +CURPLT, 0 /CURRENT PLOT BITS +ADDR, 0 /CURRENT STRING ADDRESS +COUNT6, 0 /6-BIT COUNTER +COUNT2, 0 /2-WORD COUNTER +KM6, -6 /CONSTANT FOR COUNT6 +K77, 77 /CHARACTER CODE MASK +POINT, 0 /TABLE POINTER +/ + +/ +TABLE, .+1 /TABLE BASE ADDRESS + 0 /SPECIAL CHARACTER (00) + TERM /TERMINATION CODE + 7611 / A + 1176 + 7745 / B + 4532 + 3641 / C + 4122 + 7741 / D + 4136 + 7745 / E + 4541 + 7705 / F + 501 + 7741 / G + 5173 + 7710 / H + 1077 + 4177 / I + 4100 + 2040 / J + 4037 + 7714 / K + 2241 + 7740 / L + 4040 + 7702 / M + 277 + 7706 / N + 3077 + 7741 / O + 4177 + 7705 / P + 502 + 3641 / Q + 6176 + 7715 / R + 2542 + 2245 / S + 5122 + 177 / T + 100 + 3740 / U + 4037 + 1720 / V + 4037 + 7730 / W + 3077 + 4136 / X + 3641 + 374 / Y + 7403 + 6151 / Z + 4543 + 7741 / [ + 0 + 204 / \ + 1020 + 4177 / ] + 0 + 436 / ^ + 400 + 0 /SPECIAL CHARACTER (37) + RESET /RESET + 0 /SPECIAL CHARACTER (40) + SPACE /SPACE + 5600 / ! + 0 + 303 / " + 0 + 1477 / # + 7714 + 2277 / MARKER + 2200 + 2313 / % + 6462 + 7777 / BLOCK + 7777 + 300 / ' + 0 + 3641 / ( + 0 + 4136 / ) + 0 + 4040 / UNDERSCORE (52) + 4040 + 1034 / + + 1000 + 0 /SPECIAL CHARACTER (54) + LF /LINE FEED + 1010 / - + 1000 + 4000 / . + 0 + 2010 / / + 402 + 3641 / 0 + 4136 + 4442 / 1 + 7740 + 4261 / 2 + 5146 + 2145 / 3 + 5321 + 1710 / 4 + 1077 + 4745 / 5 + 4531 + 7750 / 6 + 5070 + 6111 / 7 + 503 + 2255 / 8 + 5522 + 705 / 9 + 577 + 2400 / : + 0 + 0 /SPECIAL CHARACTER (73) + CRLF /CARRIAGE RETURN; LINE FEED + 1024 / > + 4200 + 1212 / = + 1200 + 4224 / < + 1000 + 255 / ? + 300 + + +/ +/ HERE FOLLOW THE PACKED ASCII TEXTS FOR THE VARIOUS +/ VICTORY MESSAGES. PERSONS ADVENTEROUS TO FIND THIS MIGH CARE +/ TO TOGGLE IN SOME CUTE LITTLE MESSAGES OF THEIR OWN. +/ + +MESS0, 3773 +MESS5, 7340 + 4040 + 4040 + 4000 + +MESS1, 1716 + 0500 + +MESS2, 2427 + 1700 + +MESS3, 2711 + 1623 + 4100 + +MESS4, 1617 + 0217 + 0431 + 0000 + + + *7400 + +DISBUF, 0 + +/ THE DISPLAY BUFFERS BEGIN HERE AND EXTEND UP SOMEWHERE TO +/ AROUND 7575 OR SO. +/ +/ +/ +/ +/ + + + + $ + +//////////////////////////// +/ +/ THIS IS THE END +/ +/////////////////////////// + + + + + + \ No newline at end of file diff --git a/sw/SPACE/space.pal b/sw/SPACE/space.pal new file mode 100644 index 0000000..a604b28 --- /dev/null +++ b/sw/SPACE/space.pal @@ -0,0 +1,2392 @@ +/ SPACE WAR +/ +/ INTERPLANETARY DEATH AND DESTRUCTION ON YOUR +/ LAB-8 +/ +/ EVAN SUITS +/ +/ THIS VERSION WORKS OFF EITHER THE BLUE RIBBON CONNECTOR OR THE +/ SR. WHEN THE PROGRAM IS STARTED (AT 0200) OR RESTARTED THE +/ SR WILL BE TESTED AND IF =0000 WILL BE USED FOR THE COMMAND +/ INPUT. OTHERWISE, THE BLUE RIBBON CONNECTOR (AX08 * C0-C7 * +/ XR OPTION ONLY) CONTINGENCY INPUTS WILL BE USED. +/ +/ WHEN THE PROGRAM IS STARTED THE TWO SHIPS SHOULD +/ APPEAR ON THE SCREEN WITH SHIP 'ONE' ON THE LEFT, SHIP +/ 'TWO' ON THE RIGHT. +/ +/ THE COMMAND WORD BIT ASSIGNMENTS ARE: +/ +/ SR BIT: C: FUNCTION: +/ +/ 0 0 SHIP ONE ROTATES LEFT +/ +/ 1 1 SHIP ONE ROTATES RIGHT +/ +/ 2 2 SHIP ONE ACCELERATES +/ +/ 3 3 SHIP ONE FIRES +/ +/ +/ +/ 8 4 SHIP TWO ROTATES LEFT +/ +/ 9 5 SHIP TWO ROTATES RIGHT +/ +/ 10 6 SHIP TWO ACCELERATES +/ +/ 11 7 SHIP TWO FIRES +/ +/ +/ +/ NOTE THAT TURNING RIGHT AND LEFT SIMULTANEOUSLY THROWS +/ THE SHIP INTO HYPERSPACE. IN THE CURRENT VERSION THE ODDS +/ ARE IN FAVOR OF YOUR MAKING IT BACK SAFELY. THE GAME IS OVER +/ WHEN ONE OR BOTH OF THE SHIPS HAVE BEEN DESTROYED AND THE +/ WINNER (IF ANY) IS IN NORMAL SPACE. WHEN THE WINNER +/ HAS BEEN ANNOUNCED, HIT ANY TTY KEY TO RESTART. +/ + + +/**************************************************************** + +/*************************** +/ CLOCK OPERATIONS + +CLZE=6130 / CLEAR CLOCK ENABLE REGISTER PER AC +CLSK=6131 / SKIP ON CLOCK FLAG +CLOE=6132 / SET CLOCK ENABLE REGISTER PER AC +CLAB=6133 / AC REGISTER TO CLOCK COUNTER REGISTER +CLEN=6134 / CLOCK ENABLE REGISTER TO AC +CLSA=6135 / STATUS TO AC +CLBA=6136 / CLOCK BUFFER REGISTER TO AC +CLCA=6137 / CLOCK COUNTER REGISTER TO AC + +/ BITS IN CLOCK ENABLE REGISTER +CREXT=0100 / EXTERNAL SOURCE +CR2=0200 / 10**2 per second +CR3=0300 / 10**3 per second +CR4=0400 / 10**4 per second +CR5=0500 / 10**5 per second +CR6=0600 / 10**6 per second + +COVSTAT=4000 +CMFREE=0000 / 4096 FIXED FREE RUN +CMPROG=1000 / PROGRAMMED DELAY + +CADC=0040 / START ADC ON OVERFLOW +CINH=0020 / INHIBIT CLOCK +CION=0010 / INTERRUPT ENABLE + +CEV3=0004 / EVENT 3 ENABLED +CEV2=0002 / EVENT 2 ENABLED +CEV1=00001 / EVENT 1 ENABLED + +/ VC8-E OPCODES +DIXY=6055 / INTENSIFY +DILX=6053 / LOAD X +DILY=6054 / LOAD Y +DILE=6056 / LOAD ENABLES FROM A +DISD=6052 / TEST FOR READY + +/**************************************************************** +/ SYMBOL DEFINITIONS FOR PAL8-PAL10 + +XRIN=NOP / DIGITAL INPUT? +XRCL=NOP + +/DSB=XXXX / SET BRIGHTNESS - MUST BE COMMENTED OUT!!! + +DXC=JMS I IVCLDX / X VALUE CONTROL? +DYC=JMS I IVCLDY / Y VALUE CONTROL? + +DXL=0000 / X VALUE LOAD FLAG? +DYL=0000 / Y VALUE LOAD FLAG? +DIS=0000 / ANOTHER STRANGE FLAG + +/CRF=NOP / WHICH FLAG??? +/CCF=NOP / ?? + + +/**************************************************************** +/ +/ THIS PROGRAM RELIES ON THE PROGRAM INTERUPT FACILITY FOR +/ REAL WORLD TIMING PURPOSES. +/ + + *0 + + 0 /EFFECTIVE JMS 0 ON PROGRAM INTERUPT + JMP I 2 /EXIT IMMEDIATLY TO SERVICE ROUTINE + INTSER + +EMPTY, 0 /THESE LOCATIONS ARE RESERVED FOR +ODT1, 0 /DEBUGGERS, ETC. +ODT2, 0 +ODT3, 0 + +/ +/ ALL THE AUTO INDEX REGISTERS ARE NAMED BUT NOT ALL OF +/ THEM ARE USED. THE STATUS OF ANY GIVEN REGISTER CANNOT +/ BE DETERMINED AT ANY TIME EXCEPT BY CAREFUL INSPECTION OF +/ THE CODE. +/ + + *10 + +AUTO10, 0 +AUTO11, 0 +AUTO12, 0 +AUTO13, 0 +AUTO14, 0 +AUTO15, 0 +AUTO16, 0 +AUTO17, 0 + +/ +/ THE FOLLOWING ARE THE DATA FILES FOR THE TWO SPACE SHIPS +/ AS WELL AS CERTAIN OTHER PARAMETERS FOR CALCULATING POSITIONS +/ AND SO ON. THE ORDER OF THE LOCATIONS MUST BE PRESERVED +/ ALTHOUGH THE SIZE OF THE TABLES MAY BE VARIED +/ + + *20 + +ONEOUT, 0 /IF NON-ZERO CONTAINS REAMINING TIME OF EXPLOSION +ONECNT, 0 /NUMBER OF POINTS IN FIGURE TO BE DISPLAYED +ONEFLG, 0 /IN OR OUT OF NORMAL SPACE +ONETHE, 0 /ANGLE OF ORIENTATION ON SCREEN +ONEVEX, 0 /X COMPONENT OF VELOCITY +ONEVEY, 0 /Y COMPONENT OF VELOCITY +ONEPEX, 0 /X POSITION (12 BITS) +ONEPEY, 0 /Y POSITION (12 BITS) +ONESIN, 0 /SINE OF ANGLE +ONECOS, 0 /COSINE OF ANGLE +ONEFIN, 0 /SET WHEN EXPLOSION DIES OUT + +TWOOUT, 0 /SAME CONTENT AND ORDER +TWOCNT, 0 /AS ABOVE +TWOFLG, 0 +TWOTHE, 0 +TWOVEX, 0 +TWOVEY, 0 +TWOPEX, 0 +TWOPEY, 0 +TWOSIN, 0 +TWOCOS, 0 +TWOFIN, 0 + + +/ +/ THESE LOCATIONS ARE USED BY THE "VECTOR GENERATOR" IN +/ DISPLAYING THE FIGURES. A FOUR DOT VECTOR WILL BE DRAWN +/ FROM XONE,YONE TO XTWO,YTWO WITH STEPS OF SIZE DIXTEM,DIYTEM +/ + +XONEDS, 0 +YONEDS, 0 +XTWODS, 0 +YTWODS, 0 +DIXTEM, 0 +DIYTEM, 0 +DISCNT, 0 + + +/ +/ THE NEXT LOCATIONS ARE USED BY CALPOS TO DO A FAST +/ MULTIPLY TO HELP CALCULATE THE DISPLAY FILES. +/ +T10SIN, 0 +T20SIN, 0 +T30SIN, 0 +T10COS, 0 +T20COS, 0 +T30COS, 0 + +CALSIN, 0 +CALCOS, 0 + +/ +/ NOW COME THE VARIOUS ODDS AND ENDS ONE USUALLY FINDS ON +/ PAGE ZERO +/ + +SINE, SINEIN +COSINE, COSINI +MULT, MULTI +RSHIFT, SHIFTR +VECTOR, DISPLY +CALPOS, POSCAL +INTWRD, 0 +INTCNT, 0 +/CLOCK, 0 +HYPER, HYPSET +MESOUT, CHARS +THEADJ, THEAJI +VEESCL, VEELIM +ISHFT, DISHFT +RESET1, RESE1 +GAMOVR, 0 +ACCFLG, 0 +ACCPER, -30 +MEXP, -400 + +PROX, 0 +PROY, 0 +PROLIF, -360 +BUFTMP, 0 +ONEFIL, DISBUF +TWOFIL, DISBUF+40 + +P5, 5 +P10, 10 +P17, 17 +P20, 20 +P37, 37 +P40, 40 +P100, 100 +P132, 132 +P200, 200 +P400, 400 +P550, 550 +P3777, 3777 + +M4, -4 +M6, -6 +M10, -10 +M11, -11 +M264, -264 +M200, -200 +M400, -400 +M550, -550 + +IVCLDX, VCLDX +IVCLDY, VCLDY + +/ +/ THE PROGRAM MAY BE STARTED OR RESTARTED AT ANYTIME AT 0200. +/ THE DATA FILE ON PAGE ZERO IS CLEARED, ALL FLAGS INITIALIZED, +/ AND THE SR EXAMINED. IF THE SR=0 THE DISPLAY UPDATE ROUTINES +/ ARE SET TO PICK UP THE STATUS WORD FROM THE SR. IF THE SR +/ DOES NOT EQUAL ZERO, THE STATUS WORD IS READ FROM THE EIGHT +/ CONTINGENCY INPUTS ON THE BLUE RIBBON CONNECTOR OF THE AX08 +/ (XR OPTION ONLY). JUMP IS THEN TO THE DISPLAY +/ FILE UPDATE TO START OFF THE GAME. +/ + + *200 + +START, CLA CLL /START OR RESTART HERE ANY OLD TIME + DIXY /TO GET THE VC8-E STARTED ONCE + LAS /SR +/TMP SNA CLA + TAD SWRD /USE THE SR + TAD XROPT /USE THE BLUE RIBBON CONNECTOR + DCA COLDST /AND LEAVE IN THE TRAP LOCATION + +RESTRT, CLA CMA + XRCL + CLA CLL + + TAD P17 /FIRST CLEAR THE POSITION AND DATA + DCA AUTO10 /TABLES OF THE TWO SHIPS + TAD TABLEN + DCA AUTO11 + DCA I AUTO10 + ISZ AUTO11 + JMP .-2 + + TAD STRT1 /SET THE STARTING POSITIONS OF THE + DCA ONEPEX /TWO SHIPS + TAD STRT2 + DCA TWOPEX + TAD P37 /SET TRIG FUNCTIONS JUST IN CASE + DCA ONECOS + TAD P37 + DCA TWOCOS /ZERO DEGREES IS POINTING STRAIGHT UP + TAD ACCPER /SET COUNT FOR VELOCITY INCREASE + DCA ACCFLG + DCA ONEFIN /CLEAR ALL GAME END FLAGS + DCA TWOFIN + DCA GAMOVR + JMS I BUFSET /RESET ALL PROJECTILE DISPLAY BUFFERS + + + TCF /CLEAR OTHER REMAINING LIKELY FLAGS + PCF + RRB + + CLA CMA / ALL ONES + CLZE / CLEAR CLOCK CONFIG REGISTER + CLA + TAD CDELY / LOAD NEG DELAY + CLAB / LOAD TO CLOCK BUFFER + CLA + TAD CCNF / LOAD CLOCK CONFIG + CLOE / SET CONFIG BITS + + CLA CLL + JMP COLDST /AND GO TO IT + +CCNF, CR4+CMPROG+CION+COVSTAT / CLOCK CONFIGURATION +CDELY, -310 / COUNTER PRESET (200) + +/ +/ UPDATE IS REACHED WHENEVER THE PROGRAM IS STARTED OR THE +/ CLOCK COUNT OVERFLOWS INDICATING TIME TO RECALCULATE THE +/ THE DISPLAY FILES AND REFRESH THE DISPLAY. THE INTERUPT +/ COUNT IS RESTORED, THE STATUS WORD IS PICKED UP FROM EITHER +/ THE SR OR BRC, AND THE RECALCULATION PROCESS BEGUN. +/ + +UPDATE, CLA CLL /HERE ON CLOCK COUNT OVERFLOW. + /START NEXT SWEEP +COLDST, 0 /TRAP TO READ SR OR BRC + LAS /HERE FOR SR + DCA INTWRD /STORE TEMPORARILY + TAD INTWRD /MASK OUT LEFTMOST 4 BITS + RTR /FOR NUMBER ONE + RTR + AND LFTHAF + DCA INTTEM /AND STORE + TAD INTWRD /MASK OUT RIGHTMOST BITS FOR NUMBER TWO + AND RYTHAF + TAD INTTEM /ADD TOGETHER + JMP .+3 /AND CONTINUE + +CODST, XRIN /HERE FOR BRC - PICK UP AND CLEAR + XRCL + DCA INTWRD /CONTINUE + TAD M550 /RESTORE INTERUPT COUNT BEFORE NEXT + DCA INTCNT /UPDATE + ION /GET READY FOR THE NEXT CYCLE + TAD ACCFLG /ALLOW VELOCITY INCREASE THIS TIME? + IAC /ONLY WHEN ACCFLG=0 + SMA SZA + TAD ACCPER /IF ZERO, RESET COUNT + DCA ACCFLG + + JMP I .+1 /NOW GET DOWN TO WORK. + ONEUP + +BUFSET, SETBUF +TABLEN, AUTO17-CALCOS +INTTEM, 0 +LFTHAF, 0360 +RYTHAF, 0017 +STRT1, 1000 +STRT2, -1000 +SWRD, 2000-CODST +XROPT, JMP CODST + + + +/ +/ THIS IS THE INTERUPT SERVICE ROUTINE. MOST OF THE +/ INTERUPTS WILL BE FROM THE CRYSTAL CLOCK WHICH WILL BE +/ COUNTED AND UNLESS THE COUNT OVERFLOWS THE INTERUPT IS +/ DISMISSED IMMEDIATLY. IF THE COUNT OVER FLOWS, JMP IS TO +/ UPDATE WITH IOF. +/ +/ SPECIAL CASE IS KEYBOARD INTERUPT WHEN THE GAMOVR FLAG IS +/ SET IN WHICH CASE THE GAME IS RESTARTED. +/ +/ UNEXPECTED INTERUPTS ARE COUNTED AND AFTER ENOUGH OF THEM +/ HAPPEN THE PROGRAM HALTS. IF THIS HAPPENS RELOAD OR FIND THE +/ STRANGE FLAG +/ + +INTSER, DCA INTACC /HERE RIGHT AFTER INTERUPT - STORE + RAR /AC AND LINK + DCA INTLNK /FOR POSSIBLE CONTINUATION + CLSK /WAS IT THE CRYSTAL CLOCK? + JMP INTBUS /NO TRY SOMETHING ELSE + CLA IAC RTR /LOAD 4000 + CLSA /GET CLOCKSTATUS AND RESET FLAG + CLA CLL + JMP UPDATE /YES, GO TO IT + +INTBUS, KSF /HERE ON NON-CLOCK INTERUPT + JMP .+5 /NOT THE KEYBOARD + KCC /CLEAR KEYBOARD FLAG + TAD GAMOVR /IS THE GAMEOVER + SZA CLA + JMP RESTRT /YES, RESTART +/ TCF /NO, HELL WITH IT + ISZ INTGLH /COUNT ONE BADDIE + SKP + HLT /HALT IF TOO MANY BADDIES + +INTRET, CLA CLL /HERE TO DISMISS THE INTERUPT + TAD INTLNK + RAL + TAD INTACC + ION + JMP I 0 + +INTACC, 0 +INTLNK, 0 +INTGLH, 0 + + + +/ +/ NOW BEGINS THE GREAT UPDATE PROCEEDURE, FIRST FOR SHIP +/ NUMBER ONE (THE DELTA SHAPED SHIP WHICH APPEARS ON +/ THE LEFT AT THE START OF THE GAME). IF ALIVE THE STATUS +/ WORD (INTWRD) IS TESTED FOR REQUESTS FOR LEFT TURN, +/ RIGHT TURN, THRUST ON, AND LAUNCH PROJECTILE. THESE ACTIONS +/ MAY OR MAY NOT BE ACTED UPON DEPENDING ON COUNTS AND FLAGS. +/ WHEN THIS IS COMPLETE THE SAME OPERATION IS PERFORMED FOR +/ NUMBER TWO. +/ + + *400 + +ONEUP, TAD ONEFLG /FIRST SEE IF IT'S IN NORMAL SPACE + SNA + JMP ONEOK /YES IT IS + IAC /NO, BUT IS IT JUST COMING OUT? + SNA + TAD ONEFIN /YES, THROW BACK IN IF ALREADY DESTROYED + DCA ONEFLG /OTHERWISE JUST COUNT ONE + JMP I ITWOUP /AND GO TO FIX UP NUMBER TWO + +ONEOK, TAD ONEOUT /IN NORMAL SPACE - IS IT EXPLODING? + SZA CLA + JMP ONEFIG /IF YES, ALLOW NO CONTROLS + TAD TWOFIN /HAS THE ENEMY BEEN VANQUISHED? + SZA CLA + JMS I ONEWN /YES, SIGNAL VICTORY + TAD INTWRD /NOW BEGIN TEST OF REQUEST + AND OP300 /LEFT AND RIGHT TURN TOGETHER MEAN HYPERSPACE! + TAD OM300 /TEST BITS 4 AND 5 + SZA CLA + JMP ONELEF /NOPE, CONTINUE + CMA /YES, CALL HYPER WITH AC=-1 FOR NUMBER ONE + JMP I HYPER +ONELEF, TAD INTWRD /REQUEST FOR LEFT TURN? + AND P200 /TEST BIT 4 + SNA CLA + JMP ONERYT /NO + CLA CLL CMA /YES DECREMENT ANGLE + JMP ONEFIG + +ONERYT, TAD INTWRD /HOW ABOUT RIGHT TURN + AND P100 /TEST BIT 5 + SZA CLA + IAC /YES, INCREMENT ANGLE + +ONEFIG, TAD ONETHE /PICK UP AND ADJUST ANGLE (MAYBE) + JMS I THEADJ /BRING BACK WITHIN LIMITS OF TRIG FUNCTIONS + DCA ONETHE /AND STORE + TAD ONETHE /FIND THEM TRIG FUNCTIONS + JMS I SINE /AND STORE ONCE AND FOR ALL + DCA ONESIN /IN THE APPROPRIATE PLACES + TAD ONETHE + JMS I COSINE + DCA ONECOS + TAD ONEOUT /DO NOT ALLOW THRUST IF EXPLODING + SZA CLA + JMP ONEVEL + + + + +ONEMOV, TAD ACCFLG /ALLOW ANY VELOCITY INCREASE THIS CYCLE? + SZA CLA + JMP ONEVEL /NOPE + TAD INTWRD /YES, ANY REQUESTED? + AND P40 /TEST BIT 6 + SNA CLA + JMP ONEVEL /NONE REQUESTED + TAD ONECOS /YES, ADD IN VELOCITY INCREMENT DEPENDING + TAD ONEVEY /ON ORIENTATION + JMS I VEESCL /BUT DO NOT ALLOW TO EXCEED MAXIMUM + DCA ONEVEY /AND STORE + TAD ONESIN /DO THE SAME FOR THE OTHER (X) COMPONENT + TAD ONEVEX + JMS I VEESCL + DCA ONEVEX + + + +ONEVEL, TAD ONEVEX /NOW UPDATE THE POSITION WITH THE + JMS I ISHFT /VELOCITY COMPONENTS DIVIDED BY 4 + JMS I ISHFT /THIS MAINTAINS MAXIMUM RESOLUTION + TAD ONEPEX + DCA ONEPEX /IGNORE ANY OVERFLOW + TAD ONEVEY /DO THE SAME FOR Y COORDINATE + JMS I ISHFT /AND VELOCITY COMPONENT + JMS I ISHFT + TAD ONEPEY + DCA ONEPEY + TAD ONEOUT /DO NOT ALLOW PROJECTILE LAUNCH IF + SZA CLA /EXPLODING + JMP I ITWOUP + + + + +ONELNC, TAD LNC1FG /OTHERWISE, SEE IF RELOAD IS FINISHED + SNA CLA + JMP .+3 + ISZ LNC1FG /NO, CONTINUE RELOADING + JMP I ITWOUP /AND EXIT + TAD INTWRD /YES, READY TO LAUNCH, TRIGGER BEEN PULLED? + AND P20 /TEST BIT7 + SNA CLA + JMP I ITWOUP /NO, WAIT FOR A BETTER SHOT + /.....I GUESS..... + TAD PROLIF /YES, SET CYCLE COUNT FOR THIS LAUNCH + DCA I AUTO16 /AUTO16 ALWAYS POINTS AT THE NEXT SLOT IN THE FILE + TAD ONEVEX /ADD SHIPS VELOCITY (SCALED OF COURSE) + JMS I ISHFT /TO ORIENTATION TO EXTABLISH X VELOCITY + JMS I RSHIFT /COMPONENT OF PROJECTILE + TAD ONESIN + JMS I RSHIFT /AND STICK IT IN THE FILE + DCA I AUTO16 + TAD ONESIN /MOVE THE LAUNCH POINT OUTSIDE THE + CLL RTL /SHIP OF ORIGIN + TAD ONEPEX + DCA I AUTO16 /AND STORE X POSITION + TAD ONEVEY /NOW DO THE SAME FOR THE Y VELOCITY AND + JMS I ISHFT /POSITION + JMS I RSHIFT + TAD ONECOS + JMS I RSHIFT + DCA I AUTO16 + TAD ONECOS + CLL RTL + TAD ONEPEY + DCA I AUTO16 + TAD M200 /START RELOAD CYCLE + DCA LNC1FG + JMS I RESET1 /RESET AUTO16 TO NEXT HOLE + + JMP I .+1 /NOW TO FIX IT UP WITH NUMBER TWO +ITWOUP, TWOUP + +LNC1FG, 0 /PROJECTILE LAUNCH ENABLE + +OP300, 300 /HYPERSPACE REQUEST CODE BITS 4 AND 5 +OM300, -300 +ONEWN, ONEWIN /POINTER TO VICTORY MESSAGE + + + +/ +/ HERE BEGINS THE UPDATE PROCEEDURE FOR SHIP NUMBER TWO. +/ OPERATION IS THE SAME AS FOR NUMBER ONE ABOVE. +/ + + *600 + +TWOUP, TAD TWOFLG /FIRST SEE IF IT'S IN NORMAL SPACE + SNA + JMP TWOOK /YES, CONTINUE + IAC /NO, BUMP COUNT AND TEST FOR REENTRY + SNA + TAD TWOFIN /IF RE-ENTERING THROW BACK OUT IF FINISHED + DCA TWOFLG /AND CONTINUE + JMP I IONEST + +TWOOK, TAD TWOOUT /HERE WHEN READY TO UPDATE IN NORMAL SPACE + SZA CLA /IS IT EXPLODING? + JMP TWOFIG /YES DO NOT ALLOW HYPERSPACE + TAD ONEFIN /DID WE JUST WIN? + SZA CLA + JMS I TWOWN /YES ENABLE END OF GAME MESSAGE + TAD INTWRD /TEST FOR HYPERSPACE REQUEST + AND OP14 + TAD OM14 /BITS 8 AND 9 MUST BE SET + SNA CLA + JMP I HYPER /8 AND 9 SET. ENTER HYPER ROUTINE WITH AC=0 + /FOR SHIP NUMBER 2 +TWOLEF, TAD INTWRD /TEST FOR LEFT TURN - BIT 8 + AND P10 + SNA CLA + JMP TWORYT /NOT SET + CLA CLL CMA /SET, DECREMENT TWOTHE BY 1 DEGREE + JMP TWOFIG /SKIP TEST FOR RIGHT TURN + +TWORYT, CLA CLL IAC RTL /TEST FOR RIGHT TURN - BIT 9 + AND INTWRD + SZA CLA + IAC /IF SET INCREMENT TWOTHE BY 1 DEGREE + +TWOFIG, TAD TWOTHE /UPDTAE TWOTHE + JMS I THEADJ /BRING TO WITHIN LIMITS OF SINE,COSINE + DCA TWOTHE /AND STORE + TAD TWOTHE + JMS I SINE /CALCULATE SINE AND COSINE FUNCTIONS + DCA TWOSIN /AND STORE IN DATA TABLE + TAD TWOTHE + JMS I COSINE + DCA TWOCOS + TAD TWOOUT /DO NOT ALLOW VELOCITY CHANGE IF EXPLODING + SZA CLA + JMP TWOVEL + + + + +TWOMOV, TAD ACCFLG /NOW FOR ACCELERATION. TEST TO SEE IF ALLOWED + SZA CLA /DURING THIS UPDATE CYCLE + JMP TWOVEL /NOPE + CLL IAC RAL /YES, TEST FOR BIT 2 SET + AND INTWRD + SNA CLA + JMP TWOVEL /NOT SET + + TAD TWOSIN /UPDATE X VELOCITY COMPONENT BY SINE OF + TAD TWOVEX /ANGLE OF ORIENTATION + JMS I VEESCL /AND SCALE TO NOT EXCEED MAX + DCA TWOVEX /UPDATE Y COMPONENT WITH COSINE + + TAD TWOCOS + TAD TWOVEY + JMS I VEESCL + DCA TWOVEY + + + +TWOVEL, TAD TWOVEX /NOW UPDATE THE POSITION WITH THE VELOCITY + JMS I ISHFT /COMPONENTS/16 + JMS I ISHFT + TAD TWOPEX + DCA TWOPEX + TAD TWOVEY + JMS I ISHFT + JMS I ISHFT + TAD TWOPEY + DCA TWOPEY + TAD TWOOUT + SZA CLA + JMP I IONEST + + + + +TWOLNC, TAD LNC2FG /NOW CHECK FOR PROJECTILE LAUNCH. FIRST + SNA CLA /TEST TO SEE IF RELOAD COMPLETE + JMP .+3 + ISZ LNC2FG /NO, COUNT ONE CYCLE AND EXIT + JMP I IONEST + IAC /YES, TEST TRIGGER BIT 11 + AND INTWRD + SNA CLA + JMP I IONEST /NOT SET, HELL WITH IT + + TAD PROLIF /OK, SET PROJECTILE LIFE + DCA I AUTO16 /AUTO16 IS ALWAYS POINTING AT THE NEXT SLOT + TAD TWOVEX /ADD SHIPS VELOCITY + JMS I ISHFT /(ADJUSTED) + JMS I RSHIFT + TAD TWOSIN /TO THAT OF PROJECTILE - AGAIN X COMPONENT + JMS I RSHIFT /FROM SINE OF ANGLE OF ORIENTATION + DCA I AUTO16 + TAD TWOSIN /SET INITIAL POSITION TO BE JUST AHEAD + CLL RTL /OF THE SHIP + TAD TWOPEX /X COMPONENT + DCA I AUTO16 + TAD TWOVEY /NOW THE Y COMPONENTS FROM Y VELOCITY + JMS I ISHFT /Y POSITION AND COSINE + JMS I RSHIFT + TAD TWOCOS + JMS I RSHIFT + DCA I AUTO16 + TAD TWOCOS + CLL RTL + TAD TWOPEY + DCA I AUTO16 + TAD M200 + DCA LNC2FG /200 CYCLES OF RELOAD + JMS I RESET1 /DRINK LEADEN DEATH, NUMBER ONE! + + JMP I .+1 /FINAL EXIT TO DISPLAY FILE CALCULATIONS +IONEST, ONESET + +LNC2FG, 0 /RELOAD COUNT + +OP14, 14 /HYPERSPACE CODE +OM14, -14 +TWOWN, TWOWIN + + + +/ +/ HERE BEGINS THE DISPLAY CALCULATIONS FOR THE TWO SHIPS. AT +/ THIS POINT ONLY THE POSITION AND ORIENTATION OF EACH VESSEL +/ IS ONF INTEREST SINCE THE VELOCITY AND ALL THAT HAVE ALREADY +/ BEEN TAKEN CARE OF. FOR THE BOTH SHIPS THE DISPLAY FILES ARE +/ CALCULATED AS A SERIES OF PAIRS OF X,Y COORDINATES. BETWEEN +/ EACH PAIR OF POINTS A FOUR POINT VECTOR WILL BE DRAWN. THE +/ ACTUAL COORDINATES ARE CALCULATED AS DISPLACEMENTS +/ FROM THE CENTRAL PSOTION OF THE SHIP, TAKING INTO ACCOUNT THE +/ ANGLE OF ORIENTATION. THE FORMULAS FOLLOWED ARE: +/ +/ X(POINT)=X(BASE)+X(REL)*COS[THE]+Y(REL)*SINE[THE] +/ +/ Y(POINT)=Y(BASE)+Y(REL)*COS[THE]-X(REL)*SINE[THE] +/ +/ WHERE SINE[THE] AND COS[THE] ARE THE FUNCTIONS OF THE +/ ANGLE OF ORIENTATION, X(BASE) AND Y(BASE) ARE THE +/ COORDINATES OF THE SHIPS POSITION AND X(REL) AND Y(REL) +/ CORRESPOND TO DISPLACEMENT PAIRS DEPENDING ON THE SHAPE +/ OF THE FIGURE. ALL X AND Y RELS LIE WITHIN THE RANGE 0-3 AND +/ THERE FORE ALL NECESSARY DISPLACEMENTS FROM BASE COORDINATES +/ MAY BE CALCULATEDFROM DIFFERENT COMBINATIONS OF T10SIN, T20COS +/ ETC. THESE VALUES ARE CALCULATED BY A CALL TO POSCAL WITH THE SINE +/ AND COSINE OF THE ANGLE OF INTEREST IN CALSIN AND CALCOS. +/ +/ FOLLOWING THIS METHOD ANY FIGURE DESCRIBABLE WITH A 7 BY 7 +/ MATRIX OF POINTS MAY BE QUICKLY CALCULATED. +/ +/ BEGINNING AT ONESET DIFFERENT DISPLACEMENT PAIRS ARE CALCULATED +/ AND DEPOSITIED THROUGH AUTO10 TO FORM THE DISPLAY FILE FOR SHIP NUMBER ONE. +/ + + + *1000 + +ONESET, CLA CLL /BEGIN DISPLAY FILE FOR NUMBER ONE + TAD ONEFLG /DONT BOTHER IF NOT IN NORMAL SPACE + SZA CLA + JMP I ITWOST + TAD ONESIN /SET UP FOR MATRIX COMPONENT CALCULATIONS + DCA CALSIN + TAD ONECOS + DCA CALCOS + JMS I CALPOS /CALL THE CALCULATOR + +/ +/ CONSIDER THE 7 BY 7 MATRIX OF DISPLACEMENT POINTS WITH THE +/ CENTER AT 0,0 CORRESPONDING TO THE SHIPS POSITION. A SERIES +/ OF POINTS IS NOW DESCRIBED AROUND THIS CENTER USING THE +/ MULTIPLES OF THE TRIG FUNCTIONS JUST CALCULATED +/ SO THAT ANY POINT ON THE OUTLINE IS DESCRIBABLE AS X,Y +/ DISPLACED BY X,Y OF THE SHIP ITSELF +/ + + TAD ONEFIL /SET UP AUTO10 AS THE DISPLAY FILE + DCA AUTO10 /POINTER + TAD ONEPEX /THE FIRST POINT OF THE OUTLINE IS + TAD T30SIN + DCA I AUTO10 / 0,3 OR TOP CENTER + TAD ONEPEY + TAD T30COS + DCA I AUTO10 + + TAD T10COS + CIA /THE SECOND IS + TAD ONEPEX + DCA I AUTO10 / -1,0 + TAD T10SIN /OR JUST LEFT OF DEAD CENTER + TAD ONEPEY /AND SO ON + DCA I AUTO10 + + TAD T30SIN + TAD T30COS /THE THIRD POINT IS + CIA + TAD ONEPEX / -3,-3 + DCA I AUTO10 + TAD T30COS /OR BOTTOM LEFT HAND CORNER + CIA + TAD T30SIN + TAD ONEPEY + DCA I AUTO10 + + + + + TAD T10SIN + CIA /FOURTH POINT + TAD ONEPEX + DCA I AUTO10 / 0,-1 + TAD T10COS + CIA /OR JUST BELOW CENTER + TAD ONEPEY + DCA I AUTO10 + +FLAM1, TAD INTWRD /TEST FOR POWER ON. IF ON, DRAW THE + AND P40 /FLAME WITH AN EXTRA POINT SOME + SNA CLA /DISTANCE DIRECTLY BELOW THE SHIP + JMP ONECON /POWER NOT ON - CONTINUE + TAD ONEOUT /DO NOT ALLOW IF EXPLODING + SZA CLA + JMP ONECON + + TAD ONFG1 /USE ONFG1 TO TURN THE FLAME ON AND + SNA /OFF TO MAKE IT FLICKER. DISPLAY THE + CLA CLL CMA RAL /FLAME ONE TIME OUT OF THREE + DCA ONFG1 + + ISZ ONFG1 + JMP ONECON /ONE OUT OF THREE TIMES THIS WILL SKIP + + TAD ONFG2 /VARY ALSO THE LENGHT OF THE FLAME + CMA /WITH LONG SHORT LONG SHORT + DCA ONFG2 + + TAD ONFG2 /TIP OF FLAME AT EITHER + SNA CLA + TAD T10SIN / 0,-4 OR + TAD T30SIN / 0,-3 + CIA + TAD ONEPEX + DCA I AUTO10 + TAD ONFG2 + SNA CLA + TAD T10COS + TAD T30COS + CIA + TAD ONEPEY + DCA I AUTO10 + + TAD T10SIN + CIA + TAD ONEPEX /RETURN DISPLAY TO 0,-1 + DCA I AUTO10 + TAD T10COS + CIA + TAD ONEPEY + DCA I AUTO10 + CLA CLL CMA RAL /ADD -2 TO POINT COUNT + + + + +ONECON, TAD M6 /SET POINT COUNT TO -6 OR -8 + DCA ONECNT + + TAD T30SIN /CONTINUE WITH DISPLAY FILE - THIS POINT + CIA + TAD T30COS / AT 3,-3 + TAD ONEPEX / + DCA I AUTO10 /OR LOWER RIGHT HAND CORNER + TAD T30SIN + TAD T30COS + CIA + TAD ONEPEY + DCA I AUTO10 + + TAD T10COS /NEXT + TAD ONEPEX / + DCA I AUTO10 / 1,0 + TAD T10SIN / + CIA / OR JUST RIGHT OF CENTER + TAD ONEPEY + DCA I AUTO10 + + TAD T30SIN /FINALLY BACK TO + TAD ONEPEX / + DCA I AUTO10 / 0,3 + TAD T30COS / + TAD ONEPEY / TOP CENTE + DCA I AUTO10 + + JMP I ITWOST /NOW FOR NUMBER TWO +ITWOST, TWOSET + +ONFG1, 0 /USED TO COUNT FLICKERS +ONFG2, 0 /SHORT OR LONG FLAG + + + +/ +/ HERE BEGINS THE DISPLAY FILE GENERATOR FOR SHIP TWO. +/ IT WORKS JUST LIKE THE ONE FOR NUMBER ONE BUT WITH +/ DIFFERENT DISPLACEMENT PAIRS AND TWO EXTRA POINTS +/ + + *1200 + +TWOSET, CLA CLL /DONT BOTHER IF NOT IN NORMAL SPACE + TAD TWOFLG + SZA CLA + JMP I IFILDS + TAD TWOSIN /SET UP TO HAVE DISPLACEMENT INCREMENTS + DCA CALSIN /CALCULATED + TAD TWOCOS + DCA CALCOS + JMS I CALPOS + + TAD TWOFIL /SET AUTO10 TO POINT TO SECOND DISPLAY + DCA AUTO10 /FILE + TAD T30SIN /FIRST POINT AT + TAD TWOPEX / + DCA I AUTO10 / 0,3 + TAD T30COS / + TAD TWOPEY / OR TOP CENTER + DCA I AUTO10 + + TAD T20COS + CIA + TAD T20SIN + TAD TWOPEX + DCA I AUTO10 + TAD T20SIN + TAD T20COS /SECOND POINT + TAD TWOPEY / -2,2 + DCA I AUTO10 + + TAD T20COS /THIRD POINT + CIA / -2,0 + TAD TWOPEX + DCA I AUTO10 + TAD T20SIN + TAD TWOPEY + DCA I AUTO10 + + + + TAD T20COS + TAD T30SIN + CIA + TAD TWOPEX /FOURTH POINT + DCA I AUTO10 / -2,-3 + TAD T30COS + CIA + TAD T20SIN + TAD TWOPEY + DCA I AUTO10 + + + + + TAD T20SIN + CIA /NEXT + TAD TWOPEX / 0,-2 + DCA I AUTO10 + TAD T20COS + CIA + TAD TWOPEY + DCA I AUTO10 + +FLAM2, CLA CLL IAC RAL /NOW THE FLAME BIT. CHECK FOR POWER ON + AND INTWRD + SNA CLA + JMP TWOCON /NO, FORGET IT + TAD TWOOUT /NOT ALLOWED IF EXPLODING + SZA CLA + JMP TWOCON + + TAD TWFG1 /SET THE 1-3 FLICKER AS WITH #1 + SNA + CLA CLL CMA RAL + DCA TWFG1 + + ISZ TWFG1 /ALSO THE LENGHT VARIATION + JMP TWOCON + + TAD TWFG2 /EVERY OTHER TIME LONG + CMA + DCA TWFG2 + /FLAME TIP AT EITHER + TAD TWFG2 / 0,-3 + SNA CLA /OR + TAD T20SIN / 0,-5 + TAD T30SIN + CIA + TAD TWOPEX + DCA I AUTO10 + TAD TWFG2 + SNA CLA + TAD T20COS + TAD T30COS + CIA + TAD TWOPEY + DCA I AUTO10 + + TAD T20SIN /NOW BACK UP TO THE SHIP + CIA + TAD TWOPEX + DCA I AUTO10 + TAD T20COS + CIA + TAD TWOPEY + DCA I AUTO10 + + CLA CLL CMA RAL /ADD -2 TO POINT COUNT + + + + +TWOCON, TAD M10 /SET POINT COUNT TO -8 OR -10 + DCA TWOCNT + + TAD T30SIN /CONTINUE WITH DISPLAY FILE + CIA /NEXT POINT AT 2,-3 + TAD T20COS + TAD TWOPEX + DCA I AUTO10 + TAD T30COS + TAD T20SIN + CIA + TAD TWOPEY + DCA I AUTO10 + + + + TAD T20COS /NEXT POINT + TAD TWOPEX / + DCA I AUTO10 / 2,0 + TAD T20SIN + CIA + TAD TWOPEY + DCA I AUTO10 + + TAD T20COS /AND THE NEXT AT + TAD T20SIN + TAD TWOPEX / 2,2 + DCA I AUTO10 + TAD T20SIN + CIA + TAD T20COS + TAD TWOPEY + DCA I AUTO10 + + TAD T30SIN + TAD TWOPEX + DCA I AUTO10 + TAD T30COS /AND THE LAST AT + TAD TWOPEY / + DCA I AUTO10 / 0,3 + + JMP I IFILDS /NOW TO DISPLAY THE WHOLE MESS +IFILDS, FILDIS + +TWFG1, 0 /FLIK THE FLAME +TWFG2, 0 /LONG OR SHORT + + + +/ +/ HERE TO DISPLAY THE TWO SHIPS. CHECK FIRST FOR COLLISION +/ AND THEN SET THE TWO PAIRS OF COORDENATES FOR THE END +/ POINTS AND CALL THE "VECTOR GENERATOR" TO DRAW THE DOTS +/ IN BETWEEN. WHEN THE COUNT OVERFLOWS DO THE SAME FOR +/ NUMBER TWO. THEN EXIT TO DISPLAY ALL THE PROJECTILES. +/ + + *1400 + +FILDIS, CLA CLL /ALL SET TO GO + JMS I COLIDE /TEST FOR COLLISION FIRST +/ DSB 1 /IF NO COLLISION + TAD ONEFLG /SKIP NUMBER ONE IF NOT IN NORMAL + SZA CLA /SPACE + JMP TWODIS + + TAD ONEFIL /SET UP POINTERS TO DISPLAY FILE + DCA AUTO10 /FOR NUMBER ONE + TAD ONECNT /ALONG WITH VECTOR COUNT + DCA AUTO11 + TAD I AUTO10 /SET OUT THE FIRST POINT PAIR + DCA XONEDS + TAD I AUTO10 + DCA YONEDS + TAD ONEOUT /NORMAL DISPLAY OR EXPLOSION? + SZA CLA + JMP I IONEEX /GO ELSE WHERE FOR EXPLOSION + +FILONE, TAD I AUTO10 /STEP TO NEXT PAIR OF POINTS + DCA XTWODS /SET X AND Y TO NEW POINT + TAD I AUTO10 + DCA YTWODS + JMS I VECTOR /CALL THE DOT DRAWING MACHINE + ISZ AUTO11 + SKP /COUNT + JMP TWODIS /DO NUMBER TWO ON OVERFLOW + TAD XTWODS /SWAP POINTS FOR NEXT PAIR + DCA XONEDS + TAD YTWODS /THE GENERATOR DRAWS FROM ONE + DCA YONEDS /TOWARDS TWO + JMP FILONE + + + + +TWODIS, TAD TWOFLG /HERE TO DO NUMBER TWO + SZA CLA /BUT NOT IF IN HYPER SPACE + JMP I IPRODS + + TAD TWOFIL /SET UP FILE POINTER AS IN ONE + DCA AUTO10 + TAD TWOCNT /AND THE COUNT + DCA AUTO11 + TAD I AUTO10 /I SUPPOSE THIS COULD BE A SUBROUTINE TOO + DCA XONEDS + TAD I AUTO10 + DCA YONEDS + TAD TWOOUT /IS IT EXPLODING? + SZA CLA + JMP I ITWOEX /YES, HOW EXCITING + +TWDLOP, TAD I AUTO10 /NO HOW DULL, STICK IN NEXT PAIR OF + DCA XTWODS /POINTS + TAD I AUTO10 + DCA YTWODS /AND CALL THE VECTOR SEQUENCE + JMS I VECTOR + ISZ AUTO11 + JMP .+3 + + JMP I .+1 /WHEN COUNT OVERFLOWS GO ON TO +IPRODS, PRODIS /DO THE PROJECTILE THING + + TAD XTWODS /OTHERWISE SWAP ON TO THE NEXT PAIR + DCA XONEDS /OF POINTS + TAD YTWODS + DCA YONEDS + JMP TWDLOP + +COLIDE, COLLID +IONEEX, ONEEXP +ITWOEX, TWOEXP + + + +/ +/ THIS IS THE SO CALLED "VECTOR GENERATOR" WHICH DRAWS A +/ SERIES OF DOTS FROM XONEDS,YONEDS TO XTWODS,YTWODS. +/ THE COORDINATE COMPONENTS ARE DIVIDED INTO FOURTHS AND +/ FOUR DOTS DRAWN ON THE SCOPE SCREEN. NOTE THAT NO DOT +/ IS DRAWN AT XONEDS,YONEDS. THIS IS COMPENSATED FOR ELSEWHERE. +/ + +DISPLY, 0 /ENTER TO DRAW A FOUR POINT VECTOR + CLA + TAD XONEDS /FROM XONEDS,YONEDS + CIA /TO XTWODS,YTWODS + TAD XTWODS /DIVIDE COORDINATE DIFERENCES INTO + JMS DISHFT /FOURTHS + DCA DIXTEM /AND STORE INCREMENT + TAD YONEDS + CIA + TAD YTWODS + JMS DISHFT /FOURTHS + DCA DIYTEM + TAD M4 /FOR FOUR DOTS + DCA DISCNT + +DISLOP, TAD XONEDS /ADD INCREMENT TO CURRENT X AND Y + TAD DIXTEM + DCA XONEDS /NOTE THAT THIS ROUTINE DESTROYS + TAD YONEDS /XONEDS AND YONEDS + TAD DIYTEM + DCA YONEDS + TAD XONEDS +/ RTR /DIVIDE BY 8 TO FIT SCREEN SIZE +/ RAR + DXC DXL /SET X VALUE + CLA + TAD YONEDS /DO THE SAME FOR Y +/ RTR +/ RAR + DYC DYL DIS /AT LAST SOMETHING TO SEE!! + CLA + ISZ DISCNT /DONE YET? + JMP DISLOP /NOPE + JMP I DISPLY /YUP + + +DISHFT, 0 /A GENERALIZED SHIFT ROUTINE CALLED + CLL /FROM EVERYWHERE TO DIVIDE THE + SPA /AC BY FOUR WITH AN ASR RIGHT + CML IAC /NOTE THAT NEGATIVE NUMBERS ARE + RAR /ROUNDED UPWARDS (TOWARD ZERO) + CLL /TO MAKE IT COME OUT RIGHT + SPA + CML IAC /EVEN SO THERE ARE SOME ROUNDING ERRORS + RAR /SOMEWHERE. SO MUCH FOR 12 BIT MACHINES + JMP I DISHFT + + + +/ +/ HERE TO DISPLAY ALL THE PROJECTILES AND TEST FOR HITS. +/ THE PROJECTILE DISPLAY FILE IS SEARCHED FOR PROJECTILES WITH +/ NON-ZERO COUNTS AND WHEN ONE IS FOUND THE POSITION IS +/ UPDATED BY THE VELOCITY, THE POINT DISPLAYED AND TESTED FOR +/ A HIT. +/ + + *1600 + +PRODIS, CLA CLL / BEGIN DISPLAY OF THE PROJECTILES + TAD BUFST /POINT TO BEGINNING OF DISPLAY FILE + DCA BUFTMP +/ DSB 2 /SET EXTRA BRIGHT FOR SINGLE POINTS + +PROLOP, TAD I BUFTMP /PICK UP NEXT COUNT + SNA + JMP EXPIRE /THIS ONE IS DEAD - GO TO THE NEXT + IAC /INCREMENT COUNT AND REPLACE + DCA I BUFTMP + ISZ BUFTMP /BUMP POINTER TO X VELOCITY + TAD I BUFTMP + ISZ BUFTMP /THEN TO XPOSITION AND UPDATE X POSITION + TAD I BUFTMP /WITH THE VELOCITY WHICH IS CONSTANT + DCA I BUFTMP + TAD I BUFTMP + DCA PROX /AND STORE X POSITION FOR DISPLAY AND TEST + ISZ BUFTMP /NOW TO Y POSITION AND VELOCITY + TAD I BUFTMP + ISZ BUFTMP + TAD I BUFTMP /SAME LITTLE GAME + DCA I BUFTMP + TAD I BUFTMP + DCA PROY /STORE THE NEW Y VALUE + + TAD PROX /DISPLAY THE POINT WITH +/ RTR /THE SAME SHIFT AS FOR THE SHIPS +/ RAR /FOR THE SMALL SCREEN + DXC DXL + CLA + TAD PROY +/ RTR / +/ RAR + DYC DYL DIS /THERE IT IS!! + CLA + JMS I CHKOUT /TEST FOR A HIT + ISZ BUFTMP /MOVE POINTER ON AND TEST FOR END + TAD BUFTMP /OF BUFFER + TAD BUFLIM + SZA CLA + JMP PROLOP /NOT AT END - CONTINUE + + +/ +/ HERE AT THE END OF THE PROJECTILE DISPLAY. IF THE GAMOVR +/ FLAG IS SET, GO ON TO THE MESSAGE DISPLAY - VICTORY LAP +/ SECTION. OTHERWISE PICK UP THE REMAINING CLOCK COUNT +/ TO GIVE THE FANS SOMETHING TO LOOK AT, AND MOVE THE +/ ELECTRON BEAM TO A LOWER CORNER. THE COUNT DISPLAYED +/ IN THE AC IS THE NUMBER OF 100 USEC CLOCK TICKS REMAINING +/ WHEN THIS CODE IS REACHED BEFORE THE NEXT UPDATE WOULD +/ BEGIN. TURNS OUT THAT ROUGHLY 2/3 OF THE CPU IS LEFT +/ OVER SHOULD ANYONE WANT TO DO ANYTHING VERY FANCY. +/ + + +FINISH, TAD GAMOVR /IS THIS THE VICTORY LAP OR WHAT? + SZA CLA + JMP I ENDGAM /YES, GO TO PUT UP THE MESSAGE +/ TAD M400 /MOVE THE BEAM OFF SCREEN +/ DYC DYL + CLA CLL +/ DXC DXL + TAD INTCNT /PICK UP THE COUNT + CIA + JMP . + +ENDGAM, JOBLOP + + +EXPIRE, TAD BUFTMP /HERE TO ADVANCE THE BUFFER + TAD P5 /POINTER TO THE NEXT PROJECTILE + DCA BUFTMP /UNLESS THE END + TAD BUFTMP /OF THE BUFFER + TAD BUFLIM /IS REACHED + SZA CLA /IN WHICH CASE + JMP PROLOP /IT + JMP FINISH /QUITS + +BUFST, DISBUF+101 +BUFLIM, -DISBUF-175 +CHKOUT, CHECK + +RESE1, 0 /THIS IS CALLED TO SET THE POINTER + TAD MRES /(AUTO16) TO THE NEXT FREE SLOT + DCA RESCNT /FOR A PROJECTILE LAUNCH. 12 POSSIBLE + +RESLOP, TAD RESPNT /MOVE THE POINTER TO THE NEXT SLOT + TAD P5 + DCA RESPNT + TAD RESPNT /RESTE IF AT END OF BUFFER + TAD BUFLIM + SZA CLA + JMP RESCON + TAD BUFST + DCA RESPNT + +RESCON, TAD I RESPNT /FIND A HOLE YET? + SNA CLA + JMP RESFND /YES, SET UP AUTO16 + ISZ RESCNT /NO COUNT + JMP RESLOP /AND TRY AGAIN + HLT /NO HOLES AT ALL? + +RESFND, CMA /BACK THE POINTER FOR AUTO INDEXING + TAD RESPNT + DCA AUTO16 + JMP I RESE1 + +MRES, -14 +RESCNT, 0 +RESPNT, 0 + +SETBUF, 0 + CMA /THIS ROUTINE IS CALLED FROM THE + TAD BUFST /STARTING SEQUENCE TO INITIALIZE ALL + DCA AUTO16 /THE BUFFER POINTERS AND SO ON + TAD BUFST + DCA BUFTMP + TAD BUFST + DCA RESPNT + TAD BUFST + DCA SETPNT +SETLOP, DCA I SETPNT + ISZ SETPNT + TAD SETPNT + TAD BUFLIM + SZA CLA + JMP SETLOP + JMP I SETBUF + +SETPNT, 0 + + + +/ +/ THIS HERE NOW THING CHECKS THE COORDINATES OF THE MOST RECENTLY +/ DISPLAYED PROJECTILE AGAINST THOSE OF THE SHIPS ON THE SCREEN. +/ IF WITH A COLLISION LIMIT A HIT IS RECORDED AND THE LIFE +/ COUNT OF THE PROJECTILE ZEROED TO REMOVE IT. A HIT SHIP +/ IS SUITABLY FLAGGED +/ + + *2000 + +CHECK, 0 /HERE TO TEST FOR A PROJECTILE HIT + TAD ONEFLG /CANT HIT SOMETHING IN HYPERSPACE + SZA CLA + JMP CHECK2 + TAD ONEOUT /OR SOMETHING THAT'S BEEN HIT + SZA CLA + JMP CHECK2 + + TAD PROX /CHECK X COORDINATES OF SHIP ONE + CIA /AND PROJECTILE + TAD ONEPEX /THIS SORT OF THING IS WHY THE + SPA /COORDINATES HAVE TO BE MAINTAINED TO 12 + CIA /BITS + TAD LIMIT /CLOSE ENOUGH? + SMA CLA + JMP CHECK2 /IF X ISN' CLOSE ENOUGH THEN NO HIT + TAD PROY /X WAS CLOSE ENOUGH, HOW ABOUT Y? + CIA + TAD ONEPEY + SPA + CIA + TAD LIMIT + SMA CLA + JMP CHECK2 /NO HIT + + TAD MEXP /DEPOSIT EXPLOSION COUNT IN ONEOUT + DCA ONEOUT /ALL THAT IS NECESSARY + JMS CUTOUT /REMOVE PROJECTILE + + + + +CHECK2, TAD TWOFLG /NO HIT ON NUMBER ONE, TRY NUMBER TWO + SZA CLA + JMP I CHECK /BUT NOT IF IN HYPERSPACE + TAD TWOOUT /OR IF ALREADY HIT + SZA CLA + JMP I CHECK + + TAD PROX /CHECK X'S FIRST + CIA + TAD TWOPEX + SPA /GET ABSOLUTE VALUE OF DIFFERENCE + CIA + TAD LIMIT /AND TEST MAGNITUDE AGAINST PROXIMITY + SMA CLA /LIMIT + JMP I CHECK /NOWHERE NEAR CLOSE + + TAD PROY /NYAH, NYAH + CIA /TRY THE Y'S + TAD TWOPEY + SPA + CIA /ABSOLUTE VALUE OF DIFFERENCE + TAD LIMIT + SMA CLA + JMP I CHECK /CLEAN MISS! + + TAD MEXP /HIT ON TWO - END EVERYTHING BY SETTING + DCA TWOOUT /TWOOUT TO NON-ZERO EXPLOSION COUNT + JMS CUTOUT + JMP I CHECK /EXIT AFTER DESTOYING PROJECTILE + +LIMIT, -120 /PROXIMITY LIMIT FOR WHAT CONSTITUTES A HIT + +CUTOUT, 0 /THIS ROUTINE ZEROES OUT THE MOST RECENTLY + TAD M4 /DISPLAYED PROJECTILE BY ZEROEING THE + TAD BUFTMP /COUNT + DCA CUTPNT + DCA I CUTPNT + JMP I CUTOUT + +CUTPNT, 0 + + + +/ +/ THIS ROUTINE IS CALLED TO TEST FOR A COLLISION BETWEEN THE +/ TWO SHIPS. THE COORDINATES OF BOTH ARE COMPARED +/ AND IFF SUFFICIENTLY CLOSE BOTH ARE DESTROYED BY SETTING +/ THEIR EXPLOSION COUNTS NON-ZERO. +/ + + +COLLID, 0 /HERE TO TEST FOR COLLISION + TAD ONEFLG /NO TEST IF EITHER SHIP IS IN + SZA CLA /HYPERSPACE OR EXPLODING + JMP I COLLID + TAD TWOFLG + SZA CLA + JMP I COLLID + TAD ONEOUT + SZA CLA + JMP I COLLID + TAD TWOOUT + SZA CLA + JMP I COLLID + + TAD ONEPEX /BOTH SHIPS AVAILABLE FOR COLLISION + CIA /CHECK X COORDINATES FIRST + TAD TWOPEX + SPA /GET ABSOLUTE VALUE OF DIFFERENCE + CIA + TAD COLLIM /CLOSE ENOUGH? + SMA CLA + JMP I COLLID /NOPE, FORGET IT + + TAD ONEPEY /YES, NOW TRY THE Y COORDINATES + CIA + TAD TWOPEY + SPA + CIA /GET MAGNITUDE ONLY + TAD COLLIM + SMA CLA /CLOSE ENOUGH? + JMP I COLLID + TAD MEXP /YES, SET BOTH EXPLOSION COUNTS + DCA ONEOUT + TAD MEXP + DCA TWOOUT + JMP I COLLID + +COLLIM, -300 + + +/ +/ THIS ROUTINE IS CALLED TO SET ONE OF THE TWO SHIPS INTO +/ HYPERSPACE. ON ENTRY THE AC=-1 FOR SHIP #1, 0 FOR SHIP +/ NUMBER 2. THE LOCATION CLOCK IS USED FOR A RANDOM +/ ADDRESS POINTER FROM WHICH WILL BE DRAWN THE +/ VARIOUS PARAMETERS FOR REENTRY. +/ + + *2200 + +HYPSET, DCA RTNFLG /HERE WITH AC=-1 OR 0 + TAD RTNFLG /SET UP LIST POINTER + SZA CLA + TAD ONEDIF /TO APPROPRIATE SHIP FILE + TAD TWOLST + DCA AUTO15 + + CLCA /SET UP "RANDOM NUMBER GENERATOR" + /USE CLOCK COUNTER FOR THAT PURPOSE + DCA AUTO17 + TAD I AUTO17 /PICK UP FIRST THE AMOUNT OF TIME + AND TIMOUT /OUT OF NOMAL SPACE LIMITED TO -777 + CIA /UPDATE CYCLES ( ABOUT 15 SECONDS) + DCA I AUTO15 /AND STORE IN ONEOUT OR TWO OUT + + TAD I AUTO17 /THE NEXT RANDOM NUMBER BECOMES THE + JMS I THEADJ /ANGLE OR ORIENTATION ON REENTRY + DCA I AUTO15 + TAD I AUTO17 /AND THE NEXT BECOMES THE X VELOCITY + JMS VEESET /COMPONENT + DCA I AUTO15 + TAD I AUTO17 /AND THEN THE Y COMPONENT + JMS VEESET + DCA I AUTO15 + TAD I AUTO17 + DCA I AUTO15 + + TAD I AUTO17 + DCA I AUTO15 + + TAD I AUTO17 /FINALLY SEE IF RETURN WILL BE SUCCESSFLY + AND TIMOUT + TAD MHYP /ABOUT 3/4 CHANCE + SMA CLA + JMP HYPRET /OK + TAD RTNFLG /THIS IS THE ONE TIME IN FOUR. SET + SZA CLA /UP FOR EXPLOSION ON REENTRY + TAD ONEDIF + TAD OUTLOC + DCA VEESET + TAD MEXP + DCA I VEESET + +HYPRET, ISZ RTNFLG + JMP I TWORTN + JMP I ONERTN + +TIMOUT, 777 +ONEDIF, ONEFLG-TWOFLG +TWOLST, TWOFLG-1 +RTNFLG, 0 +ONERTN, TWOUP +TWORTN, ONESET +OUTLOC, TWOOUT +MHYP, -200 + + + + +VEESET, 0 /HERE TO LIMIT VELOCITY COMPONENTS + CLL + SPA /GET MAGNITUDE + CML + AND HM177 /LIMIT TO 177 + SZL CLL + CIA + JMP I VEESET /AND EXIT + +HM177, 177 + +ONEEXP, CLA CLL /HERE TO DISPLAY SHIP NUMBER ONE AS + TAD ONETHE /AN EXPLOSION + TAD INCONE /FIRST ROTATE IT BY A GOOD DOLLOP + DCA ONETHE + JMS I IXPDIS /THEN CALL THE EXPLOSION GENERATOR + ISZ ONEOUT /DONE WITH THE EXPLOSION? + JMP I NOWTWO /NO, NORMAL RETURN + + IAC /YES, SET INTO PSEUDO HYPER SPACE + DCA ONEFLG + IAC /DISABLE RETURN FROM HYPER SPACE + DCA ONEFIN + + TAD TWOFIN /IS NUMBER TWO STILL AROUND? + SNA CLA + JMP I NOWTWO /YES, RETURN + JMP I TIEUP /NO, TIE BALL GAME + + + +TWOEXP, CLA CLL /HERE TO DISPLAY SHIP NUMBER TWO + TAD TWOTHE /AS AN EXPLOSION. BASH IT AROUND + TAD INCTWO + DCA TWOTHE + JMS I IXPDIS /THEN DISPLAY IT + ISZ TWOOUT /DONE WITH EXPLOSION? + JMP I NOWPRO /NO, NORMAL RETURN + + IAC /YES, SEND INTO PSEUDO HYPER SPACE + DCA TWOFLG + IAC /DISABLE NORMAL RETURN FROM HYPERSPACE + DCA TWOFIN + /CHECK NUMBER ONE + TAD ONEFIN + SZA CLA /STILL ALIVE AND WELL? + JMP I TIEUP /NO, TIE GAME + JMP I NOWPRO /YES, CONTINUE ON +NOWTWO, TWODIS +NOWPRO, PRODIS +TIEUP, NOWIN +IXPDIS, EXPDIS +INCONE, 55 +INCTWO, 55 + + + +/ +/ HERE TO DISPLAY THE FIGURE POINTED TO BY AUTO10 AS +/ AN EXPLOSION. THIS WORKS THE SAME WAY AS THE NORMAL +/ DISPLAY ROUTINE EXCEPT THAT THE COORDINATE INCREMENTS +/ ARE INVERTED TURNING THE FIGURE INSIDE OUT FOR S +/ A SORT OF CLOBBY EXPLOSION. +/ + + *2400 + +EXPDIS, 0 /HERE TO DISPLAY A FIGURE INSIDE OUT + TAD I AUTO10 /WITH THE POINTERS AND COUNTS ALREADY + DCA XTWODS /SET UP BY FILDIS OR TWODIS + TAD I AUTO10 /STICK NEXT TWO POINTS INTO LINE + DCA YTWODS + + TAD XTWODS + CIA /CALCULATE INCREMENT THE WRONG WAY + TAD XONEDS + DCA DIXTEM /AND STORE + TAD YTWODS + CIA + TAD YONEDS + DCA DIYTEM /SAME FOR Y + + TAD M4 /4 DOTS IN THE VECTOR" + DCA DISCNT /COULD HAVE CALLED THE OTHER + /VECTOR GENERATOR I SUPPOSE +EXPLOP, TAD XONEDS + TAD DIXTEM /ADD X AND Y INCREMENTS TO THE RUNNING + DCA XONEDS /TOTALS AND DISPLAY THE RUNNING + TAD YONEDS /TOTALS NORMAL SIZE + TAD DIYTEM + DCA YONEDS + + TAD XONEDS +/ RTR /COULD MAKE TWICE AS BIG BY NOP-ING +/ RAR /THE RAR'S BUT THE SCREEN IS SMALL ENOUGH + JMS I IVCLDX /AS IT IS + CLA + TAD YONEDS +/ RTR +/ RAR + JMS I IVCLDY +/ DISD +/ JMP .-1 +/ DIXY + + CLA + ISZ DISCNT /DONE 4 DOTS? + JMP EXPLOP /NO + + ISZ AUTO11 /DONE ALL VECTORS IN THE FILE? + SKP + JMP I EXPDIS /YES, EXIT + + TAD XTWODS /NO SWAP TO NEXT PAIR OF POINTS + DCA XONEDS + TAD YTWODS + DCA YONEDS + JMP EXPDIS+1 + + + + +/ +/ VEELIM IS THE SCALING ROUTINE FOR VELOCITY COMPONENTS. +/ THE COMPONENTS ARE SCALED TO REMAIN IN THE RANGE 140 +/ TO -140. THIS IS NECESSARY TO AVOID ASTRONOMICAL SPPED +/ BUILDUP ON THE SMALL SCREEN. UNFORTUNATELY THE X AND Y +/ COMPONENTS ARE SCALED SEPARATELY WHICH GIVES SLIGHT BUT +/ NOTICABLE DISTORTIONS IN DIAGONAL FLIGHT PATHS. IN THE +/ NORMAL HEAT OF THE BATTLE NO ONE WILL REALLY NOTICE. +/ + + +VEELIM, 0 /ENTER TO SCALE VELOCITY HELD IN + DCA VEEHLD /AC + TAD VEEHLD + SMA /BRANCH FOR POSITIVE OR NEGATIV + JMP VEEPOS + TAD VEEMAX + SMA CLA /GREATER THAN MAXIMUM POSITIVE? + JMP VEECLR /NO + TAD VEEMIN /I MEAN MAXIMUM NEGATIVE - YES SET + JMP I VEELIM /TO MAX NEGATIV + +VEEPOS, TAD VEEMIN /GREATER THAN MAX? + SPA CLA + JMP VEECLR /NO + TAD VEEMAX /YES SET TO MAX + JMP I VEELIM + +VEECLR, TAD VEEHLD /IT WAS IN RANGE ALL ALONG + JMP I VEELIM + +VEEHLD, 0 +VEEMIN, -140 +VEEMAX, 140 + +THEAJI, 0 /HERE TO ADJUST THE ANGLE TO A RANGE + SMA /0-550 OR 0-360 DEGREES. THIS IS + JMP .+3 /NECESSARY TO INSURE THAT PUSHDOWN OVERFLOW + TAD P550 /WILL NOT HAPPEN IN THE SINE AND COSINE + JMP .-3 /ROUTINES. THIS SIMPLY TAKES THE AC + TAD M550 /MODULO 360 AND EXITS + SMA + JMP .-2 + TAD P550 /FOLLOW IT THROUGH AND SEE IF IT DOESN'T + JMP I THEAJI + + + +/ +/ ONE OF THESE ROUTINE IS ENTERED WHEN A WINNER IS DECLARED. +/ THE ADDRESS OF THE VICTORY MESSAGE IS PLACED IN MESS AND +/ THE GAMOVR FLAG SET TO CAUSE A BRANCH TO JOBLOP WHEN THE +/ DISPLAY CYCLE IS COMPLETED. THE ROUTINE WILL THEN DISPLAY +/ THE APPROPRIATE MESSAGE OVER THE REMAINING SHIPS IF +/ ANY UNTIL THE KEYBOARD IS MOLESTED OR THE CLOCK RUNS OUT +/ AND THE NEXT DISPLAY UPDATE CYCLE IS SET. AT ANY RATE THE +/ PROGRAM WILL REACH HERE ONLY WHEN SOMEONE HAS BITTEN THE +/ INTERGALACTIC DUST. +/ + + +ONEWIN, 0 /THIS IS CALLED WHEN TWOFIN IS SET + TAD MES1 /AND ONE FIN IS NOT. SET ONE TO VICTOR + DCA MESS /AND SET GAMOVR FLAG + IAC + DCA GAMOVR + JMP I ONEWIN /THEN RETURN TO UPDATE CYCLE + +TWOWIN, 0 /THIS IS CALLED WHEN ONEFIN IS SET + TAD MES2 /AND TWO FIN IS NOT + DCA MESS /SET ALSO GAMOVR + IAC + DCA GAMOVR + JMP I TWOWIN + +NOWIN, TAD MES4 /GET HERE WHEN BOTH ONEFIN AND TWOFIN + DCA MESS /ARE SET . + IAC + DCA GAMOVR /NOBODY EVER REALLY WINDS + /UP THE WINNER IN THESE THINGS +JOBLOP, +/ DSB 1 /THIS IS ENTERED FROM FINISH WHEN + TAD MES0 /GAMOVR IS SET AND SERVES TO DISPLAY + JMS I MESOUT /THE VICTORY MESSAGE ON THE SCREEN + TAD MESS /USING THE CHARACTER GENERATOR SOMEWHAT + JMS I MESOUT /FURTHER ON UNTIL THE GAME IS RESTARTED + TAD MES5 /OR UNTIL THE INTERRUPT COUNT OVERFLOWS + JMS I MESOUT /AND THE UPDATE CYCLE IS RESTARTED + TAD MES3 + JMS I MESOUT +FINITO, JMP JOBLOP + +MES0, MESS0 +MES1, MESS1 +MES2, MESS2 +MES3, MESS3 +MES4, MESS4 +MES5, MESS5 +MESS, 0 + + + +/ +/ THE FOLLOWING ARE THE SINE AND COSINE ROUTINES CUSTOMIZED +/ FOR THIS PROGRAM FROM ANOTHER I WORKED ON. CALL EITHER +/ SINE OR COSINE WITH ANGLE IN DEGREES IN AC. THE ARGUEMENT +/ IS REDUCED THROUGH RECURSION UNTIL BETWEEN 0-89 DEGREES +/ AND THEN A TABLE LOOKUP DONE TO OBTAIN THE VALUE. IT TAKES +/ UP A FAIR AMOUNT OF SPACE BUT IT WORKS JUST FASTER +/ THAN SHEEP. THE COSINE CALL JUST TRANSFORMS THE ARGUEMENT +/ THROUGH SOME TRIGONOMETRIC GARBAGE AND CALLS THE SINE +/ ROUTINE. NOTE THAT CALLING EITHER ROUTINE WITH TOO +/ LARGE AN ARGUEMENT WILL CAUSE PUSHDOWN OVERFLOW AND THEN +/ ALL HELL WILL BREAK LOOSE. THE ORIGINAL ROUTINE FROM WHICH +/ THIS WAS STOLEN HAD FULL WORD PRECISION. +/ + + *6400 + +SINEIN, 0 /I REALLY CANT BRING MYSELF TO COMMENT + DCA SINARG /THIS. IT'S VERY STRAIGHFORWARD + TAD SINEIN + DCA I SINPSH + ISZ SINPSH + TAD SINARG + SZA + JMP SINNG2 + +SINPOP, CLA CLL CMA + TAD SINPSH + DCA SINPSH + TAD I SINPSH + DCA SINEIN + TAD SINARG + JMP I SINEIN + +SINNG2, SMA + JMP SINPOS + CIA + JMS SINEIN + +SINNEG, CIA + DCA SINARG + JMP SINPOP + +SINPOS, TAD M264 + SPA + JMP .+2 + JMP SINNEG-1 + TAD P132 + SPA + JMP SINELK + SZA CLA + JMP .+3 + TAD P37 + JMP SINNEG+1 + + TAD SINARG + TAD M264 + JMP SINNEG-1 + +SINELK, TAD P132 + TAD SINTAB + DCA SINEIN + TAD I SINEIN + DCA SINARG + JMP SINPOP + + + + +SINARG, 0 +SINPSH, SINLST +SINLST, 0 + 0 + 0 + 0 + 0 + 0 + +SINTAB, SINES-1 + +COSINI, 0 + CIA + TAD P132 + JMS SINEIN + JMP I COSINI + + + + +SINES, 00 /1 + 01 /2 + 01 /3 + 02 /4 + 02 /5 + 03 /6 + 03 /7 + 04 /8 + 05 /9 + 05 /10 + 06 /11 + 06 /12 + 07 /13 + 07 /14 + 10 /15 + 10 /16 + 11 /17 + 11 /18 + 12 /19 + 12 /20 + 13 /21 + 13 /22 + 14 /23 + 15 /24 + 15 /25 + 16 /26 + 16 /27 + 17 /28 + 17 /29 + 20 /30 + 20 /31 + 20 /32 + 21 /33 + 21 /34 + 22 /35 + 22 /36 + 23 /37 + 23 /38 + 24 /39 + 24 /40 + 25 /41 + 25 /42 + 25 /43 + 26 /44 + 26 /45 + 27 /46 + 27 /47 + 27 /48 + 30 /49 + 30 /50 + 30 /51 + 31 /52 + 31 /53 + 31 /54 + 32 /55 + 32 /56 + 32 /57 + 33 /58 + 33 /59 + 33 /60 + 33 /61 + 34 /62 + 34 /63 + 34 /64 + 35 /65 + 35 /66 + 35 /67 + 35 /68 + 35 /69 + 36 /70 + 36 /71 + 36 /72 + 36 /73 + 36 /74 + 36 /75 + 37 /76 + 37 /77 + 37 /78 + 37 /79 + 37 /80 + 37 /81 + 37 /82 + 37 /83 + 37 /84 + 37 /85 + 37 /86 + 37 /87 + 37 /88 + 37 /89 + + + + +MULTI, 0 /THIS IS STANDARD SINGLE PRECISION + CLL /MULTIPLY ROUTINE WHICH WAS ONCE + SPA /USED. I'VE LEFT IT IN SINCE + CMA CML IAC /THERE IS LOTS OF CORE LEFT OVER AND + DCA MULMP1 /MAYBLE SOMEDAY I'LL NEED IT TO PUT + DCA MULMP5 /IN A SUN OR SOMETHING. THIS IS THE + TAD I MULTI /STANDARD DEC SUBROUTINE WITH DIFFERENT + SNA /LABELS + JMP MULPSN+2 + SPA + CMA CML IAC + DCA MULMP2 + TAD MULTHR + DCA MULMP3 + +MULMP4, TAD MULMP1 + RAR + DCA MULMP1 + TAD MULMP5 + SZL + TAD MULMP2 + CLL RAR + DCA MULMP5 + ISZ MULMP3 + JMP MULMP4 + TAD MULMP1 + RAR +MULPSN, SZL + JMP MULCMP + DCA MULMP1 + TAD MULMP5 +MULMPZ, ISZ MULTI + JMP I MULTI + +MULCMP, CMA CLL IAC + DCA MULMP1 + TAD MULMP5 + CMA + SZL + IAC + JMP MULMPZ + +MULTHR, 7764 +MULMP1, 0 +MULMP5, 0 +MULMP2, 0 +MULMP3, 0 + + + +/ +/ SHIFTR DIVIDES THE AC BY TWO WHETHER POSITIVE OR NEGATIVE +/ AND IS CALLED FROM VARIOUS PLACES. NOT ENTIRELY MYSTERIOUS +/ + + +SHIFTR, 0 + CLL + SPA + CML IAC + RAR + JMP I SHIFTR + + +/ +/ POSCAL IS CALLED TO CALCULATE THE COORDINATE INCREMENTS +/ NECESSARY TO PRODUCE THE SHIP FIGURES. RATHER THAN DOING +/ A LOT OF EXPENSIVE MATH THIS DOES A QUICK PRODUCTION +/ OF 1, 2, AND 3 TIMES THE SIN AND COSINE VALUES FOUND +/ IN CALSIN AND CALCOS LEAVING THEM IN THE TABLE FOR +/ ONESET AND TWOSET. IF THE SCOPE WERE ANY BETTER +/ THIS PROBABLY WOULDN'T BE NEAR GOOD ENOUGH BUT.... +/ + +POSCAL, 0 + TAD CALSIN + + DCA T10SIN + TAD T10SIN + CLL RAL + DCA T20SIN + TAD T10SIN + TAD T20SIN + DCA T30SIN + + TAD CALCOS + + DCA T10COS + TAD T10COS + CLL RAL + DCA T20COS + TAD T10COS + TAD T20COS + DCA T30COS + JMP I POSCAL + +/**************************************************************** +/ VC8-E ROUTINES + + +VDIV, 0 + SMA / SKIP IF MINUS + JMP VPLUS +VMINUS, CMA IAC / COMPLEMENT + RTR / DIVIDE BY FOUR + AND P1777 / DELETE UPPER TWO BITS + CMA IAC + JMP I VDIV / RETURN + +VPLUS, RTR + AND P1777 + JMP I VDIV + +/***** + +VCLDX, 0 / INTENSIFY LAST POINT AND LOAD NEW X VALUE + JMS VDIV / DIVIDE BY FOUR + DISD / DISPLAY READY? + JMP .-1 / WAIT. + DIXY / INTENSIFY + DILX / LOAD NEW X VALUE + JMP I VCLDX / RETURN + +VCLDY, 0 + JMS VDIV / DIVIDE BY FOUR + DILY / LOAD NEW Y VALUE + JMP I VCLDY + +P1777, 1777 + + +/**************************************************************** + + + *7000 + +/GENERAL PURPOSE SYMBOL GENERATOR +/ +CHARS, 0 /ENTRY TO PLOT CHARACTER STRING + DCA ADDR /STORE STRING ADDRESS + TAD I ADDR /FETCH DOUBLE CHARACTER + RTR /SHIFT + RTR / FOR FIRST + RTR / CHARACTER + JMS CHAR /PLOT CHARACTER + SKP /NORMAL RETURN -- SKIP + JMP I CHARS /TERMINATION RETURN -- EXIT + TAD I ADDR /RECALL DOUBLE CHARACTER + ISZ ADDR /ADVANCE STRING ADDRESS + JMS CHAR /PLOT CHARACTER + JMP CHARS+2 /NORMAL RETURN -- REPEAT + JMP I CHARS /TERMINATION RETURN -- EXIT +/ +CHAR, 0 /ENTRY TO PLOT SINGLE CHARACTER + AND K77 /MASK OUT UPPER BITS + CLL RAL /MULTIPLY CODE BY TWO + TAD TABLE /ADD TABLE BASE ADDRESS + DCA POINT /CONSTRUCT POINTER TO 24-BIT CODE + CMA /INITIALIZE COUNTER FOR + DCA COUNT2 / TWO PLOT WORDS + TAD I POINT /FETCH FIRST PLOT WORD + ISZ POINT /INCREMENT POINTER FOR NEXT ONE + SNA /SKIP IF NOT SPECIAL CHARACTER + JMP SPCHAR /ELSE GO PROCESS IT + DCA CURPLT /SAVE CURRENT PLOT BITS +XPLOT, TAD KM6 /INITIALIZE 6-BIT + DCA COUNT6 / COUNTER + TAD YVALUE /RESET Y TEMPORARY + DCA YTEMP / VALUE FOR CHARACTER + TAD XVALUE /OUTPUT CURRENT + DILX /X-VALUE TO CRT + TAD XINCR /INCREMENT + DCA XVALUE / ABSCISSA +YPLOT, TAD CURPLT /RECALL CURRENT PLOT BITS + CLL RAL /GET NEXT BIT + DCA CURPLT /SAVE REMAINING PLOT BITS + SNL /SKIP IF POINT TO PLOT + JMP CNTINU /ELSE JUMP AHEAD + TAD YTEMP /OUTPUT CURRENT + DILY /Y-VALUE TO CRT + DISD / READY TO DISPLAY THE POINT? + JMP .-1 / NO, WE'LL WAIT. + DIXY / SHOOT THE BEAM! + + CLA CLL /CLEAR AC + TAD CURPLT /RECALL CURRENT PLOT BITS + SNA CLA /SKIP IF POINTS REMAINING + JMP WRDEND /ELSE WORD IS FINISHED +CNTINU, TAD YTEMP /INCREMENT TEMPORARY + TAD YINCR / Y-VALUE FOR NEXT + DCA YTEMP / CHARACTER STEP + ISZ COUNT6 /SKIP IF 6 BITS PLOTTED + JMP YPLOT /ELSE PLOT NEXT ONE + JMP XPLOT /GO UPDATE X-VALUE +WRDEND, ISZ COUNT2 /SKIP IF ANOTHER BIT WORD + JMP EXIT /ELSE EXIT + TAD I POINT /FETCH SECOND BIT WORD + SZA /SKIP IF NO PLOT POINTS + JMP XPLOT-1 /ELSE GO PLOT THEM +EXIT, TAD XVALUE /INCREMENT ABSCISSA + TAD XINCR / FOR SPACE BETWEEN + DCA XVALUE / SYMBOLS + JMP I CHAR /EXIT FROM CHAR +/ +SPCHAR, TAD I POINT /FETCH TRANSFER VECTOR + DCA POINT /STORE AS INDIRECT ADDRESS + + JMP I POINT /GO TO APPROPRIATE ROUTINE +SPACE, TAD XINCR /FETCH BASIC ABSCISSA INCREMENT + CLL RTL /MULTIPLY BY FOUR AND + JMP EXIT / GO CREATE SPACE +CRLF, TAD INITX /"CARRIAGE RETURN" RESETS X + DCA XVALUE / TO ITS ORIGINAL VALUE +LF, TAD YINCR /"LINE FEED" + CLL RTL / DECREMENTS THE + CLL CIA RAL / Y-VALUE BY + TAD YVALUE / EIGHT SCALE + DCA YVALUE / STEPS + JMP I CHAR /EXIT FROM CHAR +RESET, TAD INITX /"RESET" RESETS + DCA XVALUE / X AND Y TO + TAD INITY / THEIR ORIGINAL + JMP RESET-2 / VALUES +TERM, ISZ CHAR /TERMINATE CODE CAUSES + JMP I CHAR / EXIT TO P+2 +/ +INITX, 0 /INITIAL X-VALUE +INITY, 327 /INITIAL Y-VALUE +XVALUE, 0 /CURRENT X-VALUE +YVALUE, 0 /CURRENT Y-VALUE +XINCR, 6 /BASIC X INCREMENT VALUE +YINCR, 10 /BASIC Y INCREMENT VALUE +YTEMP, 0 /TEMPORARY Y-VALUE +CURPLT, 0 /CURRENT PLOT BITS +ADDR, 0 /CURRENT STRING ADDRESS +COUNT6, 0 /6-BIT COUNTER +COUNT2, 0 /2-WORD COUNTER +KM6, -6 /CONSTANT FOR COUNT6 +K77, 77 /CHARACTER CODE MASK +POINT, 0 /TABLE POINTER +/ + + +/ +TABLE, .+1 /TABLE BASE ADDRESS + 0 /SPECIAL CHARACTER (00) + TERM /TERMINATION CODE + 7611 / A + 1176 + 7745 / B + 4532 + 3641 / C + 4122 + 7741 / D + 4136 + 7745 / E + 4541 + 7705 / F + 501 + 7741 / G + 5173 + 7710 / H + 1077 + 4177 / I + 4100 + 2040 / J + 4037 + 7714 / K + 2241 + 7740 / L + 4040 + 7702 / M + 277 + 7706 / N + 3077 + 7741 / O + 4177 + 7705 / P + 502 + 3641 / Q + 6176 + 7715 / R + 2542 + 2245 / S + 5122 + 177 / T + 100 + 3740 / U + 4037 + 1720 / V + 4037 + 7730 / W + 3077 + 4136 / X + 3641 + 374 / Y + 7403 + 6151 / Z + 4543 + 7741 / [ + 0 + 204 / \ + 1020 + 4177 / ] + 0 + 436 / ^ + 400 + 0 /SPECIAL CHARACTER (37) + RESET /RESET + 0 /SPECIAL CHARACTER (40) + SPACE /SPACE + 5600 / ! + 0 + 303 / " + 0 + 1477 / # + 7714 + 2277 / MARKER + 2200 + 2313 / % + 6462 + 7777 / BLOCK + 7777 + 300 / ' + 0 + 3641 / ( + 0 + 4136 / ) + 0 + 4040 / UNDERSCORE (52) + 4040 + 1034 / + + 1000 + 0 /SPECIAL CHARACTER (54) + LF /LINE FEED + 1010 / - + 1000 + 4000 / . + 0 + 2010 / / + 402 + 3641 / 0 + 4136 + 4442 / 1 + 7740 + 4261 / 2 + 5146 + 2145 / 3 + 5321 + 1710 / 4 + 1077 + 4745 / 5 + 4531 + 7750 / 6 + 5070 + 6111 / 7 + 503 + 2255 / 8 + 5522 + 705 / 9 + 577 + 2400 / : + 0 + 0 /SPECIAL CHARACTER (73) + CRLF /CARRIAGE RETURN; LINE FEED + 1024 / > + 4200 + 1212 / = + 1200 + 4224 / < + 1000 + 255 / ? + 300 + + + +/ +/ HERE FOLLOW THE PACKED ASCII TEXTS FOR THE VARIOUS +/ VICTORY MESSAGES. PERSONS ADVENTEROUS TO FIND THIS MIGH CARE +/ TO TOGGLE IN SOME CUTE LITTLE MESSAGES OF THEIR OWN. +/ + +MESS0, 3773 +MESS5, 7340 + 4040 + 4040 + 4000 + +MESS1, 1716 + 0500 + +MESS2, 2427 + 1700 + +MESS3, 2711 + 1623 + 4100 + +MESS4, 1617 + 0217 + 0431 + 0000 + + + + *7400 + +DISBUF, 0 + +/ THE DISPLAY BUFFERS BEGIN HERE AND EXTEND UP SOMEWHERE TO +/ AROUND 7575 OR SO. +/ +/ +/ +/ +/ + + + + + $ + +//////////////////////////// +/ +/ THIS IS THE END +/ +/////////////////////////// + + + + + + diff --git a/sw/SPACE/space.pal.bak b/sw/SPACE/space.pal.bak new file mode 100644 index 0000000..120029c --- /dev/null +++ b/sw/SPACE/space.pal.bak @@ -0,0 +1,2355 @@ +/ SPACE WAR +/ +/ INTERPLANETARY DEATH AND DESTRUCTION ON YOUR +/ LAB-8 +/ +/ EVAN SUITS +/ +/ THIS VERSION WORKS OFF EITHER THE BLUE RIBBON CONNECTOR OR THE +/ SR. WHEN THE PROGRAM IS STARTED (AT 0200) OR RESTARTED THE +/ SR WILL BE TESTED AND IF =0000 WILL BE USED FOR THE COMMAND +/ INPUT. OTHERWISE, THE BLUE RIBBON CONNECTOR (AX08 * C0-C7 * +/ XR OPTION ONLY) CONTINGENCY INPUTS WILL BE USED. +/ +/ WHEN THE PROGRAM IS STARTED THE TWO SHIPS SHOULD +/ APPEAR ON THE SCREEN WITH SHIP 'ONE' ON THE LEFT, SHIP +/ 'TWO' ON THE RIGHT. +/ +/ THE COMMAND WORD BIT ASSIGNMENTS ARE: +/ +/ SR BIT: C: FUNCTION: +/ +/ 0 0 SHIP ONE ROTATES LEFT +/ +/ 1 1 SHIP ONE ROTATES RIGHT +/ +/ 2 2 SHIP ONE ACCELERATES +/ +/ 3 3 SHIP ONE FIRES +/ +/ +/ +/ 8 4 SHIP TWO ROTATES LEFT +/ +/ 9 5 SHIP TWO ROTATES RIGHT +/ +/ 10 6 SHIP TWO ACCELERATES +/ +/ 11 7 SHIP TWO FIRES +/ +/ +/ +/ NOTE THAT TURNING RIGHT AND LEFT SIMULTANEOUSLY THROWS +/ THE SHIP INTO HYPERSPACE. IN THE CURRENT VERSION THE ODDS +/ ARE IN FAVOR OF YOUR MAKING IT BACK SAFELY. THE GAME IS OVER +/ WHEN ONE OR BOTH OF THE SHIPS HAVE BEEN DESTROYED AND THE +/ WINNER (IF ANY) IS IN NORMAL SPACE. WHEN THE WINNER +/ HAS BEEN ANNOUNCED, HIT ANY TTY KEY TO RESTART. +/ + + +/**************************************************************** + +/*************************** +/ CLOCK OPERATIONS + +CLZE=6130 / CLEAR CLOCK ENABLE REGISTER PER AC +CLSK=6131 / SKIP ON CLOCK FLAG +CLOE=6132 / SET CLOCK ENABLE REGISTER PER AC +CLAB=6133 / AC REGISTER TO CLOCK COUNTER REGISTER +CLEN=6134 / CLOCK ENABLE REGISTER TO AC +CLSA=6135 / STATUS TO AC +CLBA=6136 / CLOCK BUFFER REGISTER TO AC +CLCA=6137 / CLOCK COUNTER REGISTER TO AC + +/ BITS IN CLOCK ENABLE REGISTER +CREXT=0100 / EXTERNAL SOURCE +CR2=0200 / 10**2 per second +CR3=0300 / 10**3 per second +CR4=0400 / 10**4 per second +CR5=0500 / 10**5 per second +CR6=0600 / 10**6 per second + +COVSTAT=4000 +CMFREE=0000 / 4096 FIXED FREE RUN +CMPROG=1000 / PROGRAMMED DELAY + +CADC=0040 / START ADC ON OVERFLOW +CINH=0020 / INHIBIT CLOCK +CION=0010 / INTERRUPT ENABLE + +CEV3=0004 / EVENT 3 ENABLED +CEV2=0002 / EVENT 2 ENABLED +CEV1=00001 / EVENT 1 ENABLED + +/ VC8-E OPCODES +DIXY=6055 / INTENSIFY +DILX=6053 / LOAD X +DILY=6054 / LOAD Y +DILE=6056 / LOAD ENABLES FROM A +DISD=6052 / TEST FOR READY + +/**************************************************************** +/ SYMBOL DEFINITIONS FOR PAL8-PAL10 + +XRIN=NOP / DIGITAL INPUT? +XRCL=NOP + +/DSB=XXXX / SET BRIGHTNESS - MUST BE COMMENTED OUT!!! + +DXC=JMS I IVCLDX / X VALUE CONTROL? +DYC=JMS I IVCLDY / Y VALUE CONTROL? + +DXL=0000 / X VALUE LOAD FLAG? +DYL=0000 / Y VALUE LOAD FLAG? +DIS=0000 / ANOTHER STRANGE FLAG + +/CRF=NOP / WHICH FLAG??? +/CCF=NOP / ?? + + +/**************************************************************** +/ +/ THIS PROGRAM RELIES ON THE PROGRAM INTERUPT FACILITY FOR +/ REAL WORLD TIMING PURPOSES. +/ + + *0 + + 0 /EFFECTIVE JMS 0 ON PROGRAM INTERUPT + JMP I 2 /EXIT IMMEDIATLY TO SERVICE ROUTINE + INTSER + +EMPTY, 0 /THESE LOCATIONS ARE RESERVED FOR +ODT1, 0 /DEBUGGERS, ETC. +ODT2, 0 +ODT3, 0 + +/ +/ ALL THE AUTO INDEX REGISTERS ARE NAMED BUT NOT ALL OF +/ THEM ARE USED. THE STATUS OF ANY GIVEN REGISTER CANNOT +/ BE DETERMINED AT ANY TIME EXCEPT BY CAREFUL INSPECTION OF +/ THE CODE. +/ + + *10 + +AUTO10, 0 +AUTO11, 0 +AUTO12, 0 +AUTO13, 0 +AUTO14, 0 +AUTO15, 0 +AUTO16, 0 +AUTO17, 0 + +/ +/ THE FOLLOWING ARE THE DATA FILES FOR THE TWO SPACE SHIPS +/ AS WELL AS CERTAIN OTHER PARAMETERS FOR CALCULATING POSITIONS +/ AND SO ON. THE ORDER OF THE LOCATIONS MUST BE PRESERVED +/ ALTHOUGH THE SIZE OF THE TABLES MAY BE VARIED +/ + + *20 + +ONEOUT, 0 /IF NON-ZERO CONTAINS REAMINING TIME OF EXPLOSION +ONECNT, 0 /NUMBER OF POINTS IN FIGURE TO BE DISPLAYED +ONEFLG, 0 /IN OR OUT OF NORMAL SPACE +ONETHE, 0 /ANGLE OF ORIENTATION ON SCREEN +ONEVEX, 0 /X COMPONENT OF VELOCITY +ONEVEY, 0 /Y COMPONENT OF VELOCITY +ONEPEX, 0 /X POSITION (12 BITS) +ONEPEY, 0 /Y POSITION (12 BITS) +ONESIN, 0 /SINE OF ANGLE +ONECOS, 0 /COSINE OF ANGLE +ONEFIN, 0 /SET WHEN EXPLOSION DIES OUT + +TWOOUT, 0 /SAME CONTENT AND ORDER +TWOCNT, 0 /AS ABOVE +TWOFLG, 0 +TWOTHE, 0 +TWOVEX, 0 +TWOVEY, 0 +TWOPEX, 0 +TWOPEY, 0 +TWOSIN, 0 +TWOCOS, 0 +TWOFIN, 0 + + +/ +/ THESE LOCATIONS ARE USED BY THE "VECTOR GENERATOR" IN +/ DISPLAYING THE FIGURES. A FOUR DOT VECTOR WILL BE DRAWN +/ FROM XONE,YONE TO XTWO,YTWO WITH STEPS OF SIZE DIXTEM,DIYTEM +/ + +XONEDS, 0 +YONEDS, 0 +XTWODS, 0 +YTWODS, 0 +DIXTEM, 0 +DIYTEM, 0 +DISCNT, 0 + + +/ +/ THE NEXT LOCATIONS ARE USED BY CALPOS TO DO A FAST +/ MULTIPLY TO HELP CALCULATE THE DISPLAY FILES. +/ +T10SIN, 0 +T20SIN, 0 +T30SIN, 0 +T10COS, 0 +T20COS, 0 +T30COS, 0 + +CALSIN, 0 +CALCOS, 0 + +/ +/ NOW COME THE VARIOUS ODDS AND ENDS ONE USUALLY FINDS ON +/ PAGE ZERO +/ + +SINE, SINEIN +COSINE, COSINI +MULT, MULTI +RSHIFT, SHIFTR +VECTOR, DISPLY +CALPOS, POSCAL +INTWRD, 0 +INTCNT, 0 +/CLOCK, 0 +HYPER, HYPSET +MESOUT, CHARS +THEADJ, THEAJI +VEESCL, VEELIM +ISHFT, DISHFT +RESET1, RESE1 +GAMOVR, 0 +ACCFLG, 0 +ACCPER, -30 +MEXP, -400 + +PROX, 0 +PROY, 0 +PROLIF, -360 +BUFTMP, 0 +ONEFIL, DISBUF +TWOFIL, DISBUF+40 + +P5, 5 +P10, 10 +P17, 17 +P20, 20 +P37, 37 +P40, 40 +P100, 100 +P132, 132 +P200, 200 +P400, 400 +P550, 550 +P3777, 3777 + +M4, -4 +M6, -6 +M10, -10 +M11, -11 +M264, -264 +M200, -200 +M400, -400 +M550, -550 + +IVCLDX, VCLDX +IVCLDY, VCLDY + +/ +/ THE PROGRAM MAY BE STARTED OR RESTARTED AT ANYTIME AT 0200. +/ THE DATA FILE ON PAGE ZERO IS CLEARED, ALL FLAGS INITIALIZED, +/ AND THE SR EXAMINED. IF THE SR=0 THE DISPLAY UPDATE ROUTINES +/ ARE SET TO PICK UP THE STATUS WORD FROM THE SR. IF THE SR +/ DOES NOT EQUAL ZERO, THE STATUS WORD IS READ FROM THE EIGHT +/ CONTINGENCY INPUTS ON THE BLUE RIBBON CONNECTOR OF THE AX08 +/ (XR OPTION ONLY). JUMP IS THEN TO THE DISPLAY +/ FILE UPDATE TO START OFF THE GAME. +/ + + *200 + +START, CLA CLL /START OR RESTART HERE ANY OLD TIME + DIXY /TO GET THE VC8-E STARTED ONCE + LAS /SR +/TMP SNA CLA + TAD SWRD /USE THE SR + TAD XROPT /USE THE BLUE RIBBON CONNECTOR + DCA COLDST /AND LEAVE IN THE TRAP LOCATION + +RESTRT, CLA CMA + XRCL + CLA CLL + + TAD P17 /FIRST CLEAR THE POSITION AND DATA + DCA AUTO10 /TABLES OF THE TWO SHIPS + TAD TABLEN + DCA AUTO11 + DCA I AUTO10 + ISZ AUTO11 + JMP .-2 + + TAD STRT1 /SET THE STARTING POSITIONS OF THE + DCA ONEPEX /TWO SHIPS + TAD STRT2 + DCA TWOPEX + TAD P37 /SET TRIG FUNCTIONS JUST IN CASE + DCA ONECOS + TAD P37 + DCA TWOCOS /ZERO DEGREES IS POINTING STRAIGHT UP + TAD ACCPER /SET COUNT FOR VELOCITY INCREASE + DCA ACCFLG + DCA ONEFIN /CLEAR ALL GAME END FLAGS + DCA TWOFIN + DCA GAMOVR + JMS I BUFSET /RESET ALL PROJECTILE DISPLAY BUFFERS + + + TCF /CLEAR OTHER REMAINING LIKELY FLAGS + PCF + RRB + + CLA CMA / ALL ONES + CLZE / CLEAR CLOCK CONFIG REGISTER + CLA + TAD CDELY / LOAD NEG DELAY + CLAB / LOAD TO CLOCK BUFFER + CLA + TAD CCNF / LOAD CLOCK CONFIG + CLOE / SET CONFIG BITS + + CLA CLL + JMP COLDST /AND GO TO IT + +CCNF, CR4+CMPROG+CION+COVSTAT / CLOCK CONFIGURATION +CDELY, -310 / COUNTER PRESET (200) + +/ +/ UPDATE IS REACHED WHENEVER THE PROGRAM IS STARTED OR THE +/ CLOCK COUNT OVERFLOWS INDICATING TIME TO RECALCULATE THE +/ THE DISPLAY FILES AND REFRESH THE DISPLAY. THE INTERUPT +/ COUNT IS RESTORED, THE STATUS WORD IS PICKED UP FROM EITHER +/ THE SR OR BRC, AND THE RECALCULATION PROCESS BEGUN. +/ + +UPDATE, CLA CLL /HERE ON CLOCK COUNT OVERFLOW. + /START NEXT SWEEP +COLDST, 0 /TRAP TO READ SR OR BRC + LAS /HERE FOR SR + DCA INTWRD /STORE TEMPORARILY + TAD INTWRD /MASK OUT LEFTMOST 4 BITS + RTR /FOR NUMBER ONE + RTR + AND LFTHAF + DCA INTTEM /AND STORE + TAD INTWRD /MASK OUT RIGHTMOST BITS FOR NUMBER TWO + AND RYTHAF + TAD INTTEM /ADD TOGETHER + JMP .+3 /AND CONTINUE + +CODST, XRIN /HERE FOR BRC - PICK UP AND CLEAR + XRCL + DCA INTWRD /CONTINUE + TAD M550 /RESTORE INTERUPT COUNT BEFORE NEXT + DCA INTCNT /UPDATE + ION /GET READY FOR THE NEXT CYCLE + TAD ACCFLG /ALLOW VELOCITY INCREASE THIS TIME? + IAC /ONLY WHEN ACCFLG=0 + SMA SZA + TAD ACCPER /IF ZERO, RESET COUNT + DCA ACCFLG + + JMP I .+1 /NOW GET DOWN TO WORK. + ONEUP + +BUFSET, SETBUF +TABLEN, AUTO17-CALCOS +INTTEM, 0 +LFTHAF, 0360 +RYTHAF, 0017 +STRT1, 1000 +STRT2, -1000 +SWRD, 2000-CODST +XROPT, JMP CODST + + +/ +/ THIS IS THE INTERUPT SERVICE ROUTINE. MOST OF THE +/ INTERUPTS WILL BE FROM THE CRYSTAL CLOCK WHICH WILL BE +/ COUNTED AND UNLESS THE COUNT OVERFLOWS THE INTERUPT IS +/ DISMISSED IMMEDIATLY. IF THE COUNT OVER FLOWS, JMP IS TO +/ UPDATE WITH IOF. +/ +/ SPECIAL CASE IS KEYBOARD INTERUPT WHEN THE GAMOVR FLAG IS +/ SET IN WHICH CASE THE GAME IS RESTARTED. +/ +/ UNEXPECTED INTERUPTS ARE COUNTED AND AFTER ENOUGH OF THEM +/ HAPPEN THE PROGRAM HALTS. IF THIS HAPPENS RELOAD OR FIND THE +/ STRANGE FLAG +/ + +INTSER, DCA INTACC /HERE RIGHT AFTER INTERUPT - STORE + RAR /AC AND LINK + DCA INTLNK /FOR POSSIBLE CONTINUATION + CLSK /WAS IT THE CRYSTAL CLOCK? + JMP INTBUS /NO TRY SOMETHING ELSE + CLA IAC RTR /LOAD 4000 + CLSA /GET CLOCKSTATUS AND RESET FLAG + CLA CLL + JMP UPDATE /YES, GO TO IT + +INTBUS, KSF /HERE ON NON-CLOCK INTERUPT + JMP .+5 /NOT THE KEYBOARD + KCC /CLEAR KEYBOARD FLAG + TAD GAMOVR /IS THE GAMEOVER + SZA CLA + JMP RESTRT /YES, RESTART +/ TCF /NO, HELL WITH IT + ISZ INTGLH /COUNT ONE BADDIE + SKP + HLT /HALT IF TOO MANY BADDIES + +INTRET, CLA CLL /HERE TO DISMISS THE INTERUPT + TAD INTLNK + RAL + TAD INTACC + ION + JMP I 0 + +INTACC, 0 +INTLNK, 0 +INTGLH, 0 + + +/ +/ NOW BEGINS THE GREAT UPDATE PROCEEDURE, FIRST FOR SHIP +/ NUMBER ONE (THE DELTA SHAPED SHIP WHICH APPEARS ON +/ THE LEFT AT THE START OF THE GAME). IF ALIVE THE STATUS +/ WORD (INTWRD) IS TESTED FOR REQUESTS FOR LEFT TURN, +/ RIGHT TURN, THRUST ON, AND LAUNCH PROJECTILE. THESE ACTIONS +/ MAY OR MAY NOT BE ACTED UPON DEPENDING ON COUNTS AND FLAGS. +/ WHEN THIS IS COMPLETE THE SAME OPERATION IS PERFORMED FOR +/ NUMBER TWO. +/ + + *400 + +ONEUP, TAD ONEFLG /FIRST SEE IF IT'S IN NORMAL SPACE + SNA + JMP ONEOK /YES IT IS + IAC /NO, BUT IS IT JUST COMING OUT? + SNA + TAD ONEFIN /YES, THROW BACK IN IF ALREADY DESTROYED + DCA ONEFLG /OTHERWISE JUST COUNT ONE + JMP I ITWOUP /AND GO TO FIX UP NUMBER TWO + +ONEOK, TAD ONEOUT /IN NORMAL SPACE - IS IT EXPLODING? + SZA CLA + JMP ONEFIG /IF YES, ALLOW NO CONTROLS + TAD TWOFIN /HAS THE ENEMY BEEN VANQUISHED? + SZA CLA + JMS I ONEWN /YES, SIGNAL VICTORY + TAD INTWRD /NOW BEGIN TEST OF REQUEST + AND OP300 /LEFT AND RIGHT TURN TOGETHER MEAN HYPERSPACE! + TAD OM300 /TEST BITS 4 AND 5 + SZA CLA + JMP ONELEF /NOPE, CONTINUE + CMA /YES, CALL HYPER WITH AC=-1 FOR NUMBER ONE + JMP I HYPER +ONELEF, TAD INTWRD /REQUEST FOR LEFT TURN? + AND P200 /TEST BIT 4 + SNA CLA + JMP ONERYT /NO + CLA CLL CMA /YES DECREMENT ANGLE + JMP ONEFIG + +ONERYT, TAD INTWRD /HOW ABOUT RIGHT TURN + AND P100 /TEST BIT 5 + SZA CLA + IAC /YES, INCREMENT ANGLE + +ONEFIG, TAD ONETHE /PICK UP AND ADJUST ANGLE (MAYBE) + JMS I THEADJ /BRING BACK WITHIN LIMITS OF TRIG FUNCTIONS + DCA ONETHE /AND STORE + TAD ONETHE /FIND THEM TRIG FUNCTIONS + JMS I SINE /AND STORE ONCE AND FOR ALL + DCA ONESIN /IN THE APPROPRIATE PLACES + TAD ONETHE + JMS I COSINE + DCA ONECOS + TAD ONEOUT /DO NOT ALLOW THRUST IF EXPLODING + SZA CLA + JMP ONEVEL + + + +ONEMOV, TAD ACCFLG /ALLOW ANY VELOCITY INCREASE THIS CYCLE? + SZA CLA + JMP ONEVEL /NOPE + TAD INTWRD /YES, ANY REQUESTED? + AND P40 /TEST BIT 6 + SNA CLA + JMP ONEVEL /NONE REQUESTED + TAD ONECOS /YES, ADD IN VELOCITY INCREMENT DEPENDING + TAD ONEVEY /ON ORIENTATION + JMS I VEESCL /BUT DO NOT ALLOW TO EXCEED MAXIMUM + DCA ONEVEY /AND STORE + TAD ONESIN /DO THE SAME FOR THE OTHER (X) COMPONENT + TAD ONEVEX + JMS I VEESCL + DCA ONEVEX + + + +ONEVEL, TAD ONEVEX /NOW UPDATE THE POSITION WITH THE + JMS I ISHFT /VELOCITY COMPONENTS DIVIDED BY 4 + JMS I ISHFT /THIS MAINTAINS MAXIMUM RESOLUTION + TAD ONEPEX + DCA ONEPEX /IGNORE ANY OVERFLOW + TAD ONEVEY /DO THE SAME FOR Y COORDINATE + JMS I ISHFT /AND VELOCITY COMPONENT + JMS I ISHFT + TAD ONEPEY + DCA ONEPEY + TAD ONEOUT /DO NOT ALLOW PROJECTILE LAUNCH IF + SZA CLA /EXPLODING + JMP I ITWOUP + + + +ONELNC, TAD LNC1FG /OTHERWISE, SEE IF RELOAD IS FINISHED + SNA CLA + JMP .+3 + ISZ LNC1FG /NO, CONTINUE RELOADING + JMP I ITWOUP /AND EXIT + TAD INTWRD /YES, READY TO LAUNCH, TRIGGER BEEN PULLED? + AND P20 /TEST BIT7 + SNA CLA + JMP I ITWOUP /NO, WAIT FOR A BETTER SHOT + /.....I GUESS..... + TAD PROLIF /YES, SET CYCLE COUNT FOR THIS LAUNCH + DCA I AUTO16 /AUTO16 ALWAYS POINTS AT THE NEXT SLOT IN THE FILE + TAD ONEVEX /ADD SHIPS VELOCITY (SCALED OF COURSE) + JMS I ISHFT /TO ORIENTATION TO EXTABLISH X VELOCITY + JMS I RSHIFT /COMPONENT OF PROJECTILE + TAD ONESIN + JMS I RSHIFT /AND STICK IT IN THE FILE + DCA I AUTO16 + TAD ONESIN /MOVE THE LAUNCH POINT OUTSIDE THE + CLL RTL /SHIP OF ORIGIN + TAD ONEPEX + DCA I AUTO16 /AND STORE X POSITION + TAD ONEVEY /NOW DO THE SAME FOR THE Y VELOCITY AND + JMS I ISHFT /POSITION + JMS I RSHIFT + TAD ONECOS + JMS I RSHIFT + DCA I AUTO16 + TAD ONECOS + CLL RTL + TAD ONEPEY + DCA I AUTO16 + TAD M200 /START RELOAD CYCLE + DCA LNC1FG + JMS I RESET1 /RESET AUTO16 TO NEXT HOLE + + JMP I .+1 /NOW TO FIX IT UP WITH NUMBER TWO +ITWOUP, TWOUP + +LNC1FG, 0 /PROJECTILE LAUNCH ENABLE + +OP300, 300 /HYPERSPACE REQUEST CODE BITS 4 AND 5 +OM300, -300 +ONEWN, ONEWIN /POINTER TO VICTORY MESSAGE + + +/ +/ HERE BEGINS THE UPDATE PROCEEDURE FOR SHIP NUMBER TWO. +/ OPERATION IS THE SAME AS FOR NUMBER ONE ABOVE. +/ + + *600 + +TWOUP, TAD TWOFLG /FIRST SEE IF IT'S IN NORMAL SPACE + SNA + JMP TWOOK /YES, CONTINUE + IAC /NO, BUMP COUNT AND TEST FOR REENTRY + SNA + TAD TWOFIN /IF RE-ENTERING THROW BACK OUT IF FINISHED + DCA TWOFLG /AND CONTINUE + JMP I IONEST + +TWOOK, TAD TWOOUT /HERE WHEN READY TO UPDATE IN NORMAL SPACE + SZA CLA /IS IT EXPLODING? + JMP TWOFIG /YES DO NOT ALLOW HYPERSPACE + TAD ONEFIN /DID WE JUST WIN? + SZA CLA + JMS I TWOWN /YES ENABLE END OF GAME MESSAGE + TAD INTWRD /TEST FOR HYPERSPACE REQUEST + AND OP14 + TAD OM14 /BITS 8 AND 9 MUST BE SET + SNA CLA + JMP I HYPER /8 AND 9 SET. ENTER HYPER ROUTINE WITH AC=0 + /FOR SHIP NUMBER 2 +TWOLEF, TAD INTWRD /TEST FOR LEFT TURN - BIT 8 + AND P10 + SNA CLA + JMP TWORYT /NOT SET + CLA CLL CMA /SET, DECREMENT TWOTHE BY 1 DEGREE + JMP TWOFIG /SKIP TEST FOR RIGHT TURN + +TWORYT, CLA CLL IAC RTL /TEST FOR RIGHT TURN - BIT 9 + AND INTWRD + SZA CLA + IAC /IF SET INCREMENT TWOTHE BY 1 DEGREE + +TWOFIG, TAD TWOTHE /UPDTAE TWOTHE + JMS I THEADJ /BRING TO WITHIN LIMITS OF SINE,COSINE + DCA TWOTHE /AND STORE + TAD TWOTHE + JMS I SINE /CALCULATE SINE AND COSINE FUNCTIONS + DCA TWOSIN /AND STORE IN DATA TABLE + TAD TWOTHE + JMS I COSINE + DCA TWOCOS + TAD TWOOUT /DO NOT ALLOW VELOCITY CHANGE IF EXPLODING + SZA CLA + JMP TWOVEL + + + +TWOMOV, TAD ACCFLG /NOW FOR ACCELERATION. TEST TO SEE IF ALLOWED + SZA CLA /DURING THIS UPDATE CYCLE + JMP TWOVEL /NOPE + CLL IAC RAL /YES, TEST FOR BIT 2 SET + AND INTWRD + SNA CLA + JMP TWOVEL /NOT SET + + TAD TWOSIN /UPDATE X VELOCITY COMPONENT BY SINE OF + TAD TWOVEX /ANGLE OF ORIENTATION + JMS I VEESCL /AND SCALE TO NOT EXCEED MAX + DCA TWOVEX /UPDATE Y COMPONENT WITH COSINE + + TAD TWOCOS + TAD TWOVEY + JMS I VEESCL + DCA TWOVEY + + + +TWOVEL, TAD TWOVEX /NOW UPDATE THE POSITION WITH THE VELOCITY + JMS I ISHFT /COMPONENTS/16 + JMS I ISHFT + TAD TWOPEX + DCA TWOPEX + TAD TWOVEY + JMS I ISHFT + JMS I ISHFT + TAD TWOPEY + DCA TWOPEY + TAD TWOOUT + SZA CLA + JMP I IONEST + + + +TWOLNC, TAD LNC2FG /NOW CHECK FOR PROJECTILE LAUNCH. FIRST + SNA CLA /TEST TO SEE IF RELOAD COMPLETE + JMP .+3 + ISZ LNC2FG /NO, COUNT ONE CYCLE AND EXIT + JMP I IONEST + IAC /YES, TEST TRIGGER BIT 11 + AND INTWRD + SNA CLA + JMP I IONEST /NOT SET, HELL WITH IT + + TAD PROLIF /OK, SET PROJECTILE LIFE + DCA I AUTO16 /AUTO16 IS ALWAYS POINTING AT THE NEXT SLOT + TAD TWOVEX /ADD SHIPS VELOCITY + JMS I ISHFT /(ADJUSTED) + JMS I RSHIFT + TAD TWOSIN /TO THAT OF PROJECTILE - AGAIN X COMPONENT + JMS I RSHIFT /FROM SINE OF ANGLE OF ORIENTATION + DCA I AUTO16 + TAD TWOSIN /SET INITIAL POSITION TO BE JUST AHEAD + CLL RTL /OF THE SHIP + TAD TWOPEX /X COMPONENT + DCA I AUTO16 + TAD TWOVEY /NOW THE Y COMPONENTS FROM Y VELOCITY + JMS I ISHFT /Y POSITION AND COSINE + JMS I RSHIFT + TAD TWOCOS + JMS I RSHIFT + DCA I AUTO16 + TAD TWOCOS + CLL RTL + TAD TWOPEY + DCA I AUTO16 + TAD M200 + DCA LNC2FG /200 CYCLES OF RELOAD + JMS I RESET1 /DRINK LEADEN DEATH, NUMBER ONE! + + JMP I .+1 /FINAL EXIT TO DISPLAY FILE CALCULATIONS +IONEST, ONESET + +LNC2FG, 0 /RELOAD COUNT + +OP14, 14 /HYPERSPACE CODE +OM14, -14 +TWOWN, TWOWIN + + +/ +/ HERE BEGINS THE DISPLAY CALCULATIONS FOR THE TWO SHIPS. AT +/ THIS POINT ONLY THE POSITION AND ORIENTATION OF EACH VESSEL +/ IS ONF INTEREST SINCE THE VELOCITY AND ALL THAT HAVE ALREADY +/ BEEN TAKEN CARE OF. FOR THE BOTH SHIPS THE DISPLAY FILES ARE +/ CALCULATED AS A SERIES OF PAIRS OF X,Y COORDINATES. BETWEEN +/ EACH PAIR OF POINTS A FOUR POINT VECTOR WILL BE DRAWN. THE +/ ACTUAL COORDINATES ARE CALCULATED AS DISPLACEMENTS +/ FROM THE CENTRAL PSOTION OF THE SHIP, TAKING INTO ACCOUNT THE +/ ANGLE OF ORIENTATION. THE FORMULAS FOLLOWED ARE: +/ +/ X(POINT)=X(BASE)+X(REL)*COS[THE]+Y(REL)*SINE[THE] +/ +/ Y(POINT)=Y(BASE)+Y(REL)*COS[THE]-X(REL)*SINE[THE] +/ +/ WHERE SINE[THE] AND COS[THE] ARE THE FUNCTIONS OF THE +/ ANGLE OF ORIENTATION, X(BASE) AND Y(BASE) ARE THE +/ COORDINATES OF THE SHIPS POSITION AND X(REL) AND Y(REL) +/ CORRESPOND TO DISPLACEMENT PAIRS DEPENDING ON THE SHAPE +/ OF THE FIGURE. ALL X AND Y RELS LIE WITHIN THE RANGE 0-3 AND +/ THERE FORE ALL NECESSARY DISPLACEMENTS FROM BASE COORDINATES +/ MAY BE CALCULATEDFROM DIFFERENT COMBINATIONS OF T10SIN, T20COS +/ ETC. THESE VALUES ARE CALCULATED BY A CALL TO POSCAL WITH THE SINE +/ AND COSINE OF THE ANGLE OF INTEREST IN CALSIN AND CALCOS. +/ +/ FOLLOWING THIS METHOD ANY FIGURE DESCRIBABLE WITH A 7 BY 7 +/ MATRIX OF POINTS MAY BE QUICKLY CALCULATED. +/ +/ BEGINNING AT ONESET DIFFERENT DISPLACEMENT PAIRS ARE CALCULATED +/ AND DEPOSITIED THROUGH AUTO10 TO FORM THE DISPLAY FILE FOR SHIP NUMBER ONE. +/ + + + *1000 + +ONESET, CLA CLL /BEGIN DISPLAY FILE FOR NUMBER ONE + TAD ONEFLG /DONT BOTHER IF NOT IN NORMAL SPACE + SZA CLA + JMP I ITWOST + TAD ONESIN /SET UP FOR MATRIX COMPONENT CALCULATIONS + DCA CALSIN + TAD ONECOS + DCA CALCOS + JMS I CALPOS /CALL THE CALCULATOR + +/ +/ CONSIDER THE 7 BY 7 MATRIX OF DISPLACEMENT POINTS WITH THE +/ CENTER AT 0,0 CORRESPONDING TO THE SHIPS POSITION. A SERIES +/ OF POINTS IS NOW DESCRIBED AROUND THIS CENTER USING THE +/ MULTIPLES OF THE TRIG FUNCTIONS JUST CALCULATED +/ SO THAT ANY POINT ON THE OUTLINE IS DESCRIBABLE AS X,Y +/ DISPLACED BY X,Y OF THE SHIP ITSELF +/ + + TAD ONEFIL /SET UP AUTO10 AS THE DISPLAY FILE + DCA AUTO10 /POINTER + TAD ONEPEX /THE FIRST POINT OF THE OUTLINE IS + TAD T30SIN + DCA I AUTO10 / 0,3 OR TOP CENTER + TAD ONEPEY + TAD T30COS + DCA I AUTO10 + + TAD T10COS + CIA /THE SECOND IS + TAD ONEPEX + DCA I AUTO10 / -1,0 + TAD T10SIN /OR JUST LEFT OF DEAD CENTER + TAD ONEPEY /AND SO ON + DCA I AUTO10 + + TAD T30SIN + TAD T30COS /THE THIRD POINT IS + CIA + TAD ONEPEX / -3,-3 + DCA I AUTO10 + TAD T30COS /OR BOTTOM LEFT HAND CORNER + CIA + TAD T30SIN + TAD ONEPEY + DCA I AUTO10 + + + + TAD T10SIN + CIA /FOURTH POINT + TAD ONEPEX + DCA I AUTO10 / 0,-1 + TAD T10COS + CIA /OR JUST BELOW CENTER + TAD ONEPEY + DCA I AUTO10 + +FLAM1, TAD INTWRD /TEST FOR POWER ON. IF ON, DRAW THE + AND P40 /FLAME WITH AN EXTRA POINT SOME + SNA CLA /DISTANCE DIRECTLY BELOW THE SHIP + JMP ONECON /POWER NOT ON - CONTINUE + TAD ONEOUT /DO NOT ALLOW IF EXPLODING + SZA CLA + JMP ONECON + + TAD ONFG1 /USE ONFG1 TO TURN THE FLAME ON AND + SNA /OFF TO MAKE IT FLICKER. DISPLAY THE + CLA CLL CMA RAL /FLAME ONE TIME OUT OF THREE + DCA ONFG1 + + ISZ ONFG1 + JMP ONECON /ONE OUT OF THREE TIMES THIS WILL SKIP + + TAD ONFG2 /VARY ALSO THE LENGHT OF THE FLAME + CMA /WITH LONG SHORT LONG SHORT + DCA ONFG2 + + TAD ONFG2 /TIP OF FLAME AT EITHER + SNA CLA + TAD T10SIN / 0,-4 OR + TAD T30SIN / 0,-3 + CIA + TAD ONEPEX + DCA I AUTO10 + TAD ONFG2 + SNA CLA + TAD T10COS + TAD T30COS + CIA + TAD ONEPEY + DCA I AUTO10 + + TAD T10SIN + CIA + TAD ONEPEX /RETURN DISPLAY TO 0,-1 + DCA I AUTO10 + TAD T10COS + CIA + TAD ONEPEY + DCA I AUTO10 + CLA CLL CMA RAL /ADD -2 TO POINT COUNT + + + +ONECON, TAD M6 /SET POINT COUNT TO -6 OR -8 + DCA ONECNT + + TAD T30SIN /CONTINUE WITH DISPLAY FILE - THIS POINT + CIA + TAD T30COS / AT 3,-3 + TAD ONEPEX / + DCA I AUTO10 /OR LOWER RIGHT HAND CORNER + TAD T30SIN + TAD T30COS + CIA + TAD ONEPEY + DCA I AUTO10 + + TAD T10COS /NEXT + TAD ONEPEX / + DCA I AUTO10 / 1,0 + TAD T10SIN / + CIA / OR JUST RIGHT OF CENTER + TAD ONEPEY + DCA I AUTO10 + + TAD T30SIN /FINALLY BACK TO + TAD ONEPEX / + DCA I AUTO10 / 0,3 + TAD T30COS / + TAD ONEPEY / TOP CENTE + DCA I AUTO10 + + JMP I ITWOST /NOW FOR NUMBER TWO +ITWOST, TWOSET + +ONFG1, 0 /USED TO COUNT FLICKERS +ONFG2, 0 /SHORT OR LONG FLAG + + +/ +/ HERE BEGINS THE DISPLAY FILE GENERATOR FOR SHIP TWO. +/ IT WORKS JUST LIKE THE ONE FOR NUMBER ONE BUT WITH +/ DIFFERENT DISPLACEMENT PAIRS AND TWO EXTRA POINTS +/ + + *1200 + +TWOSET, CLA CLL /DONT BOTHER IF NOT IN NORMAL SPACE + TAD TWOFLG + SZA CLA + JMP I IFILDS + TAD TWOSIN /SET UP TO HAVE DISPLACEMENT INCREMENTS + DCA CALSIN /CALCULATED + TAD TWOCOS + DCA CALCOS + JMS I CALPOS + + TAD TWOFIL /SET AUTO10 TO POINT TO SECOND DISPLAY + DCA AUTO10 /FILE + TAD T30SIN /FIRST POINT AT + TAD TWOPEX / + DCA I AUTO10 / 0,3 + TAD T30COS / + TAD TWOPEY / OR TOP CENTER + DCA I AUTO10 + + TAD T20COS + CIA + TAD T20SIN + TAD TWOPEX + DCA I AUTO10 + TAD T20SIN + TAD T20COS /SECOND POINT + TAD TWOPEY / -2,2 + DCA I AUTO10 + + TAD T20COS /THIRD POINT + CIA / -2,0 + TAD TWOPEX + DCA I AUTO10 + TAD T20SIN + TAD TWOPEY + DCA I AUTO10 + + + + TAD T20COS + TAD T30SIN + CIA + TAD TWOPEX /FOURTH POINT + DCA I AUTO10 / -2,-3 + TAD T30COS + CIA + TAD T20SIN + TAD TWOPEY + DCA I AUTO10 + + + + TAD T20SIN + CIA /NEXT + TAD TWOPEX / 0,-2 + DCA I AUTO10 + TAD T20COS + CIA + TAD TWOPEY + DCA I AUTO10 + +FLAM2, CLA CLL IAC RAL /NOW THE FLAME BIT. CHECK FOR POWER ON + AND INTWRD + SNA CLA + JMP TWOCON /NO, FORGET IT + TAD TWOOUT /NOT ALLOWED IF EXPLODING + SZA CLA + JMP TWOCON + + TAD TWFG1 /SET THE 1-3 FLICKER AS WITH #1 + SNA + CLA CLL CMA RAL + DCA TWFG1 + + ISZ TWFG1 /ALSO THE LENGHT VARIATION + JMP TWOCON + + TAD TWFG2 /EVERY OTHER TIME LONG + CMA + DCA TWFG2 + /FLAME TIP AT EITHER + TAD TWFG2 / 0,-3 + SNA CLA /OR + TAD T20SIN / 0,-5 + TAD T30SIN + CIA + TAD TWOPEX + DCA I AUTO10 + TAD TWFG2 + SNA CLA + TAD T20COS + TAD T30COS + CIA + TAD TWOPEY + DCA I AUTO10 + + TAD T20SIN /NOW BACK UP TO THE SHIP + CIA + TAD TWOPEX + DCA I AUTO10 + TAD T20COS + CIA + TAD TWOPEY + DCA I AUTO10 + + CLA CLL CMA RAL /ADD -2 TO POINT COUNT + + + +TWOCON, TAD M10 /SET POINT COUNT TO -8 OR -10 + DCA TWOCNT + + TAD T30SIN /CONTINUE WITH DISPLAY FILE + CIA /NEXT POINT AT 2,-3 + TAD T20COS + TAD TWOPEX + DCA I AUTO10 + TAD T30COS + TAD T20SIN + CIA + TAD TWOPEY + DCA I AUTO10 + + + + TAD T20COS /NEXT POINT + TAD TWOPEX / + DCA I AUTO10 / 2,0 + TAD T20SIN + CIA + TAD TWOPEY + DCA I AUTO10 + + TAD T20COS /AND THE NEXT AT + TAD T20SIN + TAD TWOPEX / 2,2 + DCA I AUTO10 + TAD T20SIN + CIA + TAD T20COS + TAD TWOPEY + DCA I AUTO10 + + TAD T30SIN + TAD TWOPEX + DCA I AUTO10 + TAD T30COS /AND THE LAST AT + TAD TWOPEY / + DCA I AUTO10 / 0,3 + + JMP I IFILDS /NOW TO DISPLAY THE WHOLE MESS +IFILDS, FILDIS + +TWFG1, 0 /FLIK THE FLAME +TWFG2, 0 /LONG OR SHORT + + +/ +/ HERE TO DISPLAY THE TWO SHIPS. CHECK FIRST FOR COLLISION +/ AND THEN SET THE TWO PAIRS OF COORDENATES FOR THE END +/ POINTS AND CALL THE "VECTOR GENERATOR" TO DRAW THE DOTS +/ IN BETWEEN. WHEN THE COUNT OVERFLOWS DO THE SAME FOR +/ NUMBER TWO. THEN EXIT TO DISPLAY ALL THE PROJECTILES. +/ + + *1400 + +FILDIS, CLA CLL /ALL SET TO GO + JMS I COLIDE /TEST FOR COLLISION FIRST +/ DSB 1 /IF NO COLLISION + TAD ONEFLG /SKIP NUMBER ONE IF NOT IN NORMAL + SZA CLA /SPACE + JMP TWODIS + + TAD ONEFIL /SET UP POINTERS TO DISPLAY FILE + DCA AUTO10 /FOR NUMBER ONE + TAD ONECNT /ALONG WITH VECTOR COUNT + DCA AUTO11 + TAD I AUTO10 /SET OUT THE FIRST POINT PAIR + DCA XONEDS + TAD I AUTO10 + DCA YONEDS + TAD ONEOUT /NORMAL DISPLAY OR EXPLOSION? + SZA CLA + JMP I IONEEX /GO ELSE WHERE FOR EXPLOSION + +FILONE, TAD I AUTO10 /STEP TO NEXT PAIR OF POINTS + DCA XTWODS /SET X AND Y TO NEW POINT + TAD I AUTO10 + DCA YTWODS + JMS I VECTOR /CALL THE DOT DRAWING MACHINE + ISZ AUTO11 + SKP /COUNT + JMP TWODIS /DO NUMBER TWO ON OVERFLOW + TAD XTWODS /SWAP POINTS FOR NEXT PAIR + DCA XONEDS + TAD YTWODS /THE GENERATOR DRAWS FROM ONE + DCA YONEDS /TOWARDS TWO + JMP FILONE + + + +TWODIS, TAD TWOFLG /HERE TO DO NUMBER TWO + SZA CLA /BUT NOT IF IN HYPER SPACE + JMP I IPRODS + + TAD TWOFIL /SET UP FILE POINTER AS IN ONE + DCA AUTO10 + TAD TWOCNT /AND THE COUNT + DCA AUTO11 + TAD I AUTO10 /I SUPPOSE THIS COULD BE A SUBROUTINE TOO + DCA XONEDS + TAD I AUTO10 + DCA YONEDS + TAD TWOOUT /IS IT EXPLODING? + SZA CLA + JMP I ITWOEX /YES, HOW EXCITING + +TWDLOP, TAD I AUTO10 /NO HOW DULL, STICK IN NEXT PAIR OF + DCA XTWODS /POINTS + TAD I AUTO10 + DCA YTWODS /AND CALL THE VECTOR SEQUENCE + JMS I VECTOR + ISZ AUTO11 + JMP .+3 + + JMP I .+1 /WHEN COUNT OVERFLOWS GO ON TO +IPRODS, PRODIS /DO THE PROJECTILE THING + + TAD XTWODS /OTHERWISE SWAP ON TO THE NEXT PAIR + DCA XONEDS /OF POINTS + TAD YTWODS + DCA YONEDS + JMP TWDLOP + +COLIDE, COLLID +IONEEX, ONEEXP +ITWOEX, TWOEXP + + +/ +/ THIS IS THE SO CALLED "VECTOR GENERATOR" WHICH DRAWS A +/ SERIES OF DOTS FROM XONEDS,YONEDS TO XTWODS,YTWODS. +/ THE COORDINATE COMPONENTS ARE DIVIDED INTO FOURTHS AND +/ FOUR DOTS DRAWN ON THE SCOPE SCREEN. NOTE THAT NO DOT +/ IS DRAWN AT XONEDS,YONEDS. THIS IS COMPENSATED FOR ELSEWHERE. +/ + +DISPLY, 0 /ENTER TO DRAW A FOUR POINT VECTOR + CLA + TAD XONEDS /FROM XONEDS,YONEDS + CIA /TO XTWODS,YTWODS + TAD XTWODS /DIVIDE COORDINATE DIFERENCES INTO + JMS DISHFT /FOURTHS + DCA DIXTEM /AND STORE INCREMENT + TAD YONEDS + CIA + TAD YTWODS + JMS DISHFT /FOURTHS + DCA DIYTEM + TAD M4 /FOR FOUR DOTS + DCA DISCNT + +DISLOP, TAD XONEDS /ADD INCREMENT TO CURRENT X AND Y + TAD DIXTEM + DCA XONEDS /NOTE THAT THIS ROUTINE DESTROYS + TAD YONEDS /XONEDS AND YONEDS + TAD DIYTEM + DCA YONEDS + TAD XONEDS +/ RTR /DIVIDE BY 8 TO FIT SCREEN SIZE +/ RAR + DXC DXL /SET X VALUE + CLA + TAD YONEDS /DO THE SAME FOR Y +/ RTR +/ RAR + DYC DYL DIS /AT LAST SOMETHING TO SEE!! + CLA + ISZ DISCNT /DONE YET? + JMP DISLOP /NOPE + JMP I DISPLY /YUP + + +DISHFT, 0 /A GENERALIZED SHIFT ROUTINE CALLED + CLL /FROM EVERYWHERE TO DIVIDE THE + SPA /AC BY FOUR WITH AN ASR RIGHT + CML IAC /NOTE THAT NEGATIVE NUMBERS ARE + RAR /ROUNDED UPWARDS (TOWARD ZERO) + CLL /TO MAKE IT COME OUT RIGHT + SPA + CML IAC /EVEN SO THERE ARE SOME ROUNDING ERRORS + RAR /SOMEWHERE. SO MUCH FOR 12 BIT MACHINES + JMP I DISHFT + + +/ +/ HERE TO DISPLAY ALL THE PROJECTILES AND TEST FOR HITS. +/ THE PROJECTILE DISPLAY FILE IS SEARCHED FOR PROJECTILES WITH +/ NON-ZERO COUNTS AND WHEN ONE IS FOUND THE POSITION IS +/ UPDATED BY THE VELOCITY, THE POINT DISPLAYED AND TESTED FOR +/ A HIT. +/ + + *1600 + +PRODIS, CLA CLL / BEGIN DISPLAY OF THE PROJECTILES + TAD BUFST /POINT TO BEGINNING OF DISPLAY FILE + DCA BUFTMP +/ DSB 2 /SET EXTRA BRIGHT FOR SINGLE POINTS + +PROLOP, TAD I BUFTMP /PICK UP NEXT COUNT + SNA + JMP EXPIRE /THIS ONE IS DEAD - GO TO THE NEXT + IAC /INCREMENT COUNT AND REPLACE + DCA I BUFTMP + ISZ BUFTMP /BUMP POINTER TO X VELOCITY + TAD I BUFTMP + ISZ BUFTMP /THEN TO XPOSITION AND UPDATE X POSITION + TAD I BUFTMP /WITH THE VELOCITY WHICH IS CONSTANT + DCA I BUFTMP + TAD I BUFTMP + DCA PROX /AND STORE X POSITION FOR DISPLAY AND TEST + ISZ BUFTMP /NOW TO Y POSITION AND VELOCITY + TAD I BUFTMP + ISZ BUFTMP + TAD I BUFTMP /SAME LITTLE GAME + DCA I BUFTMP + TAD I BUFTMP + DCA PROY /STORE THE NEW Y VALUE + + TAD PROX /DISPLAY THE POINT WITH +/ RTR /THE SAME SHIFT AS FOR THE SHIPS +/ RAR /FOR THE SMALL SCREEN + DXC DXL + CLA + TAD PROY +/ RTR / +/ RAR + DYC DYL DIS /THERE IT IS!! + CLA + JMS I CHKOUT /TEST FOR A HIT + ISZ BUFTMP /MOVE POINTER ON AND TEST FOR END + TAD BUFTMP /OF BUFFER + TAD BUFLIM + SZA CLA + JMP PROLOP /NOT AT END - CONTINUE + + / +/ HERE AT THE END OF THE PROJECTILE DISPLAY. IF THE GAMOVR +/ FLAG IS SET, GO ON TO THE MESSAGE DISPLAY - VICTORY LAP +/ SECTION. OTHERWISE PICK UP THE REMAINING CLOCK COUNT +/ TO GIVE THE FANS SOMETHING TO LOOK AT, AND MOVE THE +/ ELECTRON BEAM TO A LOWER CORNER. THE COUNT DISPLAYED +/ IN THE AC IS THE NUMBER OF 100 USEC CLOCK TICKS REMAINING +/ WHEN THIS CODE IS REACHED BEFORE THE NEXT UPDATE WOULD +/ BEGIN. TURNS OUT THAT ROUGHLY 2/3 OF THE CPU IS LEFT +/ OVER SHOULD ANYONE WANT TO DO ANYTHING VERY FANCY. +/ + + +FINISH, TAD GAMOVR /IS THIS THE VICTORY LAP OR WHAT? + SZA CLA + JMP I ENDGAM /YES, GO TO PUT UP THE MESSAGE +/ TAD M400 /MOVE THE BEAM OFF SCREEN +/ DYC DYL + CLA CLL +/ DXC DXL + TAD INTCNT /PICK UP THE COUNT + CIA + JMP . + +ENDGAM, JOBLOP + + +EXPIRE, TAD BUFTMP /HERE TO ADVANCE THE BUFFER + TAD P5 /POINTER TO THE NEXT PROJECTILE + DCA BUFTMP /UNLESS THE END + TAD BUFTMP /OF THE BUFFER + TAD BUFLIM /IS REACHED + SZA CLA /IN WHICH CASE + JMP PROLOP /IT + JMP FINISH /QUITS + +BUFST, DISBUF+101 +BUFLIM, -DISBUF-175 +CHKOUT, CHECK + +RESE1, 0 /THIS IS CALLED TO SET THE POINTER + TAD MRES /(AUTO16) TO THE NEXT FREE SLOT + DCA RESCNT /FOR A PROJECTILE LAUNCH. 12 POSSIBLE + +RESLOP, TAD RESPNT /MOVE THE POINTER TO THE NEXT SLOT + TAD P5 + DCA RESPNT + TAD RESPNT /RESTE IF AT END OF BUFFER + TAD BUFLIM + SZA CLA + JMP RESCON + TAD BUFST + DCA RESPNT + +RESCON, TAD I RESPNT /FIND A HOLE YET? + SNA CLA + JMP RESFND /YES, SET UP AUTO16 + ISZ RESCNT /NO COUNT + JMP RESLOP /AND TRY AGAIN + HLT /NO HOLES AT ALL? + +RESFND, CMA /BACK THE POINTER FOR AUTO INDEXING + TAD RESPNT + DCA AUTO16 + JMP I RESE1 + +MRES, -14 +RESCNT, 0 +RESPNT, 0 + +SETBUF, 0 + CMA /THIS ROUTINE IS CALLED FROM THE + TAD BUFST /STARTING SEQUENCE TO INITIALIZE ALL + DCA AUTO16 /THE BUFFER POINTERS AND SO ON + TAD BUFST + DCA BUFTMP + TAD BUFST + DCA RESPNT + TAD BUFST + DCA SETPNT +SETLOP, DCA I SETPNT + ISZ SETPNT + TAD SETPNT + TAD BUFLIM + SZA CLA + JMP SETLOP + JMP I SETBUF + +SETPNT, 0 + + +/ +/ THIS HERE NOW THING CHECKS THE COORDINATES OF THE MOST RECENTLY +/ DISPLAYED PROJECTILE AGAINST THOSE OF THE SHIPS ON THE SCREEN. +/ IF WITH A COLLISION LIMIT A HIT IS RECORDED AND THE LIFE +/ COUNT OF THE PROJECTILE ZEROED TO REMOVE IT. A HIT SHIP +/ IS SUITABLY FLAGGED +/ + + *2000 + +CHECK, 0 /HERE TO TEST FOR A PROJECTILE HIT + TAD ONEFLG /CANT HIT SOMETHING IN HYPERSPACE + SZA CLA + JMP CHECK2 + TAD ONEOUT /OR SOMETHING THAT'S BEEN HIT + SZA CLA + JMP CHECK2 + + TAD PROX /CHECK X COORDINATES OF SHIP ONE + CIA /AND PROJECTILE + TAD ONEPEX /THIS SORT OF THING IS WHY THE + SPA /COORDINATES HAVE TO BE MAINTAINED TO 12 + CIA /BITS + TAD LIMIT /CLOSE ENOUGH? + SMA CLA + JMP CHECK2 /IF X ISN' CLOSE ENOUGH THEN NO HIT + TAD PROY /X WAS CLOSE ENOUGH, HOW ABOUT Y? + CIA + TAD ONEPEY + SPA + CIA + TAD LIMIT + SMA CLA + JMP CHECK2 /NO HIT + + TAD MEXP /DEPOSIT EXPLOSION COUNT IN ONEOUT + DCA ONEOUT /ALL THAT IS NECESSARY + JMS CUTOUT /REMOVE PROJECTILE + + + +CHECK2, TAD TWOFLG /NO HIT ON NUMBER ONE, TRY NUMBER TWO + SZA CLA + JMP I CHECK /BUT NOT IF IN HYPERSPACE + TAD TWOOUT /OR IF ALREADY HIT + SZA CLA + JMP I CHECK + + TAD PROX /CHECK X'S FIRST + CIA + TAD TWOPEX + SPA /GET ABSOLUTE VALUE OF DIFFERENCE + CIA + TAD LIMIT /AND TEST MAGNITUDE AGAINST PROXIMITY + SMA CLA /LIMIT + JMP I CHECK /NOWHERE NEAR CLOSE + + TAD PROY /NYAH, NYAH + CIA /TRY THE Y'S + TAD TWOPEY + SPA + CIA /ABSOLUTE VALUE OF DIFFERENCE + TAD LIMIT + SMA CLA + JMP I CHECK /CLEAN MISS! + + TAD MEXP /HIT ON TWO - END EVERYTHING BY SETTING + DCA TWOOUT /TWOOUT TO NON-ZERO EXPLOSION COUNT + JMS CUTOUT + JMP I CHECK /EXIT AFTER DESTOYING PROJECTILE + +LIMIT, -120 /PROXIMITY LIMIT FOR WHAT CONSTITUTES A HIT + +CUTOUT, 0 /THIS ROUTINE ZEROES OUT THE MOST RECENTLY + TAD M4 /DISPLAYED PROJECTILE BY ZEROEING THE + TAD BUFTMP /COUNT + DCA CUTPNT + DCA I CUTPNT + JMP I CUTOUT + +CUTPNT, 0 + + +/ +/ THIS ROUTINE IS CALLED TO TEST FOR A COLLISION BETWEEN THE +/ TWO SHIPS. THE COORDINATES OF BOTH ARE COMPARED +/ AND IFF SUFFICIENTLY CLOSE BOTH ARE DESTROYED BY SETTING +/ THEIR EXPLOSION COUNTS NON-ZERO. +/ + + +COLLID, 0 /HERE TO TEST FOR COLLISION + TAD ONEFLG /NO TEST IF EITHER SHIP IS IN + SZA CLA /HYPERSPACE OR EXPLODING + JMP I COLLID + TAD TWOFLG + SZA CLA + JMP I COLLID + TAD ONEOUT + SZA CLA + JMP I COLLID + TAD TWOOUT + SZA CLA + JMP I COLLID + + TAD ONEPEX /BOTH SHIPS AVAILABLE FOR COLLISION + CIA /CHECK X COORDINATES FIRST + TAD TWOPEX + SPA /GET ABSOLUTE VALUE OF DIFFERENCE + CIA + TAD COLLIM /CLOSE ENOUGH? + SMA CLA + JMP I COLLID /NOPE, FORGET IT + + TAD ONEPEY /YES, NOW TRY THE Y COORDINATES + CIA + TAD TWOPEY + SPA + CIA /GET MAGNITUDE ONLY + TAD COLLIM + SMA CLA /CLOSE ENOUGH? + JMP I COLLID + TAD MEXP /YES, SET BOTH EXPLOSION COUNTS + DCA ONEOUT + TAD MEXP + DCA TWOOUT + JMP I COLLID + +COLLIM, -300 + +/ +/ THIS ROUTINE IS CALLED TO SET ONE OF THE TWO SHIPS INTO +/ HYPERSPACE. ON ENTRY THE AC=-1 FOR SHIP #1, 0 FOR SHIP +/ NUMBER 2. THE LOCATION CLOCK IS USED FOR A RANDOM +/ ADDRESS POINTER FROM WHICH WILL BE DRAWN THE +/ VARIOUS PARAMETERS FOR REENTRY. +/ + + *2200 + +HYPSET, DCA RTNFLG /HERE WITH AC=-1 OR 0 + TAD RTNFLG /SET UP LIST POINTER + SZA CLA + TAD ONEDIF /TO APPROPRIATE SHIP FILE + TAD TWOLST + DCA AUTO15 + + CLCA /SET UP "RANDOM NUMBER GENERATOR" + /USE CLOCK COUNTER FOR THAT PURPOSE + DCA AUTO17 + TAD I AUTO17 /PICK UP FIRST THE AMOUNT OF TIME + AND TIMOUT /OUT OF NOMAL SPACE LIMITED TO -777 + CIA /UPDATE CYCLES ( ABOUT 15 SECONDS) + DCA I AUTO15 /AND STORE IN ONEOUT OR TWO OUT + + TAD I AUTO17 /THE NEXT RANDOM NUMBER BECOMES THE + JMS I THEADJ /ANGLE OR ORIENTATION ON REENTRY + DCA I AUTO15 + TAD I AUTO17 /AND THE NEXT BECOMES THE X VELOCITY + JMS VEESET /COMPONENT + DCA I AUTO15 + TAD I AUTO17 /AND THEN THE Y COMPONENT + JMS VEESET + DCA I AUTO15 + TAD I AUTO17 + DCA I AUTO15 + + TAD I AUTO17 + DCA I AUTO15 + + TAD I AUTO17 /FINALLY SEE IF RETURN WILL BE SUCCESSFLY + AND TIMOUT + TAD MHYP /ABOUT 3/4 CHANCE + SMA CLA + JMP HYPRET /OK + TAD RTNFLG /THIS IS THE ONE TIME IN FOUR. SET + SZA CLA /UP FOR EXPLOSION ON REENTRY + TAD ONEDIF + TAD OUTLOC + DCA VEESET + TAD MEXP + DCA I VEESET + +HYPRET, ISZ RTNFLG + JMP I TWORTN + JMP I ONERTN + +TIMOUT, 777 +ONEDIF, ONEFLG-TWOFLG +TWOLST, TWOFLG-1 +RTNFLG, 0 +ONERTN, TWOUP +TWORTN, ONESET +OUTLOC, TWOOUT +MHYP, -200 + + + +VEESET, 0 /HERE TO LIMIT VELOCITY COMPONENTS + CLL + SPA /GET MAGNITUDE + CML + AND HM177 /LIMIT TO 177 + SZL CLL + CIA + JMP I VEESET /AND EXIT + +HM177, 177 + +ONEEXP, CLA CLL /HERE TO DISPLAY SHIP NUMBER ONE AS + TAD ONETHE /AN EXPLOSION + TAD INCONE /FIRST ROTATE IT BY A GOOD DOLLOP + DCA ONETHE + JMS I IXPDIS /THEN CALL THE EXPLOSION GENERATOR + ISZ ONEOUT /DONE WITH THE EXPLOSION? + JMP I NOWTWO /NO, NORMAL RETURN + + IAC /YES, SET INTO PSEUDO HYPER SPACE + DCA ONEFLG + IAC /DISABLE RETURN FROM HYPER SPACE + DCA ONEFIN + + TAD TWOFIN /IS NUMBER TWO STILL AROUND? + SNA CLA + JMP I NOWTWO /YES, RETURN + JMP I TIEUP /NO, TIE BALL GAME + + +TWOEXP, CLA CLL /HERE TO DISPLAY SHIP NUMBER TWO + TAD TWOTHE /AS AN EXPLOSION. BASH IT AROUND + TAD INCTWO + DCA TWOTHE + JMS I IXPDIS /THEN DISPLAY IT + ISZ TWOOUT /DONE WITH EXPLOSION? + JMP I NOWPRO /NO, NORMAL RETURN + + IAC /YES, SEND INTO PSEUDO HYPER SPACE + DCA TWOFLG + IAC /DISABLE NORMAL RETURN FROM HYPERSPACE + DCA TWOFIN + /CHECK NUMBER ONE + TAD ONEFIN + SZA CLA /STILL ALIVE AND WELL? + JMP I TIEUP /NO, TIE GAME + JMP I NOWPRO /YES, CONTINUE ON +NOWTWO, TWODIS +NOWPRO, PRODIS +TIEUP, NOWIN +IXPDIS, EXPDIS +INCONE, 55 +INCTWO, 55 + + +/ +/ HERE TO DISPLAY THE FIGURE POINTED TO BY AUTO10 AS +/ AN EXPLOSION. THIS WORKS THE SAME WAY AS THE NORMAL +/ DISPLAY ROUTINE EXCEPT THAT THE COORDINATE INCREMENTS +/ ARE INVERTED TURNING THE FIGURE INSIDE OUT FOR S +/ A SORT OF CLOBBY EXPLOSION. +/ + + *2400 + +EXPDIS, 0 /HERE TO DISPLAY A FIGURE INSIDE OUT + TAD I AUTO10 /WITH THE POINTERS AND COUNTS ALREADY + DCA XTWODS /SET UP BY FILDIS OR TWODIS + TAD I AUTO10 /STICK NEXT TWO POINTS INTO LINE + DCA YTWODS + + TAD XTWODS + CIA /CALCULATE INCREMENT THE WRONG WAY + TAD XONEDS + DCA DIXTEM /AND STORE + TAD YTWODS + CIA + TAD YONEDS + DCA DIYTEM /SAME FOR Y + + TAD M4 /4 DOTS IN THE VECTOR" + DCA DISCNT /COULD HAVE CALLED THE OTHER + /VECTOR GENERATOR I SUPPOSE +EXPLOP, TAD XONEDS + TAD DIXTEM /ADD X AND Y INCREMENTS TO THE RUNNING + DCA XONEDS /TOTALS AND DISPLAY THE RUNNING + TAD YONEDS /TOTALS NORMAL SIZE + TAD DIYTEM + DCA YONEDS + + TAD XONEDS +/ RTR /COULD MAKE TWICE AS BIG BY NOP-ING +/ RAR /THE RAR'S BUT THE SCREEN IS SMALL ENOUGH + JMS I IVCLDX /AS IT IS + CLA + TAD YONEDS +/ RTR +/ RAR + JMS I IVCLDY +/ DISD +/ JMP .-1 +/ DIXY + + CLA + ISZ DISCNT /DONE 4 DOTS? + JMP EXPLOP /NO + + ISZ AUTO11 /DONE ALL VECTORS IN THE FILE? + SKP + JMP I EXPDIS /YES, EXIT + + TAD XTWODS /NO SWAP TO NEXT PAIR OF POINTS + DCA XONEDS + TAD YTWODS + DCA YONEDS + JMP EXPDIS+1 + + + +/ +/ VEELIM IS THE SCALING ROUTINE FOR VELOCITY COMPONENTS. +/ THE COMPONENTS ARE SCALED TO REMAIN IN THE RANGE 140 +/ TO -140. THIS IS NECESSARY TO AVOID ASTRONOMICAL SPPED +/ BUILDUP ON THE SMALL SCREEN. UNFORTUNATELY THE X AND Y +/ COMPONENTS ARE SCALED SEPARATELY WHICH GIVES SLIGHT BUT +/ NOTICABLE DISTORTIONS IN DIAGONAL FLIGHT PATHS. IN THE +/ NORMAL HEAT OF THE BATTLE NO ONE WILL REALLY NOTICE. +/ + + +VEELIM, 0 /ENTER TO SCALE VELOCITY HELD IN + DCA VEEHLD /AC + TAD VEEHLD + SMA /BRANCH FOR POSITIVE OR NEGATIV + JMP VEEPOS + TAD VEEMAX + SMA CLA /GREATER THAN MAXIMUM POSITIVE? + JMP VEECLR /NO + TAD VEEMIN /I MEAN MAXIMUM NEGATIVE - YES SET + JMP I VEELIM /TO MAX NEGATIV + +VEEPOS, TAD VEEMIN /GREATER THAN MAX? + SPA CLA + JMP VEECLR /NO + TAD VEEMAX /YES SET TO MAX + JMP I VEELIM + +VEECLR, TAD VEEHLD /IT WAS IN RANGE ALL ALONG + JMP I VEELIM + +VEEHLD, 0 +VEEMIN, -140 +VEEMAX, 140 + +THEAJI, 0 /HERE TO ADJUST THE ANGLE TO A RANGE + SMA /0-550 OR 0-360 DEGREES. THIS IS + JMP .+3 /NECESSARY TO INSURE THAT PUSHDOWN OVERFLOW + TAD P550 /WILL NOT HAPPEN IN THE SINE AND COSINE + JMP .-3 /ROUTINES. THIS SIMPLY TAKES THE AC + TAD M550 /MODULO 360 AND EXITS + SMA + JMP .-2 + TAD P550 /FOLLOW IT THROUGH AND SEE IF IT DOESN'T + JMP I THEAJI + + +/ +/ ONE OF THESE ROUTINE IS ENTERED WHEN A WINNER IS DECLARED. +/ THE ADDRESS OF THE VICTORY MESSAGE IS PLACED IN MESS AND +/ THE GAMOVR FLAG SET TO CAUSE A BRANCH TO JOBLOP WHEN THE +/ DISPLAY CYCLE IS COMPLETED. THE ROUTINE WILL THEN DISPLAY +/ THE APPROPRIATE MESSAGE OVER THE REMAINING SHIPS IF +/ ANY UNTIL THE KEYBOARD IS MOLESTED OR THE CLOCK RUNS OUT +/ AND THE NEXT DISPLAY UPDATE CYCLE IS SET. AT ANY RATE THE +/ PROGRAM WILL REACH HERE ONLY WHEN SOMEONE HAS BITTEN THE +/ INTERGALACTIC DUST. +/ + + +ONEWIN, 0 /THIS IS CALLED WHEN TWOFIN IS SET + TAD MES1 /AND ONE FIN IS NOT. SET ONE TO VICTOR + DCA MESS /AND SET GAMOVR FLAG + IAC + DCA GAMOVR + JMP I ONEWIN /THEN RETURN TO UPDATE CYCLE + +TWOWIN, 0 /THIS IS CALLED WHEN ONEFIN IS SET + TAD MES2 /AND TWO FIN IS NOT + DCA MESS /SET ALSO GAMOVR + IAC + DCA GAMOVR + JMP I TWOWIN + +NOWIN, TAD MES4 /GET HERE WHEN BOTH ONEFIN AND TWOFIN + DCA MESS /ARE SET . + IAC + DCA GAMOVR /NOBODY EVER REALLY WINDS + /UP THE WINNER IN THESE THINGS +JOBLOP, +/ DSB 1 /THIS IS ENTERED FROM FINISH WHEN + TAD MES0 /GAMOVR IS SET AND SERVES TO DISPLAY + JMS I MESOUT /THE VICTORY MESSAGE ON THE SCREEN + TAD MESS /USING THE CHARACTER GENERATOR SOMEWHAT + JMS I MESOUT /FURTHER ON UNTIL THE GAME IS RESTARTED + TAD MES5 /OR UNTIL THE INTERRUPT COUNT OVERFLOWS + JMS I MESOUT /AND THE UPDATE CYCLE IS RESTARTED + TAD MES3 + JMS I MESOUT +FINITO, JMP JOBLOP + +MES0, MESS0 +MES1, MESS1 +MES2, MESS2 +MES3, MESS3 +MES4, MESS4 +MES5, MESS5 +MESS, 0 + + +/ +/ THE FOLLOWING ARE THE SINE AND COSINE ROUTINES CUSTOMIZED +/ FOR THIS PROGRAM FROM ANOTHER I WORKED ON. CALL EITHER +/ SINE OR COSINE WITH ANGLE IN DEGREES IN AC. THE ARGUEMENT +/ IS REDUCED THROUGH RECURSION UNTIL BETWEEN 0-89 DEGREES +/ AND THEN A TABLE LOOKUP DONE TO OBTAIN THE VALUE. IT TAKES +/ UP A FAIR AMOUNT OF SPACE BUT IT WORKS JUST FASTER +/ THAN SHEEP. THE COSINE CALL JUST TRANSFORMS THE ARGUEMENT +/ THROUGH SOME TRIGONOMETRIC GARBAGE AND CALLS THE SINE +/ ROUTINE. NOTE THAT CALLING EITHER ROUTINE WITH TOO +/ LARGE AN ARGUEMENT WILL CAUSE PUSHDOWN OVERFLOW AND THEN +/ ALL HELL WILL BREAK LOOSE. THE ORIGINAL ROUTINE FROM WHICH +/ THIS WAS STOLEN HAD FULL WORD PRECISION. +/ + + *6400 + +SINEIN, 0 /I REALLY CANT BRING MYSELF TO COMMENT + DCA SINARG /THIS. IT'S VERY STRAIGHFORWARD + TAD SINEIN + DCA I SINPSH + ISZ SINPSH + TAD SINARG + SZA + JMP SINNG2 + +SINPOP, CLA CLL CMA + TAD SINPSH + DCA SINPSH + TAD I SINPSH + DCA SINEIN + TAD SINARG + JMP I SINEIN + +SINNG2, SMA + JMP SINPOS + CIA + JMS SINEIN + +SINNEG, CIA + DCA SINARG + JMP SINPOP + +SINPOS, TAD M264 + SPA + JMP .+2 + JMP SINNEG-1 + TAD P132 + SPA + JMP SINELK + SZA CLA + JMP .+3 + TAD P37 + JMP SINNEG+1 + + TAD SINARG + TAD M264 + JMP SINNEG-1 + +SINELK, TAD P132 + TAD SINTAB + DCA SINEIN + TAD I SINEIN + DCA SINARG + JMP SINPOP + + + +SINARG, 0 +SINPSH, SINLST +SINLST, 0 + 0 + 0 + 0 + 0 + 0 + +SINTAB, SINES-1 + +COSINI, 0 + CIA + TAD P132 + JMS SINEIN + JMP I COSINI + + + +SINES, 00 /1 + 01 /2 + 01 /3 + 02 /4 + 02 /5 + 03 /6 + 03 /7 + 04 /8 + 05 /9 + 05 /10 + 06 /11 + 06 /12 + 07 /13 + 07 /14 + 10 /15 + 10 /16 + 11 /17 + 11 /18 + 12 /19 + 12 /20 + 13 /21 + 13 /22 + 14 /23 + 15 /24 + 15 /25 + 16 /26 + 16 /27 + 17 /28 + 17 /29 + 20 /30 + 20 /31 + 20 /32 + 21 /33 + 21 /34 + 22 /35 + 22 /36 + 23 /37 + 23 /38 + 24 /39 + 24 /40 + 25 /41 + 25 /42 + 25 /43 + 26 /44 + 26 /45 + 27 /46 + 27 /47 + 27 /48 + 30 /49 + 30 /50 + 30 /51 + 31 /52 + 31 /53 + 31 /54 + 32 /55 + 32 /56 + 32 /57 + 33 /58 + 33 /59 + 33 /60 + 33 /61 + 34 /62 + 34 /63 + 34 /64 + 35 /65 + 35 /66 + 35 /67 + 35 /68 + 35 /69 + 36 /70 + 36 /71 + 36 /72 + 36 /73 + 36 /74 + 36 /75 + 37 /76 + 37 /77 + 37 /78 + 37 /79 + 37 /80 + 37 /81 + 37 /82 + 37 /83 + 37 /84 + 37 /85 + 37 /86 + 37 /87 + 37 /88 + 37 /89 + + + +MULTI, 0 /THIS IS STANDARD SINGLE PRECISION + CLL /MULTIPLY ROUTINE WHICH WAS ONCE + SPA /USED. I'VE LEFT IT IN SINCE + CMA CML IAC /THERE IS LOTS OF CORE LEFT OVER AND + DCA MULMP1 /MAYBLE SOMEDAY I'LL NEED IT TO PUT + DCA MULMP5 /IN A SUN OR SOMETHING. THIS IS THE + TAD I MULTI /STANDARD DEC SUBROUTINE WITH DIFFERENT + SNA /LABELS + JMP MULPSN+2 + SPA + CMA CML IAC + DCA MULMP2 + TAD MULTHR + DCA MULMP3 + +MULMP4, TAD MULMP1 + RAR + DCA MULMP1 + TAD MULMP5 + SZL + TAD MULMP2 + CLL RAR + DCA MULMP5 + ISZ MULMP3 + JMP MULMP4 + TAD MULMP1 + RAR +MULPSN, SZL + JMP MULCMP + DCA MULMP1 + TAD MULMP5 +MULMPZ, ISZ MULTI + JMP I MULTI + +MULCMP, CMA CLL IAC + DCA MULMP1 + TAD MULMP5 + CMA + SZL + IAC + JMP MULMPZ + +MULTHR, 7764 +MULMP1, 0 +MULMP5, 0 +MULMP2, 0 +MULMP3, 0 + + +/ +/ SHIFTR DIVIDES THE AC BY TWO WHETHER POSITIVE OR NEGATIVE +/ AND IS CALLED FROM VARIOUS PLACES. NOT ENTIRELY MYSTERIOUS +/ + + +SHIFTR, 0 + CLL + SPA + CML IAC + RAR + JMP I SHIFTR + + +/ +/ POSCAL IS CALLED TO CALCULATE THE COORDINATE INCREMENTS +/ NECESSARY TO PRODUCE THE SHIP FIGURES. RATHER THAN DOING +/ A LOT OF EXPENSIVE MATH THIS DOES A QUICK PRODUCTION +/ OF 1, 2, AND 3 TIMES THE SIN AND COSINE VALUES FOUND +/ IN CALSIN AND CALCOS LEAVING THEM IN THE TABLE FOR +/ ONESET AND TWOSET. IF THE SCOPE WERE ANY BETTER +/ THIS PROBABLY WOULDN'T BE NEAR GOOD ENOUGH BUT.... +/ + +POSCAL, 0 + TAD CALSIN + + DCA T10SIN + TAD T10SIN + CLL RAL + DCA T20SIN + TAD T10SIN + TAD T20SIN + DCA T30SIN + + TAD CALCOS + + DCA T10COS + TAD T10COS + CLL RAL + DCA T20COS + TAD T10COS + TAD T20COS + DCA T30COS + JMP I POSCAL + +/**************************************************************** +/ VC8-E ROUTINES + + +VDIV, 0 + SMA / SKIP IF MINUS + JMP VPLUS +VMINUS, CMA IAC / COMPLEMENT + RTR / DIVIDE BY FOUR + AND P1777 / DELETE UPPER TWO BITS + CMA IAC + JMP I VDIV / RETURN + +VPLUS, RTR + AND P1777 + JMP I VDIV + +/***** + +VCLDX, 0 / INTENSIFY LAST POINT AND LOAD NEW X VALUE + JMS VDIV / DIVIDE BY FOUR + DISD / DISPLAY READY? + JMP .-1 / WAIT. + DIXY / INTENSIFY + DILX / LOAD NEW X VALUE + JMP I VCLDX / RETURN + +VCLDY, 0 + JMS VDIV / DIVIDE BY FOUR + DILY / LOAD NEW Y VALUE + JMP I VCLDY + +P1777, 1777 + + +/**************************************************************** + + + *7000 + +/GENERAL PURPOSE SYMBOL GENERATOR +/ +CHARS, 0 /ENTRY TO PLOT CHARACTER STRING + DCA ADDR /STORE STRING ADDRESS + TAD I ADDR /FETCH DOUBLE CHARACTER + RTR /SHIFT + RTR / FOR FIRST + RTR / CHARACTER + JMS CHAR /PLOT CHARACTER + SKP /NORMAL RETURN -- SKIP + JMP I CHARS /TERMINATION RETURN -- EXIT + TAD I ADDR /RECALL DOUBLE CHARACTER + ISZ ADDR /ADVANCE STRING ADDRESS + JMS CHAR /PLOT CHARACTER + JMP CHARS+2 /NORMAL RETURN -- REPEAT + JMP I CHARS /TERMINATION RETURN -- EXIT +/ +CHAR, 0 /ENTRY TO PLOT SINGLE CHARACTER + AND K77 /MASK OUT UPPER BITS + CLL RAL /MULTIPLY CODE BY TWO + TAD TABLE /ADD TABLE BASE ADDRESS + DCA POINT /CONSTRUCT POINTER TO 24-BIT CODE + CMA /INITIALIZE COUNTER FOR + DCA COUNT2 / TWO PLOT WORDS + TAD I POINT /FETCH FIRST PLOT WORD + ISZ POINT /INCREMENT POINTER FOR NEXT ONE + SNA /SKIP IF NOT SPECIAL CHARACTER + JMP SPCHAR /ELSE GO PROCESS IT + DCA CURPLT /SAVE CURRENT PLOT BITS +XPLOT, TAD KM6 /INITIALIZE 6-BIT + DCA COUNT6 / COUNTER + TAD YVALUE /RESET Y TEMPORARY + DCA YTEMP / VALUE FOR CHARACTER + TAD XVALUE /OUTPUT CURRENT + DILX /X-VALUE TO CRT + TAD XINCR /INCREMENT + DCA XVALUE / ABSCISSA +YPLOT, TAD CURPLT /RECALL CURRENT PLOT BITS + CLL RAL /GET NEXT BIT + DCA CURPLT /SAVE REMAINING PLOT BITS + SNL /SKIP IF POINT TO PLOT + JMP CNTINU /ELSE JUMP AHEAD + TAD YTEMP /OUTPUT CURRENT + DILY /Y-VALUE TO CRT + DISD / READY TO DISPLAY THE POINT? + JMP .-1 / NO, WE'LL WAIT. + DIXY / SHOOT THE BEAM! + + CLA CLL /CLEAR AC + TAD CURPLT /RECALL CURRENT PLOT BITS + SNA CLA /SKIP IF POINTS REMAINING + JMP WRDEND /ELSE WORD IS FINISHED +CNTINU, TAD YTEMP /INCREMENT TEMPORARY + TAD YINCR / Y-VALUE FOR NEXT + DCA YTEMP / CHARACTER STEP + ISZ COUNT6 /SKIP IF 6 BITS PLOTTED + JMP YPLOT /ELSE PLOT NEXT ONE + JMP XPLOT /GO UPDATE X-VALUE +WRDEND, ISZ COUNT2 /SKIP IF ANOTHER BIT WORD + JMP EXIT /ELSE EXIT + TAD I POINT /FETCH SECOND BIT WORD + SZA /SKIP IF NO PLOT POINTS + JMP XPLOT-1 /ELSE GO PLOT THEM +EXIT, TAD XVALUE /INCREMENT ABSCISSA + TAD XINCR / FOR SPACE BETWEEN + DCA XVALUE / SYMBOLS + JMP I CHAR /EXIT FROM CHAR +/ +SPCHAR, TAD I POINT /FETCH TRANSFER VECTOR + DCA POINT /STORE AS INDIRECT ADDRESS + JMP I POINT /GO TO APPROPRIATE ROUTINE +SPACE, TAD XINCR /FETCH BASIC ABSCISSA INCREMENT + CLL RTL /MULTIPLY BY FOUR AND + JMP EXIT / GO CREATE SPACE +CRLF, TAD INITX /"CARRIAGE RETURN" RESETS X + DCA XVALUE / TO ITS ORIGINAL VALUE +LF, TAD YINCR /"LINE FEED" + CLL RTL / DECREMENTS THE + CLL CIA RAL / Y-VALUE BY + TAD YVALUE / EIGHT SCALE + DCA YVALUE / STEPS + JMP I CHAR /EXIT FROM CHAR +RESET, TAD INITX /"RESET" RESETS + DCA XVALUE / X AND Y TO + TAD INITY / THEIR ORIGINAL + JMP RESET-2 / VALUES +TERM, ISZ CHAR /TERMINATE CODE CAUSES + JMP I CHAR / EXIT TO P+2 +/ +INITX, 0 /INITIAL X-VALUE +INITY, 327 /INITIAL Y-VALUE +XVALUE, 0 /CURRENT X-VALUE +YVALUE, 0 /CURRENT Y-VALUE +XINCR, 6 /BASIC X INCREMENT VALUE +YINCR, 10 /BASIC Y INCREMENT VALUE +YTEMP, 0 /TEMPORARY Y-VALUE +CURPLT, 0 /CURRENT PLOT BITS +ADDR, 0 /CURRENT STRING ADDRESS +COUNT6, 0 /6-BIT COUNTER +COUNT2, 0 /2-WORD COUNTER +KM6, -6 /CONSTANT FOR COUNT6 +K77, 77 /CHARACTER CODE MASK +POINT, 0 /TABLE POINTER +/ + +/ +TABLE, .+1 /TABLE BASE ADDRESS + 0 /SPECIAL CHARACTER (00) + TERM /TERMINATION CODE + 7611 / A + 1176 + 7745 / B + 4532 + 3641 / C + 4122 + 7741 / D + 4136 + 7745 / E + 4541 + 7705 / F + 501 + 7741 / G + 5173 + 7710 / H + 1077 + 4177 / I + 4100 + 2040 / J + 4037 + 7714 / K + 2241 + 7740 / L + 4040 + 7702 / M + 277 + 7706 / N + 3077 + 7741 / O + 4177 + 7705 / P + 502 + 3641 / Q + 6176 + 7715 / R + 2542 + 2245 / S + 5122 + 177 / T + 100 + 3740 / U + 4037 + 1720 / V + 4037 + 7730 / W + 3077 + 4136 / X + 3641 + 374 / Y + 7403 + 6151 / Z + 4543 + 7741 / [ + 0 + 204 / \ + 1020 + 4177 / ] + 0 + 436 / ^ + 400 + 0 /SPECIAL CHARACTER (37) + RESET /RESET + 0 /SPECIAL CHARACTER (40) + SPACE /SPACE + 5600 / ! + 0 + 303 / " + 0 + 1477 / # + 7714 + 2277 / MARKER + 2200 + 2313 / % + 6462 + 7777 / BLOCK + 7777 + 300 / ' + 0 + 3641 / ( + 0 + 4136 / ) + 0 + 4040 / UNDERSCORE (52) + 4040 + 1034 / + + 1000 + 0 /SPECIAL CHARACTER (54) + LF /LINE FEED + 1010 / - + 1000 + 4000 / . + 0 + 2010 / / + 402 + 3641 / 0 + 4136 + 4442 / 1 + 7740 + 4261 / 2 + 5146 + 2145 / 3 + 5321 + 1710 / 4 + 1077 + 4745 / 5 + 4531 + 7750 / 6 + 5070 + 6111 / 7 + 503 + 2255 / 8 + 5522 + 705 / 9 + 577 + 2400 / : + 0 + 0 /SPECIAL CHARACTER (73) + CRLF /CARRIAGE RETURN; LINE FEED + 1024 / > + 4200 + 1212 / = + 1200 + 4224 / < + 1000 + 255 / ? + 300 + + +/ +/ HERE FOLLOW THE PACKED ASCII TEXTS FOR THE VARIOUS +/ VICTORY MESSAGES. PERSONS ADVENTEROUS TO FIND THIS MIGH CARE +/ TO TOGGLE IN SOME CUTE LITTLE MESSAGES OF THEIR OWN. +/ + +MESS0, 3773 +MESS5, 7340 + 4040 + 4040 + 4000 + +MESS1, 1716 + 0500 + +MESS2, 2427 + 1700 + +MESS3, 2711 + 1623 + 4100 + +MESS4, 1617 + 0217 + 0431 + 0000 + + + *7400 + +DISBUF, 0 + +/ THE DISPLAY BUFFERS BEGIN HERE AND EXTEND UP SOMEWHERE TO +/ AROUND 7575 OR SO. +/ +/ +/ +/ +/ + + + + $ + +//////////////////////////// +/ +/ THIS IS THE END +/ +/////////////////////////// + + + + + + \ No newline at end of file diff --git a/sw/f4/FRTSRC/BUILD.BI b/sw/f4/FRTSRC/BUILD.BI new file mode 100644 index 0000000..148a20f --- /dev/null +++ b/sw/f4/FRTSRC/BUILD.BI @@ -0,0 +1,25 @@ +$JOB FORTRAN IV BUILD - INITIAL CLEANUP AND PREPARATION +/ ******************************************************************* +/ ******************************************************************* +/ ******************************************************************* +/ +/ INITIAL CLEANUP +/ +/ ******************************************************************* +/ ******************************************************************* +/ ******************************************************************* + +.DELETE *.RL +.DELETE *.BN +.DELETE *.LD +.DELETE SYS:FORTRN.* +.DELETE SYS:F4.SV,LOAD.SV,RALF.SV +.DELETE SYS:PASS2.SV,PASS20.SV,PASS3.SV +.DELETE SYS:FRTS.SV,FORLIB.RL +.SQUISH SYS:/O + +/ PUT MAIN BATCH FILE TO SYS: +.COPY SYS: + IFNSW 8 < + TAD% BUFADR /GET X DISPLACEMENT + DCAZ 17 /INTO ALPHA REG + ISZ BUFADR /INCREMENT ADDRESS + SKP CLA + JMS BUMPF /INCREMENT DATA FIELD + TAD% BUFADR /GET Y DISPLACEMENT + CIF 10 + LINC + DIS 17 + PDP + CLA + ISZ BUFADR /INCR BUFFER POINTER + SKP CLA + JMS BUMPF + > +ENDDL, ISZ NPTS /INCREMENT COUNTER + JMP DSPLUP /LOOP + CDF 10 + JMP% DISPLY /RETURN TO IDLE Q +BUMPF, 0 /FIELD CHANGER + TAD FLDDB /BUMP FIELD + TAD L10 + DCA FLDDB +FLDDB, HLT /CHANGE IT NOW + JMP% BUMPF +PUTONQ, 0 /PUT DISPLY ONTO BACKROUND Q + TAD BUFADR+1 /CREATE CDF FOR DISPLAY LOOP + AND L7 + CLL RAL + RTL + TAD FLD0 + DCA DBFLD + IFSW 8 < + 6050 /CLEAR DISPLAY LOGIC + > + CDF CIF + SKP + JMP% PUTONQ + DCA .-2 /ONCE ONLY + CIF CDF 10 + JMS% ONQBX+1 + ADDR DISPLY + CIF CDF + JMP% PUTONQ /CALLED VIA TRAP4 + EXTERN ONQB +ONQBX, ADDR ONQB +BUFADR, 0 + 0 +PLTXR, 0;0;0;-1;0;0 +FLD0, CDF +L7, 7 +L10, 10 +NPTS, 0 + SECT PLOT + JA #PLOT +NAME, TEXT +PLOT + +PLTBAS, 0;0;0 +XLO, +X, 0;0;0 +YLO, +Y, 0;0;0 +XHI, +N, 0;0;0 +YHI, 0;0;0 +ADRBUF, 0;0;0 + IFSW 8 < +YSCALE, F 1022. +YZERO, F 511. + ORG 10*3+PLTBAS + FNOP + JA NAME+3 + 0 +PLTRET, JA . +XSCALE, F 786. +XZERO, F 511. +RANGE, F 1022. +BASE, F 511.> + IFNSW 8 < +YSCALE, F 510. +YZERO, F 255. + ORG 10*3+PLTBAS + FNOP + JA NAME+3 + 0 +PLTRET, JA . +XSCALE, F 392. +XZERO, F 0. +RANGE, F 510. +BASE, F 255.> +L1P5, F 1.5 +XYPAIR, 0;0;0 +#PLOT, BASE PLTBAS + JSA SETUP + LDX 1,1 + FLDA% PLTBAS,1 /GET ARG ADDRESSES + FSTA N + FLDA% PLTBAS,1+ + FSTA X + FLDA% PLTBAS,1+ + FSTA Y + STARTF + FLDA% N /NUMBER OF POINTS TO PLOT + FNEG + ATX 1 /INTO XR 1 + LDX -1,2 /XR 2 IS THE INDEXER +PLTLUP, JXN PLOOP,3+ /ANY MORE ROOM IN PLOT BUFFER ? + LDX -1,3 /NO, FIX COUNT + JA PLTRET +PLOOP, FLDA% Y,2+ /GET Y VALUE + FMUL YSCALE /SCALE IT + FSUB YZERO /SUBTRACT LOWER LIMIT + ALN 0 + FSTA XYPAIR + FLDA% X,2 /GET X VALUE OF PAIR + FMUL XSCALE /SCALE IT + FSUB XZERO /SUBTRACT LOWER LIMIT + ALN 0 + STARTD + FSTA XYPAIR,0 /XYPAIR+1,+2 CONTAINS THE POINT + FLDA XYPAIR /STORE THIS DOUBLE WORD INTO PLOT BUFFER + FSTA% ADRBUF,4 + ADDX 1,4 /TROUBLE IS, WE WANT POST INCREMENT + STARTF + JXN PLTLUP,1+ /LOOP IF MORE POINTS + JA PLTRET + BASE 0 +SETUP, JA . + STARTD + FLDA 30 /GET RETURN ADDRESS + FSTA PLTRET + FLDA 0 /GET ARG POINTER + BASE PLTBAS + SETB PLTBAS + SETX PLTXR + FSTA PLTBAS + JA SETUP + SECT PLOTR + BASE PLTBAS + JSA SETUP + LDX 1,1 + FLDA% PLTBAS,1 /GET ARG ADDRESSES + FSTA N + FLDA% PLTBAS,1+ + FSTA X + FLDA% PLTBAS,1+ + FSTA Y + FLDA% PLTBAS,1+ + FSTA YHI + STARTF + FLDA% YHI + ATX 5 + FLDA% N /NUMBER OF POINTS TO PLOT + FNEG + ATX 1 /INTO XR 1 + LDX -1,2 /XR 2 IS THE INDEXER +PLOTRL, FLDA% Y,2+ /GET Y VALUE + FMUL YSCALE /SCALE IT + FSUB YZERO /SUBTRACT LOWER LIMIT + ALN 0 + FSTA XYPAIR + FLDA% X,2 /GET X VALUE OF PAIR + FMUL XSCALE /SCALE IT + FSUB XZERO /SUBTRACT LOWER LIMIT + ALN 0 + STARTD + FSTA XYPAIR,0 /XYPAIR+1,+2 CONTAINS THE POINT + FLDA XYPAIR /STORE THIS DOUBLE WORD INTO PLOT BUFFER + FSTA% ADRBUF,5 + ADDX 1,5 /TROUBLE IS, WE WANT POST INCREMENT + STARTF + JXN PLOTRL,1+ /LOOP IF MORE POINTS + JA PLTRET + SECT CLRPLT + BASE PLTBAS + JSA SETUP + LDX 0,4 /DISABLE DISPLAY LOOP + LDX 1,1 + FLDA% PLTBAS,1 /GET ARG POINTERS + FSTA N + FLDA% PLTBAS,1+ + FSTA ADRBUF + FSTA BUFADR+1 + STARTF + FLDA% N /SIZE OF BUFFER + FMUL L1P5 /NUMBER OF 2 WORD PAIRS + FNEG + ATX 3 /INTO SOME CHOICE XRS + TRAP4 PUTONQ /PUTISPLY ONTO IDLE Q +CLRRET, JA PLTRET + SECT SCALE /SET SCALING FACTORS + BASE PLTBAS + JSA SETUP + LDX 1,1 + FLDA% PLTBAS,1 /GET ARGS + FSTA XLO + FLDA% PLTBAS,1+ + FSTA YLO + FLDA% PLTBAS,1+ + FSTA XHI + FLDA% PLTBAS,1+ + FSTA YHI + STARTF + FLDA% XHI /COMPUTE X RANGE + FSUB% XLO + FSTA XHI + FLDA% YHI /NOW Y RANGE + FSUB% YLO + FSTA YHI + FLDA RANGE /COMPUTE XSCALE + FDIV XHI + FSTA XSCALE + FLDA RANGE /NOW Y SCALE + FDIV YHI + FSTA YSCALE + FLDA% XLO /COMPUTE XZERO + FMUL RANGE + FDIV XHI + IFSW 8 < + FADD BASE> + FSTA XZERO + FLDA% YLO /NOW YZERO + FMUL RANGE + FDIV YHI + FADD BASE + FSTA YZERO +SCLRET, JA PLTRET + END + diff --git a/sw/f4/FRTSRC/RALF.PA b/sw/f4/FRTSRC/RALF.PA new file mode 100644 index 0000000..5b3d399 --- /dev/null +++ b/sw/f4/FRTSRC/RALF.PA @@ -0,0 +1,4454 @@ +/ RALF, V62A +/ +/ +/ +/ +/ +/ +/ +// +/ +/ +/ +/ +/COPYRIGHT (C) 1974, 1975, 1977 +/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. +/ +/ +/ +/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A +/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- +/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER +/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE +/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO +/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE +/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. +/ +/ +/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT +/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL +/EQUIPMRNT COROPATION. +/ +/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS +/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. +/ +/ +/ +/ +/ +/ + / RELOCATABLE ASSEMBLER FOR OS/8 FORTRAN IV +/ +/ +/ FPPASM BY HANK MAURER +/ RALF MODS BY JUD LEONARD +/ OS/8 FORTRAN MODS BY RICHIE LARY + MARTY HURLEY +/ NEW DATE ALGORITHUM PUT IN BY ED STEINBERGER +/ +/ THE FOLLOWING FORMULA GIVES THE NUM +/ OF USER SYMBOLS: +/ -(FREE+200[BASE8])/6[BASE10] +/ WHERE THE VALUE OF FREE IS FROM THE +/ RALF SYMBOL MAP +/ +/ +IFNDEF RALF +/ +/ ASSEMBLE WITH PAL8-V9 WITH W SWITCH +/ SAVE AS: +/ .SAVE SYS RALF.SV ;200=2000 + +/ +/ CHANGES FOR OS/78 AND OS/8 V3D BY P.T. +/ .CHANGED VERSION NUMBER TO 62 +/ .RALF NO LONGER GENERATES FAULTY RELOCATABLE IF: +/ 1.) THE ESD IS LONGER THAN ONE BLOCK, AND +/ 2.)LIST OUTPUT IS DIRECTED TO A 2-PAGE NON-SYSTEM HANDLER +/ +/ + FLD0=0 + FLD1=10 + VNUM=62 + PATCH="A /PATCH LEVEL A + *3 +VERS, VNUM /VERSION NUMBER +OLDN3, 0 /TEMP FOR LOOKUP +OTEMP, 0 /A COUPLE OF TEMPS THAT +OCNT, 0 /DIDNT FIT INTO THEIR PAGE + 0 +X10, 0 +X11, 0 +X12, 0 +X13, 0 +X14, 0 +OUTPTR, OUBUF-1 +NEXT, FREE-1 +CHRPTR, LINE-1 +NCHARS, -1 /CHARACTER INPUT STUFF +CPTMP, 0 +NCTMP, 0 /USED TO SAVE CHAR POSITION +LINSIZ, 0 /SIZE OF LINE FOR PRINTING +STYPE, /SYMBOL TYPE CODE +CHKSUM, 0 /FOR BINARY OUTPUT + IFZERO RALF < +LOCTR1, 0 /INITIAL LOCN CNTR FOR ABSOLUTE ASM +LOCTR2, 200 > + IFNZRO RALF < +ESDNO, 2 /LAST ESD #. (#MAIN & BLANK COMMON DEFAULT) +LOCTR1, 20 /HIGH LOCN CNTR WITH ESD (STARTS IN #MAIN) +LOCTR2, 0 +DPFLG, 0 > + BASER, 4000 /BASE REGISTER SETTING + 0 +INDXR, 0 /INDEX LOCS: MUST FOLLOW BASER + 0 +EXPVAL, 0 /EXPRESSION VALUE + 0 + 0 +EXPDEF, 0 /=0 IF EXPR IS UNDEFINED +EXPSW, 0 /FLAG=1 IF NO EXPR +WORD1, 0 /TEMPORARY 2 WORD OPERAND +WORD2, 0 +FPPADR, 0 /ADDRESS FIELD FOR FPP INDEX INSTR + 0 +OPCODE, 0 /OPCODE OR PSEUDO-OP POINTER +XFLAG, 0 /INDEX FLAG = 1 IF INDEX PRESENT +XINCR, 1 /FLAG = 0 IF + LEGAL IN INDEX EXPR +BUCKET, 0 /FIRST CHAR OF NAME +NAME1, 0 /CHARS 2 AND 3 OF NAME +NAME2, 0 /CHARS 4 AND 5 OF NAME +NAME3, 0 /CHAR 6 OF NAME AND TYPE +LASTOP, 0 /LAST OPERATOR ENCOUNTERRED IN EXPR +PASSNO, -1 /PASS NUMBER +ASMOF, 0 /SET NEGATIVE WHEN ASSEMBLY OFF +PNCHOF, 0 /NON-ZERO TO SUPPRESS BINARY OUTPUT +LISTSW, 1 /LIST SWITCH (1 ENABLES LISTING) +OUTSWT, 0 /OUT SWITCH, =1 IF LINE ALREADY LISTED +REPCNT, 0 /REPEAT COUNTER +SCSWT, 0 /SEMICOLON SWITCH +RADIX, 0 /RADIX FOR INTEGERS (0 IS OCTAL) +LTEMP, -177 /TEMP USED BY LOOKUP +EXTMP, 0 /TEMPS USED BY EXPR AND OTHERS +EXTMP2, 0 +EQUN, 0;0;0;0 /NAME ON LEFT OF EQUAL SIGN + /NEXT TWO LOCS USED WITH EQUN BY DMPESD +FPPSWT, 0 /1 WHHEN FINDING FPP ADR EXPR +FPP2WD, 0 /SET BY EXPR TO FORCE 2 WD FMT +FPPWD2, 0 /SET BY FPP2WD.OR.EXPTYP.EQ.0 +LITRL, 0 /SET = 1 FOR LITERAL +P0LIT, 177 +CPLIT, 177 +PAGEN, 0 +ERRORS, 0 /ERROR COUNT +PC, TTYOUT /OUTPUT ROUTINE +OUFILE, 7573 /OUTPUT FILE LIST POINTER +BFILE, 1 + LPAGE1, 1 /INPUT FORMFEED COUNT +LPAGE2, 0 /OUTPUT PAGE WITH RESPECT TO ABOVE +LINPAG, -1 /LINES/PAGE COUNTER +LINKSW, 0 /1 IF LINK GENERATED ON THIS LINE +LINKS, /NO OF LINKS GENERATED +ABREFS, 0 /NO OF ABSOLUTE REFERENCES +ABSOP, 0 /POINTER-SWITCH FOR BINARY OUTPUT +USR, 200 /CURRENT CALL ADDRESS FOR USR +SYONLY, 0 /=0=LIST ONLY SMAP WHEN LIST FILE + /IS SPECIFIED. ITS SET VIA SLASH S + /=1=REGULAR +NP17, 17 /** +NP7700, 7700 +OPX, 0 +OP, ZBLOCK 6 +ACX, 0 +AC, ZBLOCK 6 +M3, -3 +BLINE, LINE-1 +/ + PAGE + / +/ CORE ALLOCATION IN HIGH FIELD 0 +/ + CPLBUF=5100 /ACTUALLY AT 5200 + P0LBUF=5200 /AND 5300, 1/2 PAGE EACH + IFZERO RALF < + INBUF=5400 > + IFNZRO RALF < + INBUF=6000 /AFTER PASS 1, MOVES TO 5400> + OUBUF=6400 + LINE=7000 /CURRENT INPUT LINE IN ASCII + INDEVH=7200 /TENTATIVE INPUT DEVICE HANDLR ADDR + OUDEVH=7400 /TENTATIVE OUTPUT HANDLER ADDR + INRECS=2 + INCTL=400 + OUCTL=4200 +/ +/ COLLECT THE NEXT STATEMENT +/ + ISZ .+2 +REPLEN, JMP I .+1 +REPLST, BEGIN /START AT 6000 IF CHAINED ELSE 6001 +NEXTST, CDF FLD0 /JUST PRECAUTION + TAD OUTSWT /IF NO OUTPUT FROM THIS LINE, + SNA CLA + TAD PASSNO /AND LISTING PASS + SMA SZA CLA + TAD LISTSW /AND LISTING ENABLED + SNA CLA /PRINT THIS LINE NOW + JMP START /ELSE GET NEXT + JMS I [CRLF /PRINT CR/LF + TAD (-6 + DCA LTEMP /SPACE OVER + JMS I [PRINT2 /12 SPACES + ISZ LTEMP + JMP .-2 + JMS I (PRNTLN /THEN PRINT LINE +START, JMS I [GETCHR /ANY MORE CHARS ? + JMP NOTEG + JMS I [ERMSG /EXTRA GARBAGE ON LAST LINE + 0507 /*EG* +NOTEG, TAD SCSWT /DID LAST LINE END WITH SEMICOLON ? + SNA CLA + JMP .+5 /NO + DCA SCSWT /KILL SC SWITCH + ISZ CHRPTR /SKIP OVER SEMICOLON + ISZ NCHARS + JMP ASMBL /DON'T READ A NEW LINE + TAD REPCNT /IS THIS LINE TO BE REPEATED? + SPA CLA + JMP AGAIN /DO IT +NEWLIN, TAD BLINE /RESET POINTER + DCA CHRPTR + TAD [-200 /LIMIT LINE SIZE + DCA MAXLIN + DCA OUTSWT /CLEAR OUTPUT SWITCH + RDLOOP, JMS I (ICHAR /READ A CHAR + TAD (-212 + SNA + JMP RDLOOP /IGNORE LINE FEEDS + TAD (212-215 /END ON CR + SNA + JMP ENDLIN + IAC + SNA /FORM FEED? + JMP FORMFD + TAD (214 /FIX CHAR + DCA I CHRPTR /SAVE IT + ISZ MAXLIN /TEST FOR LINE TOO LONG + JMP RDLOOP /PUT CHAR AWAY AND GET NEXT 1 + JMS I (ICHAR /IGNORE ANOTHER CHAR + TAD (-215 /UNLESS CR + SZA CLA + JMP .-3 + JMS I [ERMSG /EXCESS LENGTH LINE + 1424 /*LT* +ENDLIN, TAD CHRPTR /FIND - NUMBER OF CHARS - 1 + CMA + TAD BLINE + DCA NCHARS + TAD REPCNT /0 BECOMES 0, + CIA /BUT POS REP COUNT + DCA REPCNT /ENABLES REPEAT + TAD NCHARS /SAVE LENGTH + DCA REPLEN + TAD LISTSW /SAVE LISTING SWITCH DURING REPEAT + DCA REPLST +REASM, TAD NCHARS /SAVE SIZE OF LINE FOR PRINT + DCA LINSIZ + TAD BLINE + DCA CHRPTR /SET POINTER +ASMBL, TAD ASMOF /ARE WE INSIDE A CONDITIONAL + SZA CLA + JMP OFFIT /YES, AND THE COND WAS FALSE + JMS I [GETCHR /LOOK FOR A CHARACTER + JMP NEXTST + TAD (-257 /IS IT SLASH ? + SNA + JMP NOASM /YES, COOL IT + TAD [257-240 /IS IT BLANK OR TAB ? + SZA CLA /YES, IGNORE + JMS I [BACK1 /NO, PUT IT BACK + JMP I (LUNAME /ASSEMBLE STMT + FORMFD, ISZ LPAGE1 /BUMP FORM FEED COUNT + DCA LPAGE2 /CLEAR SUB-PAGE COUNT + CLA CMA + DCA LINPAG /FORCE EJECT ON CRLF + JMP RDLOOP +OPENIT, CLA CMA /DECR COUNT, ANOTHER OPEN ANGLE + TAD ASMOF + DCA ASMOF +OFFIT, ISZ NCHARS /MORE TO GO? + JMP GETIT /YES +NOASM, CLA CMA + DCA NCHARS /DONT ASSEMBLE THIS LINE + JMP NEXTST /(PREVENTING *EG* MESSAGE) +GETIT, TAD I CHRPTR /PICK UP THE CHARACTER + TAD (-274 /OPEN ANGLE BRACKET? + SNA + JMP OPENIT /YES, PUSH ONE LEVEL DOWN + CLL RTR + SNA CLA + ISZ ASMOF /IF CLOSE, CHECK LEVEL + JMP OFFIT /TRY FOR NEXT + JMP ASMBL /RESUME WORK +AGAIN, TAD REPLEN /WE NOW REPEAT THE SAME LINE + DCA NCHARS + DCA LISTSW /NO LISTING DURRING REPEAT + ISZ REPCNT + JMP REASM /ASSUMING COUNT STILL OK + TAD REPLST /RESTORE LISTING + DCA LISTSW + JMP NEWLIN /GET NEXT LINE + MAXLIN=LTEMP +/ +TXERR, TEXT " ERRORS" +TXELN= .-TXERR + PAGE + / +/ DIVIDE AC BY 3 +/ USEFUL IN FPP REFERENCES TO BASE +/ +OVER3, 0 /DIVIDE AC BY THREE + DCA EXTMP2 /MQ + TAD (-15 /SET SHIFT COUNT + DCA LTEMP +DIVLUP, CLL /ZERO LINK + TAD (-3 /SUBTRACT DIVISOR FROM AC + SZL /IF AC>=3 SET LINK TO 1 + JMP .+3 /OK, DONT RESTORE + TAD (3 /TOO SMALL, RESTORE AC + CLL /SET LINK BACK TO 0 + DCA EXTMP /SAVE AC + TAD EXTMP2 /ROTATE MQ-AC LEFT, PUT LINK IN MQ + RAL + DCA EXTMP2 /SAVE MQ + TAD EXTMP /GET BACK AC + RAL /COMPLETE SHIFT + ISZ LTEMP /TEST COUNT + JMP DIVLUP /KEEP GOING + DCA EXTMP /THIS IS REMAINDER + TAD EXTMP2 /RETURN QUOTIENT + JMP I OVER3 +/ +/ INITIALIZE FOR OUTPUT +/ +OUSETP, 0 + TAD (OUCTL&3700 /BUFFER SIZE IN DBL WORDS + CIA /NEGATE IT (PAL10 BLOWS) + DCA OUDWCT + TAD NOUBUF + DCA OUPTR /INITIALIZE WORD POINTER + TAD OUJMPE + DCA OUJMP /INITIALIZE 3-WAY CHARACTER SWITCH + JMP I OUSETP +NOUBUF, OUBUF +/ +/ STORE CHARACTERS IN OUTPUT BUFFER +/ IN PS8 FORMAT (YOU KNOW, 3 CHARS +/ IN 2 WORDS THE WRONG WAY) +/ +OCHAR, 0 + AND (377 + DCA OUTEMP + TAD OUTINH + SZA CLA /IS THERE AN OUTPUT FILE? + JMP I OCHAR /NO - EXIT + CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD + ISZ OUJMP /BUMP THE CHARACTER SWITCH +OUJMP, HLT /THREE WAY CHARACTER SWITCH + JMP OCHAR1 + JMP OCHAR2 + TAD OUTEMP + CLL RTL + RTL + AND (7400 + TAD I OUPOLD + DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH + /ORDER 4 BITS OF THIRD CHAR + TAD OUTEMP + CLL RTR + RTR + RAR + AND (7400 + TAD I OUPTR + DCA I OUPTR /UPDATE 2ND WORD FROM LO 4 BITS + TAD OUJMPE + DCA OUJMP /RESET SWITCH + ISZ OUPTR + ISZ OUDWCT /BUMP COUNTER EVERY 3 CHARS + JMP OUCOMN + TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE + JMS I (OUTDMP /DUMP THE BUFFER + JMS OUSETP /RE-INITIALIZE THE POINTERS + JMP OUCOMN +OCHAR2, TAD OUPTR + DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO + ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD +OCHAR1, TAD OUTEMP + DCA I OUPTR +OUCOMN, CDF + JMP I OCHAR +OUTEMP, 0 +OUPOLD, 0 +OUPTR, 0 +OUJMPE, JMP OUJMP +OUDWCT, 0 +OUTINH, 0 +/ +/ MOVE OUTPUT FILE NAME TO FIELD 0 +/ +OFNAME, 0 + TAD OUFILE + DCA X10 + TAD (OUFNAM-1 + DCA X11 + TAD (-4 + DCA LTEMP + CDF 10 + TAD I X10 + CDF 0 + DCA I X11 + ISZ LTEMP + JMP .-5 + JMP I OFNAME + / +/ GET OUTPUT DEVICE CHARISTICS +/ +OTYPE, 0 + CDF 10 + TAD I (7600 + AND [17 + TAD (DCB-1 + DCA OTYPP + TAD I OTYPP + CDF 0 + JMP I OTYPE +OTYPP= OFNAME +/ +/ BASIC TITLE INFO +/ +TITBUF, + IFZERO RALF < + TEXT "FLAP V" > + IFNZRO RALF < + TEXT "RALF V" > +*.-1 +VMTXT, 0;0;0 +TITDAT, ZBLOCK 6 + TEXT " PAGE" +TITLEN= .-TITBUF + PAGE + / +/ PROCESS A STATEMENT +/ +LUNAME, TAD CHRPTR /SAVE CHAR STUFF + DCA CPTMP + TAD NCHARS + DCA NCTMP + DCA LINKSW /CLEAR SWITCH + JMS I [GETNAM /LOOK FOR NAME + IFZERO RALF < + JMP I (TRYSTR /COULD BE AN ORG> + IFNZRO RALF < + JMP I (GETEXP /NOT ONE OF OURS, I GUESS> + JMS I [GETCHR /LOOK FOR COMMA + JMP JSTONE /ITS JUST ONE SYMBOL + TAD (-254 /COMMA TEST + SZA + JMP TRYEQU /NO COMMA, CHECK FOR EQUAL + JMS I [LOOKUP /LOOK UP SYMBOL + JMP DEFLBL /ITS UNDEFINED + CLL RAR /VERIFY ADDR TYPE + SZA CLA + JMP MDERR /THAT'S A NO-NO + TAD I X10 /CHECK LOCCTR AGAINST OLD DEFINITION + CIA + TAD LOCTR1 /FIRST UPPERR HALF + SZA CLA + JMP .+6 + TAD I X10 + CIA + TAD LOCTR2 /THEN LOWER HALF + SNA CLA + JMP DEFIND +MDERR, JMS I [ERMSG /MULTIPLY DEFINED + 1504 /*MD* + JMP I (ASMBL /FIELD IS OK +DEFLBL, ISZ I LTEMP /SET TYPE TO 1 (USER ADDR) + TAD LOCTR1 /PUT LOCATION COUNTER + DCA I X10 /INTO VALUE + TAD LOCTR2 + DCA I X10 +DEFIND, CDF FLD0 /GO LOOK FOR ANOTHER TAG + JMP I (ASMBL + TRYEQU, TAD (-21 /CHECK FOR EQUAL SIGN + SZA + JMP TRYBLK /NO, TRY BLANK + TAD NAME1 + DCA EQUN /SAVE 6 CHARACTER NAME + TAD NAME2 + DCA EQUN+1 + TAD NAME3 + DCA EQUN+2 + TAD BUCKET + DCA EQUN+3 + JMS I [GETCHR /ALLOW BLANK AFTER = + JMP EQUERR + TAD [-240 + SZA CLA + JMS I [BACK1 /ANYTHING ELSE GOES BACK + JMS I [EXPR /GET VALUE RIGHT OF EQUALS + JMP EQUERR /BAD EQU + TAD EQUN /RESTORE NAME + DCA NAME1 + TAD EQUN+1 + DCA NAME2 + TAD EQUN+2 + DCA NAME3 + TAD EQUN+3 + DCA BUCKET + JMS I [LOOKUP /LOOKUP SYMBOL + JMP PUTVAL /A NEW SYMBOL + CLL RAR + SZA CLA + JMP EQUERR /TYPE CONFLICT +PUTVAL, TAD EXPVAL+1 /SAVE ADDRESS TYPE + DCA I X10 + TAD EXPVAL+2 + DCA I X10 + TAD I LTEMP /NOW GET TYPE WORD + AND (7740 /ZERO OLD TYPE, PRESERVING FORCE BIT + TAD EXPDEF /DEFINED BY RIGHT HAND SIDE + DCA I LTEMP /RESTORE WORD + CDF FLD0 + JMP I [NEXTST /GO GET NEXT STMT +EQUERR, JMS I [ERMSG /BAD EQU + 0205 /*BE* + JMP I [NEXTST + TRYBLK, TAD (35 /CHECK FOR BLANK + SNA /MATCH BLANK? + JMP JSTONE /YES + AND [77 + JMS I [R6L + DCA NAME3 /MAKE MODIFIED NAME OF IT + JMS I [GETCHR /MODIFIER MUST BE FOLLOWED BY BLANK + JMP I (GETEXP /LOOKS BAD + TAD [-240 /GOT IT? + SZA CLA + JMP I (GETEXP /LET EXPR TELL HIM IF ITS WRONG +JSTONE, TAD (33 /USE OUR INTERNAL SYMBOL TABLE + JMS I [FIND /IS IT THERE? + JMP I (GETEXP /NO, LOOK IN USER'S + TAD OPCTBL /CREATE JUMP THRU TABLE + DCA OPCJMP /SAVE IT + TAD I X10 /PICK UP FIRST WORD OF VALUE + DCA OPCODE /ITS AN OPCODE-MAYBE? + CDF FLD0 +OPCJMP, 0 /JUMP SOMEWHERE +OPCTBL, JMP I .-4 + PSEUDO /PSEUDO OPS + PDP8MR /PDP8 MRI + FPPMR /FPPMR + FPPS1 /OTHER FPP OPCODES + FPPS2 + FPPS3 + FPPS4 + FPPS5 + FPMRI /INDIRECT FPP MEM REF + FPMRS /SHORT DIRECT MEM REF + FPMRL /LONG DIRECT REF + PDPOPR /8-MODE OPERATES +REPETX, JMS I (ADRGET /EVALUATE REPEAT EXPR + CLL CMA RAR /3777 + AND EXPVAL+2 + DCA REPCNT + JMP I [NEXTST + PAGE + / +GETEXP, CDF FLD0 + TAD CPTMP /RESTORE CHARACTER POINTER + DCA CHRPTR + TAD NCTMP /TO JUST AFTER TAG (IF ANY) + DCA NCHARS +SX, DCA OPCODE + JMS I [EXPR /TRY FOR AN EXPRESSION + JMP BADEXP /IF NONE, ERROR + IFNZRO RALF < + JMS RELERR /BOMB IF NOT ABSOLUTE EXP> + TAD EXPVAL+2 + JMS I [OUTWRD + JMP I [NEXTST /GO DO NEXT STMT + IFNZRO RALF +/ +FPPMR, ISZ FPPSWT /SET FORCE ENABLE + JMS FPADR + TAD WORD1 /IF WAY OFF BASE, + SNA + TAD FPPWD2 /OR IF FORCED + SNA + TAD XFLAG /OR IF INDEXED + SZA CLA + JMP FORMT1 /USE LONG FORM + TAD WORD2 + CLL + TAD (-600 /COMPLETE OFF-BASE CHECK + SZL CLA + JMP FORMT1 /USE LONG + JMP FORMT2 +FPPS2, JMS I (GETADR /COLLECT ADDRESS EXPR + JMS IXMES /BUT DISALLOW INDEX + JMP F2WD /PUT TWO WORDS OUT +/ +IXMES, 0 + TAD XFLAG /NO INDEX ALLOWED + SNA CLA + JMP I IXMES /HE'S COOL + JMS I [ERMSG + 1130 /*IX* + JMP I IXMES + FPMRL, JMS FPADR +FORMT1, JMS I (FIXOPC +F2WD, TAD FPPADR + AND [7 /FIELD BITS + TAD OPCODE /IN FIRST WORD +FPDMP, IFZERO RALF < + JMS I [OUTWRD + TAD FPPADR+1 /LOW ADDRESS + JMS I [OUTWRD + JMP I [NEXTST /NEXT!> + IFNZRO RALF < + JMP I (OUTREL /DUMP TWO RELOCATABLE> +FPMRS, JMS FPADR /COLLECT OPERAND + JMS IXMES /ERROR IF INDEX GIVEN + TAD WORD1 + SZA CLA + JMP BADEXP + TAD WORD2 + CLL + TAD (-600 /DOES IT FIT? + SNL CLA + JMP FORMT2 +BADEXP, JMS I [ERMSG + 0230 /*BX* + TAD OPCODE /BEST GUESS OF THE DESIRED OUTPUT + JMS I [OUTWRD + JMP I [NEXTST +FPMRI, JMS FPADR + TAD WORD1 + SZA CLA + JMP BADEXP /NOT EVEN CLOSE + TAD WORD2 + CLL + TAD (-30 + SZL CLA + JMP BADEXP /GOTTA BE IN THE FIRST 10 +FORMT3, JMS I (FIXOPC +FORMT2, TAD WORD2 + JMS I (OVER3 /BY 3 FOR BASE ADDRESS + TAD [200 +FPPS3, TAD OPCODE + JMS I [OUTWRD /WHEW! + JMP I [NEXTST +FPPS1, JMS I (GETADR /GET ADDR, AND INDEX + JMS I (FIXOPC /PUT OPCODE TOGETHER + TAD FPPADR /GET ADDR EXTENSION + AND [7 + TAD OPCODE /WITH TOGETHER OPCODE + AND (7377 /WITHDRAW ONE BIT + JMP FPDMP /PUT IT OUT + FPPS5, CLA IAC /DISALLOW INDEX INCR + JMS I (GETADR /COLLECT ADDRESS AND INDEX + IFNZRO RALF < + TAD FPPADR + AND [7770 /MUST BE ABSOLUTE + SNA CLA + JMP .+3 /OK + JMS I [ERMSG + 2205 /*RE*> + TAD XFLAG + SZA CLA /ANY INDEX? + TAD EXPVAL+2 + AND [7 /STRIP OFF ESD BITS + TAD OPCODE + JMS I [OUTWRD /DUMP THAT + TAD FPPADR+1 + JMS I [OUTWRD /NOW LOW 12 BITS + JMP I [NEXTST +/ +FPADR, 0 + JMS I (GETADR /COLLECT ADDRESS AND INDEX + TAD BASER+1 + CIA STL + TAD FPPADR+1 + DCA WORD2 /GET ADDRESS RELATIVE TO BASE + RAL + TAD BASER + CIA + TAD FPPADR + DCA WORD1 + JMP I FPADR + PAGE + / +PSEUDO, JMP I OPCODE /DISPATCH TO APPROPRIATE HNDLR +/ + IFZERO RALF < +/ +/ ASSEMBLE VARIOUS INSTRUCTION TYPES +/ +PDP8MR, TAD CHRPTR /SAVE POSITION + DCA CPTMP + TAD NCHARS + DCA NCTMP /SAVE COUNT + JMS I [GETCHR /LOOK FOR SPACE "I" + JMP GETMR /WILL GIVE BX ERROR + TAD (-"I /IS IT I? + SNA CLA /IF NOT, FORGET IT + JMS I [GETCHR /MUST BE FOLLOWED BY SPACE + JMP NOTIND + TAD [-240 + SZA CLA + JMP NOTIND /SOMETHING ELSE + TAD OPCODE /PUT INDIRECT INTO OPCODE + TAD (400 + DCA OPCODE +GETMR, JMS ADRGET /PICK UP ADDRESS FIELD + TAD EXPVAL+2 /CHECK PAGE OF ADDRESS + AND [7600 + SNA + JMP PAGEZ /ITS IN PAGE 0 + CIA + TAD LOCTR2 /COMPARE WITH CURRENT PAGE + AND [7600 + SNA CLA + JMP THSPAG /OK, ITS THIS PAGE + TAD OPCODE /CAN WE USE A LINK ? + AND (400 /IS INDIRECT BIT OFF ? + SNA CLA + JMP I (MAKLNK /YES, GO MAKE LINK + JMS I [ERMSG /NOPE, ITS AN ILLEGAL REFERENCE + 1122 /*IR* +THSPAG, TAD EXPVAL+2 /GET ADDRESS + AND [177 /LOWER 7 BITS + TAD [200 /PUT IN PAGE BIT + SKP +PAGEZ, TAD EXPVAL+2 /GET ADDRESS (UPPER 5 BITS ZERO) + TAD OPCODE /PLUS OPCODE + JMS I [OUTWRD /OUTPUT WORD + JMP I [NEXTST +NOTIND, TAD CPTMP /RESTORE CHAR POINTER + DCA CHRPTR + TAD NCTMP + DCA NCHARS + JMP GETMR /NOT AN INDIRECT> + FPPS4, JMS ADRGET /GET INDEX REG EXPRESSION + IFZERO RALF < + JMS LITERR /CAN'T ALLOW LITERAL> + JMS SUBX /GET RELATIVE INDEX VALUE + TAD EXPVAL+2 /GET LOWER 3 BITS + AND [7 /OF INDEX REG EXPR + TAD OPCODE /WITH OPCODE + JMS I [OUTWRD /OUT + JMP I [NEXTST +ADRGET, 0 /GET ADDRESS EXPR AND CHECK TYPE + JMS I [EXPR /GET EXPR + JMS I [ERMSG /BAD ADDR EXPR + 0230 /*BX* + JMP I ADRGET + IFZERO RALF < +LITERR, 0 /GIVE ERROR IF LITERAL + TAD LITRL + SNA CLA + JMP I LITERR + JMS I [ERMSG + 1114 /*IL* + JMP I LITERR > + IFNZRO RALF < +PDP8MR, JMS ADRGET + JMP I (CHCKMR /V.56 + > + GETADR, 0 /GET ADDR, INDEX + DCA XITEMP /SAVE INDEX INCREMENT SWITCH + JMS ADRGET /GET ADDR + DCA FPPSWT /KILL FPP SWITCH + IFZERO RALF < + JMS LITERR /DISALLOW LITERALS> + TAD EXPDEF /IF EXPR WAS UNDEFINED + SNA CLA + IAC /OR FORCE BIT WAS SET + TAD FPP2WD + DCA FPPWD2 /FORCE 2 WORD FORMAT + DCA XFLAG /ZERO INDEX SWT + TAD EXPVAL+1 /SAVE ADDRESS VALUE + DCA FPPADR + TAD EXPVAL+2 + DCA FPPADR+1 + JMS I [GETCHR /LOOK FOR COMMA + JMP I GETADR /NO INDEX + TAD (-254 + SZA CLA + JMS I [BACK1 /WILL CAUSE A BX ERROR + ISZ XFLAG /SET INDEX SWITCH + TAD XITEMP /SET INDEX INCREMENT SWITCH + DCA XINCR + JMS ADRGET + ISZ XINCR /CLEAR INDEX INCREMENT SWITCH + IFZERO RALF < + JMS LITERR > + JMS SUBX /CALCULATE INDEX NO + JMP I GETADR +XITEMP, +SUBX, 0 + TAD INDXR+1 /CHECK FOR INDEX IN RANGE + STL CIA + TAD EXPVAL+2 + DCA EXPVAL+2 + RAL + TAD INDXR + CIA + TAD EXPVAL+1 + SZA CLA + JMP BIERR + TAD EXPVAL+2 + CLL + TAD [-10 + SZL CLA +BIERR, JMS I [ERMSG + 0211 /*BI* + JMP I SUBX + IFNZRO RALF < +/ +/ AT END OF PASS, +/ CLEAR LENGTHS OF ALL SECTIONS +/ +CLRSCT, 0 + TAD (PNDL+3 + DCA LTEMP /POINT TO USER SYMBOL SPACE + CDF FLD1 +CSLOOP, TAD I LTEMP /GET TYPE + AND [37 /STRIP TO TYPE ONLY + TAD (-3 + SPA CLA /IS IT COMMON OR SECTION? + JMP NOTSCT /NO, PASS IT + ISZ LTEMP /BUMP POINTER TO VALUE + TAD I LTEMP + AND [7770 /SAVE ESD NUMBER + DCA I LTEMP + ISZ LTEMP + DCA I LTEMP /CLEAR LOW ORDER + CLA CLL CMA RAL /-2 +NOTSCT, TAD (6 /BUMP POINTER + TAD LTEMP /TO NEXT SYMBOL + DCA LTEMP + TAD NEXT /COMPARE END OF SYMBOL TABLE + CIA CLL + TAD LTEMP + SNL CLA + JMP CSLOOP /MORE TO GO + CDF FLD0 + JMP I CLRSCT /THAS ALL> +/ +/ + IFNZRO RALF < +/ +/ ENSURE BOTH SYMBOL AND SUB-EXPR ARE ABSOLUTE +/ +NOREL, 0 + TAD WORD1 /IS SYMBOL RELOCATABLE? + AND [7770 /TEST ESD BITS + SZA CLA + STL RAR /IF SO, FORCE ERROR + JMS I (RELERR /TEST SUB EXPR + JMP I NOREL +DPCHKX, CLA CLL CML RAR /SET DPFLG, MODULE NEEDS + DCA DPFLG /DP HARDWARE + JMP I [NEXTST +/ SET BASE AND INDEX LOCS +INDXX, CLA STL RTL /INDXR MUST JUST FOLLOW BASER +BASEX, TAD (BASER-1 /POINT TO VALUE TO BE SET + DCA X12 /HOPEFULLY UNUSED XR + JMS I (ADRGET /COLLECT EXPRESSION + TAD EXPVAL+1 + DCA I X12 /HIGH ORDER AND ESD + TAD EXPVAL+2 + DCA I X12 /LOW ORDER + JMP I [NEXTST >/THIS CONDITIONAL SASSEMBLY WAS +/EXPANDED TO INCLUDE INDXX ON THIS PAGE. IT IS ALSO +/COND. ASSEMBLED ON ANOTHER PAGE FOR FLAP. +DELFIL, 0 + TAD [7600 + DCA OUFILE + JMS I [OFNAME + CLA IAC + CIF 10 + JMS I USR + 4 + OUFNAM + 0 + NOP + JMP I DELFIL + PAGE + / +/ PRINT THE CURRENT LINE IF NOT ALREADY DONE +/ +PRNTLN, 0 /PRINT THE LINE + TAD OUTSWT /HAS THE LINE BEEN PRINTED YET? + SZA CLA + JMP I PRNTLN /YES, COOL IT + ISZ OUTSWT /SET SWITCH + TAD BLINE /POINTER TO LINE + DCA X13 + DCA CRLF /CLEAR POSITION COUNT + JMP PRLTST /IN CASE OF EMPTY LINE +PRLNXT, TAD I X13 /GET A CHAR + TAD (-211 /WATCH OUT FOR TAB + SNA + JMP TABIT /CONVERT TO BLANKS + TAD (211 /RESTORE + ISZ CRLF /BUMP POSITION COUNT + JMS I PC /PRINT IT +PRLTST, ISZ LINSIZ /CHECK COUNT + JMP PRLNXT + JMP I PRNTLN +TABIT, TAD [240 /REPLACE TAB WITH BLANKS + ISZ CRLF + JMS I PC + TAD CRLF + AND [7 + SZA CLA + JMP TABIT + JMP PRLTST +/ +/ GO TO NEXT LINE +/ +CRLF, 0 + CLA + TAD (215 + JMS I PC /PRINT A CHAR + TAD (212 + JMS I PC + ISZ LINPAG /FULL PAGE? + JMP I CRLF /NO + CLA CMA + DCA LINPAG +/ +/ NEW PAGE, WITH HEADING AND PAGE NO +/ + TAD PASSNO /IF NOT LISTING PASS + SMA SZA CLA + TAD LISTSW /OR IF NOT LISTING, + SNA CLA + JMP I CRLF /DO NOT EJECT + TAD RFORMF + SZA /DON'T F.F. FIRST TIME + JMS I PC /TOP OF PAGE + TAD (214 + DCA RFORMF + JMS I (PRTXT /PRINT HEADING + TITBUF-1 + -TITLEN + TAD LPAGE1 /FORM FEED COUNT + JMS I (DECOUT + TAD LPAGE2 + SNA CLA + JMP .+5 /NO SUB PAGE IF 0 + TAD (255 + JMS I PC + TAD LPAGE2 + JMS I (DECOUT + ISZ LPAGE2 + TAD (215 /FOR BH + JMS I PC + TAD (212 + JMS I PC + TAD (-71 /RESET LINE COUNTER + DCA LINPAG + JMP CRLF+1 /GIVE ANOTHER CRLF +RFORMF, 0 +/ +/ PRINT TEXT +/ +PRTXT, 0 + TAD I PRTXT + DCA X13 + ISZ PRTXT + TAD I PRTXT + DCA PRTTMP + ISZ PRTXT + TAD I X13 + JMS PRINT2 + ISZ PRTTMP + JMP .-3 + JMP I PRTXT +PRTTMP= PRNTLN +/ +PRINT2, 0 + DCA P2 + TAD P2 + JMS I [R6R + JMS P1 + TAD P2 + JMS P1 + JMP I PRINT2 +/ +P1, 0 + AND [77 + SNA + JMP .+4 /PRINT ZERO AS BLANK + TAD (-40 /TEST ABOVE OR BELOW 300 + SPA + TAD [100 /ABOVE, MAKE 301 TO 337 + TAD [240 /IF BELOW, MAKE 240 TO 277 + JMS I PC /PRINT IT, WHATEVER IT IS + JMP I P1 + / +TTYOUT, 0 + TLS + TSF + JMP .-1 +TTYCLA, JMS I (CKCTC /CHECK FOR ^C - AC CONTAINS DIFFERENCE + TAD (-14 /CTRL/O + SZA CLA + JMP I TTYOUT + TAD .+2 + DCA TTYOUT+1 + JMP I TTYOUT +/ +P2, 0 +/ + IFZERO RALF < +TXLNK, TEXT " LINKS" +TXLLN= .-TXLNK > + IFNZRO RALF < +TXABR, TEXT " ABS REFS" +TXALN= .-TXABR > + PAGE + / +/ GET AND EVALUATE AN EXPRESSION +/ +EXPR, 0 /GET EXPRESSION + DCA EXPVAL /ZERO EXPR VALUE + DCA EXPVAL+1 + DCA EXPVAL+2 + CLA IAC + DCA EXPDEF /AND TYPE + CLA IAC /SET EXPR SWITCH TO NO EXPR + DCA EXPSW + DCA FPP2WD /SET FORCE SWITCH OFF + CLA IAC /SET LASTOP TO + + DCA LASTOP + IFZERO RALF < + JMS I (CHKLIT /GO CHECK FOR LITERAL> + JMS I (GETSGN /IGNORE +, BUMP LASTOP IF - +SYMBOL, JMS I [GETNAM /NOW PICK UP NAME + JMP NOSYM /NONE, TRY OTHER + JMS I [LOOKUP /LOOK IT UP + JMP UNDEF /A NEW ONE + IFZERO RALF < + JMP ADR /YES > + IFNZRO RALF < + CLL RAR + SNA + JMP ADR +SCTN, TAD I LTEMP /GET TYPE + AND (40 /FORCE BIT + SZA CLA + ISZ FPP2WD /SET FORCE EXPR SW + TAD I X10 /GET ESD FROM SYMBOL + AND [7770 /ESD ONLY + DCA WORD1 /INTERNALLY, SYMBOL VAL IS ZERO + JMP CLR2 /SO CLEAR WORD 2> + NOTDOT, TAD (256-242 /IS IT DBL QUOTE? + SZA CLA + JMP ENDEXP + ISZ NCHARS /IS THERE ANOTHER CHAR? + JMP ISQUOT /YES, USE IT +ENDEXP, JMS I [BACK1 /PUT IT BACK + TAD EXPSW /WAS THERE ANY EXPRESSION AT ALL? + SZA CLA + JMP BAD /NO, DON'T SKIP + IFZERO RALF < + TAD LITRL /WAS IT A LITERAL REF? + SZA CLA + JMS I (CRLIT /YES, STICK IT IN THE POOL> + TAD LASTOP /TRAILING OPERATOR? + SNA + JMP OKEXP /NO, ALL IS FINE + CLL RAR /IF PLUS OPERATOR + TAD XINCR /AND THATS LEGAL + SNA CLA +OKEXP, ISZ EXPR /GOOD EXPR, BUMP RETURN +BAD, JMS CKCTC + CLA + JMP I EXPR /AND RETURN +/ +NOSYM, JMS I (NUMBER /LOOK FOR A NUMBER + JMP ADREXP /USE NUMBER + JMS I [GETCHR /NOT A NUMBER, GET A CHAR + JMP ENDEXP+1 /NONE LEFT, END + TAD (-256 /IS IT "." ? + SZA + JMP NOTDOT /NO, TRY FOR QUOTE + TAD LOCTR1 /THIS WAS LOC SYMBOL + DCA WORD1 /PUT VALUE INTO WORD1,2 + TAD LOCTR2 + JMP CLR2 /AND USE VALUE +ISQUOT, DCA WORD1 + TAD I CHRPTR + JMP CLR2 +CKCTC, 0 + CLA + KSF /IF NOTHING AT THE KEYBOARD, + JMP I CKCTC /RETURN + TAD [200 + KRS /ELSE, LOOK AT IT + TAD (-203 /IS IT CTRL/C? + SNA + JMP I [7600 /GO TO MOMMA + JMP I CKCTC + ADR, TAD I LTEMP /CHECK FORCE BIT FOR THIS SYMBOL + AND (40 + SZA CLA + ISZ FPP2WD /AND SET SWITCH IF BIT ON + TAD I X10 /GET FIRST WORD OF VALUE +ONE, DCA WORD1 /SINGLE WORD SYMBOL, HIGH=0 + TAD I X10 /GET REST OF SYMBOL +CLR2, DCA WORD2 + CDF FLD0 /FIX FIELD +ADREXP, DCA EXPSW /KILL FIRST TIME SWITCH + TAD LASTOP /PICK UP LAST OPERATOR + TAD ADROP /MAKE A JMP I + DCA .+1 + 0 /DO IT +ADROP, JMP I . + ADRADD + ADRSUB + ADRMUL + ADRDIV + ADRAND + ADROR + ADROR + UNDEF, TAD FPPSWT /IS THIS AN FPP ADDR ? + SNA CLA + JMP .+5 /NO, SKIP AROUND + TAD I LTEMP /TURN ON FORCE BIT + AND (7737 /FOR THIS SYMBOL + TAD (40 + DCA I LTEMP + DCA EXPDEF /SET TYPE TO UNDEFINED + CDF FLD0 /FIX FIELD + DCA EXPSW /KILL FIRST TIME SWITCH + JMS I [ERMSG + 2523 /*US* +OPR8R, TAD (OPR8RS-1 /SET POINTER + DCA X11 /TO OPERATOR TABLE + DCA LASTOP /ZERO LASTOP + JMS I [GETCHR /GET CHAR + JMP ENDEXP+1 /NONE, DONE + DCA EXTMP /SAVE IT +FINDOP, ISZ LASTOP + TAD I X11 /GET NEXT LIST ENTRY + SNA + JMP NOOPR /ZERO IS END OF LIST + TAD EXTMP /COMPARE + SZA CLA + JMP FINDOP /LOOP + JMP SYMBOL /LOOK FOR OPERAND +NOOPR, DCA LASTOP /NO MATCH FOUND + JMP ENDEXP /PUT IT BACK + PAGE + ADRADD, IFNZRO RALF < + TAD WORD1 + AND [7770 /IF THIS SYMBOL IS RELOCATABLE, + SZA CLA /CHECK FOR EXPR VALIDITY + JMS I (RELERR > + TAD EXPVAL+2 /ADD FOR 15 BIT ADDRESS + CLL /ZERO LINK + TAD WORD2 /ADD LOW WORDS + DCA EXPVAL+2 /SAVE RESULT + RAL /PUT CARRY INTO BIT 11 + TAD WORD1 /ORDER WORDS + JMP ADRASX /LOOK FOR OPERATOR +ADRSUB, IFNZRO RALF < + TAD WORD1 /IF SYMBOL IS RELOCATABLE + AND [7770 /WE MUST COMPARE SECTIONS + CIA /IF EQUAL, EXPR BECOMES ABSOLUTE + SNA /ELSE, EXPR IS ILLEGAL + JMP .+5 /OK, USE EXPVAL ESD + JMS I (RELERR /COMPARE: AC DELIBERATELY NON-ZERO + TAD EXPVAL+1 + AND [7 /IF WORD RELOCATABLE, EXP IS ABS + DCA EXPVAL+1 > + TAD WORD2 /SUBTR LOW 12 BITS + CLL CML CIA + TAD EXPVAL+2 + DCA EXPVAL+2 /SAVE LOW HALF + RAL + TAD WORD1 /SUBTRACT HIGH HALF + CIA + AND [7 /DO NOT SUBTR ESD'S +ADRASX, TAD EXPVAL+1 + AND (7767 /PREVENT CARRY INTO BIT 8 +ADRASY, DCA EXPVAL+1 /SAVE HIGH HALF + JMP I (OPR8R /GET OPERATOR +/INDXX HERE FOR FLAP + IFZERO RALF < +/ SET BASE AND INDEX LOCS +INDXX, CLA STL RTL /INDXR MUST JUST FOLLOW BASER +BASEX, TAD (BASER-1 /POINT TO VALUE TO BE SET + DCA X12 /HOPEFULLY UNUSED XR + JMS I (ADRGET /COLLECT EXPRESSION + TAD EXPVAL+1 + DCA I X12 /HIGH ORDER AND ESD + TAD EXPVAL+2 + DCA I X12 /LOW ORDER + JMP I [NEXTST > + ADRAND, TAD WORD1 /AND + AND EXPVAL+1 /HIGH + AND [7 /3 BITS + DCA EXPVAL+1 /HALF + TAD WORD2 /THEN + AND EXPVAL+2 /LOW + JMP ADRAOX +ADROR, TAD WORD1 /OR IS PERFORMED BY + CMA /SETTING THE BITS + AND EXPVAL+1 /THAT ARE ON IN B AND NOT ON IN A + TAD WORD1 /AND THEN SETTING THE BITS + AND [7 + DCA EXPVAL+1 /THAT ARE ON IN A + TAD WORD2 + CMA + AND EXPVAL+2 + TAD WORD2 +ADRAOX, DCA EXPVAL+2 + IFNZRO RALF < + JMS I (NOREL /**> + JMP I (OPR8R /GET NEXT OPERATOR +/ + ADRMUL, TAD WORD2 /**RL CODE + CIA + DCA EXPVAL+1 /MULT BY + TAD EXPVAL+2 /REPEATED ADDITIONS + ISZ EXPVAL+1 + JMP .-2 + JMP ADRAOX +ADRDIV, DCA WORD1 + DCA EXPVAL+1 + TAD WORD2 + SNA CLA + JMP DIVERR + TAD EXPVAL+2 + CIA CLL + TAD WORD2 + SZL + JMP .+3 /DIVIDE BY + ISZ WORD1 /COUNTING SUBTRACTIONS + JMP .-4 + CLA + TAD WORD1 + JMP ADRAOX + DIVERR, JMS I [ERMSG + 0626 /*DV* + JMP I (OPR8R /CONTINUE + PDPOPR, TAD CHRPTR + DCA CPTMP + TAD NCHARS + DCA NCTMP + JMS I [GETNAM /LOOK FOR ANOTHER MICRO-INST + JMP TRYEXP /NONE + TAD (33 /USE INTERNAL TABLE + JMS I [FIND /IS IT THERE ? + JMP TRYEXP /NO + TAD (-PDPOP /IS IT AN OPERATE ? + SZA CLA + JMP TRYEXP /NO + TAD I X10 /GET VALUE + CDF FLD0 + DCA EXPVAL+2 +PDPOR, TAD EXPVAL+2 + CMA /OR THEM TOGETHER + AND OPCODE + TAD EXPVAL+2 + DCA OPCODE + JMS I [GETCHR /MORE CHARS ? + JMP I (FPPS3 /NO-DONE + TAD [-240 /BLANK ? + SNA CLA + JMP PDPOPR /YES-PROCESS NEXT + JMP I (BADEXP +TRYEXP, CDF FLD0 + TAD CPTMP + DCA CHRPTR + TAD NCTMP + DCA NCHARS + ISZ NCTMP + SKP + JMP I (FPPS3 + JMS I [EXPR + JMP I (BADEXP + JMP PDPOR +TXSYM, TEXT " SYMBOLS," + TXSLN=.-TXSYM + PAGE + IFZERO RALF < +/ +/ LITERAL THINGS +/ +CHKLIT, 0 /CHECK FOR LITERAL + DCA PAGENO /ZERO PAGE NUMBER + DCA LITRL + JMS I [GETCHR /GET CHARACTER + JMP I CHKLIT /NO LITERAL + TAD (-250 /CHECK FOR ( + SNA + ISZ PAGENO /CURRENT PAGE LITERAL + SZA /SKIP IF ALREADY ZERO + TAD (-63 /CHECK FOR [ + SNA + ISZ LITRL /SET SWITCH + SZA CLA + JMS I [BACK1 /PUT BACK NON ([ + JMP I CHKLIT +/ +/ CREATE A LINK FOR OFF-PAGE REFERENCE +/ +MAKLNK, TAD (THSPAG /PROPER RETURN ADDR + DCA CRLIT + TAD OPCODE /SET INDIRECT BIT + TAD (400 + DCA OPCODE + CLA IAC + DCA PAGENO /SET INDICATOR + ISZ LINKS /COUNT ANOTHER LINK GENERATED + ISZ LINKSW /SET SWITCH FOR APOSTROPHE OUTPUT + JMP NOTP0 +CRLIT, 0 /CREATE LITERAL + /VALUE:EXPVAL, IN PAGE:PAGENO + TAD PAGENO /CHECK FOR PAGE 0 + SNA CLA + JMP ISP0 /PAGE 0 LITERAL +NOTP0, TAD (CPLBUF /SET PTR TO LITERAL BUFFER + DCA LITBAS + TAD LOCTR2 /CHECK FOR LIT BUFFER FULL + AND [100 + SNA CLA + JMP DOLIT-1 /USE 77 AS LIMIT + TAD LOCTR2 + AND [177 + JMP DOLIT /USE CURRENT ADDR AS LIMIT + ISP0, TAD (P0LBUF /USE PAGE 0 LIT BUFFER + DCA LITBAS + TAD [77 /ASSUME FIRST 64 WORDS USED +DOLIT, DCA NWUSED + TAD PAGENO /GET POINTER TO + TAD [P0LIT /LITERAL BOUNDARY + DCA XPAGE + TAD I XPAGE /DISPLACEMENT OF LIT BUFR - 1 + DCA LITPTR /INTO LITPTR +NOTIT, TAD LITPTR /POINTER+SIZE + TAD (-177 /SHOULD BE LESS THAN 177 + SMA CLA + JMP NEWLIT /ENTER NEW LITERAL + TAD LITPTR /NOW GET POINTER + TAD LITBAS /TO TABLE + DCA X11 /FOR COMPARISON + ISZ LITPTR /INCREMENT POINTER + TAD I X11 /GET WORD OF LITERAL + CIA + TAD EXPVAL+2 /COMPARE PROTOTYPE + SZA CLA + JMP NOTIT /NOT IT, SLIDE POINTER AND RETRY +LITADR, TAD PAGENO /PAGE 0 ? + SZA CLA + TAD LOCTR2 /NO, CURRENT PAGE, GET ADDRESS + AND [7600 + TAD LITPTR /PLUS PAGE DISPLACEMENT + DCA EXPVAL+2 /INTO VALUE + TAD LOCTR1 +RETLIT, DCA EXPVAL+1 + JMP I CRLIT + NEWLIT, CLA CMA + TAD I XPAGE /MOVE LITERAL BOUNDARY DOWN + DCA X10 /ADDRESS OF NEW LITERAL + TAD NWUSED /CHECK FOR PAGE OVERFULL + CIA + TAD X10 + SMA CLA + JMP .+5 /NOT FULL + JMS I [ERMSG /*PO* + 2017 + DCA EXPVAL+2 /ZERO ADDRESS + JMP RETLIT + TAD X10 + DCA I XPAGE + TAD I XPAGE /SET UP POINTER FOR MOVE + TAD LITBAS + DCA X10 + TAD EXPVAL+2 /MOVE LITERAL IN + DCA I X10 + TAD I XPAGE /SET UP LITERAL ADDRESS + IAC + DCA LITPTR + JMP LITADR /RETURN LITERAL ADDRESS +LITBAS, 0 +NWUSED, 0 +LITPTR, 0 +PAGENO, 0 +XPAGE, 0 + PAGE /> + / +/ FIND SYMBOL TABLE ENTRY +/ FOR THE SYMBOL IN BUCKET AND NAME 1, 2, 3 +/ SKIP IF FOUND WITH TYPE IN AC +/ +FIND, 0 /SYMBOL TABLE LOOKUP + TAD BUCKET /GET BUCKET ADDRESS + CDF FLD1 /GO TO FIELD 1 +LOOK, DCA OLDN3 /THIS IS PTR OF PREV ENTRY + TAD I OLDN3 /THIS IS ADR OF NEXT ENTRY + SNA /IF ZERO, THEN + JMP I FIND /IT AIN'T HERE + DCA X10 /SAVE NEXT NAME PTR + TAD NAME1 /COMPARE NAMES + CIA CLL + TAD I X10 /WORD 1 + SZA CLA + JMP NOTSAM + TAD NAME2 + CIA CLL + TAD I X10 /WORD2 + SZA CLA + JMP NOTSAM + TAD NAME3 + CIA CLL + TAD I X10 /COMPARE LAST CHAR + AND [7700 /HIGH HALF ONLY + SZA CLA + JMP NOTSAM + ISZ FIND /IF FOUND BUMP RETURN + TAD X10 + DCA LTEMP /ADDR OF TYPE WORD + TAD I LTEMP /GET TYPE INTO AC + AND [37 /WITHOUT FORCE BIT + JMP I FIND /RETURN +NOTSAM, SZL CLA /IS NAME 1,2,3 .LT. ENTRY + JMP I FIND /YES, IT ISN'T HERE + TAD I OLDN3 /GET ADDR OF LINK INTO AC + JMP LOOK /LOOP + / +/ FIND SYMBOL, OR IF NOT THERE, CREATE ENTRY FOR IT +/ +LOOKUP, 0 + JMS FIND + JMP .+4 + SZA + ISZ LOOKUP /SKIP RETURN IF DEFINED + JMP I LOOKUP /RETURN TYPE CODE + TAD I OLDN3 /GET FORWARD LINK TO + DCA I NEXT /NEXT ENTRY INTO NEW ENTRY + TAD NEXT /PUT FORWARD LINK TO NEW + DCA I OLDN3 /ENTRY INTO PREVIOUS ENTRY + TAD NAME1 /PUT IN NAME + DCA I NEXT + TAD NAME2 + DCA I NEXT + TAD NAME3 + DCA I NEXT + TAD NEXT /X10=NEXT + DCA X10 + TAD NEXT /LTEMP=NEXT + DCA LTEMP + DCA I NEXT /INITIAL VALUE IS ZERO + DCA I NEXT + TAD NEXT /CHECK FOR TABLE FULL + CLL + TAD [200 /GONNA OVERFLO PS8? + SNL CLA + JMP I LOOKUP /NO PROBLEMS, RETURN (NO SKIP) + JMS I [ERMSG1 + 2324 /*ST* + / +/ COLLECT AN INTEGER IN THE CURRENT RADIX +/ +NUMBER, 0 /GET INTEGER NUMBER (NO SIGN) + DCA NSWTCH /CLEAR SWITCH + DCA NOFLO /CLEAR OVRFLO SW + DCA WORD1 /CLEAR 24 BIT NUMBER + DCA WORD2 +NUMLUP, JMS I (DIGIT + JMP NODGT /TOO BAD + DCA NUM /YES, SAVE IT + TAD WORD1 /SAVE CURRENT VALUE + DCA NUM1 /OF NUMBER + TAD WORD2 + DCA NUM2 + JMS SHIFT /SHIFT WORD1,2, LEFT 1 (MULT BY 2) + JMS SHIFT /DO IT AGAIN (MULT BY 4) + TAD RADIX /LOOK AT RADIX (1=DECIMAL) + SNA CLA + JMP OCTNUM /ITS OCTAL + CLL /DECIMAL, ADD IN NUMBER + TAD NUM2 + TAD WORD2 /THUS MULTIPLYING BY 5 + DCA WORD2 + RAL + TAD NUM1 + TAD WORD1 + DCA WORD1 + JMP ADDDGT +OCTNUM, TAD NUM + AND [7770 /CHECK FOR 8 OR 9 + SZA CLA + ISZ NOFLO /SET ERROR FLAG +ADDDGT, JMS SHIFT /SHIFT LEFT 1 AGAIN, THUS + TAD WORD2 /MULTIPLYING BY 8 OR 10 + CLL /THEN ADD IN NEW DIGIT + TAD NUM + DCA WORD2 + RAL + TAD WORD1 + DCA WORD1 + SZL /BEWARE OF OVERFLO + ISZ NOFLO + JMP NUMLUP /LOOP + NODGT, TAD NSWTCH /WAS THERE A NUMBER + SNA CLA + ISZ NUMBER /NO, SKIP + TAD WORD1 + AND [7770 /CHECK FOR MORE THAN 15 BITS + SNA + TAD NOFLO /OR GROSS OVERFLOW + SNA CLA + JMP I NUMBER /ALL GREEN + JMS I [ERMSG + 1605 /*NE* + JMP I NUMBER /RETURN +NOFLO= LOOKUP /ZERO IF NO ERRORS +NUM= FIND +NUM1= EXTMP +NUM2= EXTMP2 +NSWTCH, /ZERO IF NO DIGITS +SHIFT, 0 /SHIFT DOUBLE WORD LEFT 1 + TAD WORD2 + CLL RAL + DCA WORD2 + TAD WORD1 + RAL + DCA WORD1 + SZL /IF BIT SHIFTED FROM HI WORD, + ISZ NOFLO /SET ERROR FLAG + JMP I SHIFT + PAGE + / +/ BACK UP GETCHR POINTERS, +/ WE DON'T WANT THIS ONE +/ +BACK1, 0 + CLA CMA /BACKUP COUNT + TAD NCHARS + DCA NCHARS + CLA CMA /AND POINTER + TAD CHRPTR + DCA CHRPTR + JMP I BACK1 +/ +/ GET NEXT CHAR FROM LINE BUFFER +/ FOR ASSEMBLY PURPOSES ONLY +/ SKIP UNLESS END OF LINE (CR, ;, OR /) +/ +GETCHR, 0 + JMS GETAC +GETSKP, ISZ GETCHR /SKIP RETURN + JMP I GETCHR +BLANK, JMS GETAC /COME HERE IF BALNK OR TAB + TAD (-257 /END OF LINE ON SLASH AFTER BLANK + SNA CLA + JMP GETCND + JMS BACK1 /PUT IT BACK + TAD [240 /AND RETURN A SINGLE BLANK + JMP GETSKP /SKIP OUT +SEMICL, ISZ SCSWT + JMS BACK1 /PUT BACK SEMI COLON + JMP I GETCHR +GETAC, 0 + ISZ NCHARS /END OF LINE? + JMP .+4 /NO, GET IT +GETCND, CLA CMA /YES, RESET IN CASE OF + DCA NCHARS /ANOTHER CALL + JMP I GETCHR /RETURN END OF LINE + TAD I CHRPTR /PICK UP NEXT + TAD [-240 /CHECK FOR BLANK + SZA + TAD (240-211 /OR TAB + SNA + JMP BLANK /THEY GET SPECIAL HANDLING + TAD (211-273 /LOOKOUT FOR SEMICOLON + SNA + JMP SEMICL /ALSO SPECIAL + TAD (273-276 /IGNORE CLOSE ANGLE BRACKET + SNA + JMP GETAC+1 /GET ANOTHER + TAD (276 /ELSE, RESTORE CHAR + JMP I GETAC /AND PASS IT BACK + / +/ COLLECT A SYMBOL IN BUCKET, NAME 1,2, & 3 +/ NO SKIP ON RETURN IF NO SYMBOL +/ +GETNAM, 0 + DCA NAME1 /CLEAR SYMBOL SPACE + DCA NAME2 + DCA NAME3 + JMS LETTER /GET A LETTER + JMP ISSYM + JMS GETCHR /CHECK FOR # + JMP I GETNAM /NOPE + TAD (-"# + SNA CLA + JMP ISSYM + JMS BACK1 + JMP I GETNAM +ISSYM, DCA BUCKET + ISZ GETNAM /ONE LETTER DOTH A SYMBOL MAKE + JMS GNC /FRIENDLY LOCAL SUBR + JMS R6L + DCA NAME1 + JMS GNC + TAD NAME1 + DCA NAME1 + JMS GNC + JMS R6L + DCA NAME2 + JMS GNC + TAD NAME2 + DCA NAME2 + JMS GNC + JMS R6L + DCA NAME3 + JMS GNC /AFTER 6, WE IGNORE + SKP CLA +GNC, 0 + JMS LETTER + JMP I GNC /RETTURN LETTER + JMS DIGIT + JMP I GETNAM /EMPTY HANDED, RETURN TO CALLER + TAD (60 + JMP I GNC + / +/ IF NEXT CHAR IS A LETTER, RETURN 6 BITS +/ IF NOT, REPLACE CHAR AND SKIP. +/ +LETTER, 0 + JMS GETCHR + JMP NLETR /NO LETTER, SKIP + TAD (-333 + CLL CML + TAD (33 + SZA SNL /DON'T ALLOW 300 + JMP I LETTER + JMS BACK1 +NLETR, ISZ LETTER + JMP I LETTER +/ +/ IF NEXT CHAR IS A DIGIT (0-9) RETURN VALUE AND SKIP +/ +DIGIT, 0 + JMS GETCHR + JMP I DIGIT + TAD (-272 + CLL + TAD (12 + SNL + JMP NDIGT + ISZ DIGIT + JMP I DIGIT +NDIGT, JMS BACK1 + JMP I DIGIT +/ +R6L, 0 + CLL RTL + RTL + RTL + JMP I R6L +/ +R6R, 0 + RTR + RTR + RTR + AND [77 + JMP I R6R + PAGE + / +/ BUILD AN INSTRUCTION +/ +FIXOPC, 0 /COMBINE OPCODE PARTS + TAD XFLAG /CHECK INDEX SWITCH + SNA CLA + JMP ZRONDX /IF ZERO, NO INDEX REG + CLA CMA + TAD LASTOP /IF INDEX, CHECK FOR INCR + SNA CLA + TAD [100 /YES, PUT + BIT ON + TAD OPCODE /COMBINE WITH OPCODE + DCA OPCODE + TAD EXPVAL+2 /GET INDEX REG. EXPR + AND [7 /ONLY 3 BITS + CLL RTL /SHIFT INTO POSITION + RAL +ZRONDX, TAD OPCODE /ADD OPCODE + TAD (400 /TURN ON TYPE BIT + DCA OPCODE /SAVE OPCODE + JMP I FIXOPC /RETURN +/ +OPR8RS, + -253 /PLUS + -255 /MINUS + -252 /STAR (MULTIPLY) ** + -257 /SLASH (DIVIDE) + -246 /AMPERSAND (AND) + -240 /SPACE (OR) + -241 /EXCLAMATION (OR) + 0 /END OF LIST + / +/ FATAL ERRORS +/ +ERMSG1, 0 /PASS 1 (FATAL) MESSAGES + CDF + TAD I ERMSG1 /GET CODE + DCA .+3 + DCA PASSNO + JMS ERMSG /DO THE MSG THING + 0 + IFZERO RALF < +RETSYS, > + TSF /FINISH TYPING + JMP .-1 + JMP I [7600 /EXIT TO PS8 +/ +/ GENERAL GARBAGE TYPE ERRORS +/ +ERMSG, 0 + CDF FLD0 /FIX FIELD + CLA /NO MESSAGE ON PASS 1 + TAD PASSNO + SMA SZA /IF PASS 3, OUTPUT LEADING CRLF + JMS I [CRLF + SPA CLA + JMP MSGDUN + TAD (5555 /MINUSES + JMS I [PRINT2 + TAD I ERMSG /2-CHAR CODE + JMS I [PRINT2 /PRINT THE MESSAGE + TAD (5555 + JMS I [PRINT2 + TAD PASSNO + SZA CLA + JMP .+4 + JMS I [PRINT2 +PLINE, JMS I (PRNTLN + JMS I [CRLF + ISZ ERRORS /BUMP COUNT +MSGDUN, ISZ ERMSG + JMP I ERMSG + / +/ OUTPUT DECIMAL +/ SUPPRESS LEADING ZEROS +/ PRINT "NO" INSTEAD OF "0" +/ +DECOUT, 0 + SNA /ZERO IS SPECIAL + JMP DECNO /NO INSTEAD OF 0 + DCA OTEMP + DCA OCNT + JMS DEC2 /GET THOUSANDS + -1750 + JMS DEC2 /HUNDREDS + -144 + JMS DEC2 /TENS + -12 + TAD OTEMP /UNITS (NO ZERO SUPPRESS HERE) + JMS PDIG /PRINT LAST DIGIT + JMP I DECOUT /EASY, WHEN YOU KNOW HOW +/ +DECNO, TAD (1617 /NO + JMS I [PRINT2 + JMP I DECOUT +/ +/ LAZY MAN'S DIVISION +/ +DEC2, 0 + CDF FLD0 /JUST TO MAKE SURE +DEC3, CLA CLL + TAD OTEMP + SNA + JMP DEC4 + TAD I DEC2 /SUBTRACT DIVISOR + SNL /TOO MUCH? + JMP DEC4 /YES, STOP NOW + DCA OTEMP /NO, SAVE NEW REMAIN + ISZ OCNT /BUMP QUOTIENT + JMP DEC3 /DO IT AGAIN +DEC4, CLA + ISZ DEC2 /SKIP RETURN + TAD OCNT /CHECK FOR SIGNIFICANCE + SNA + JMP I DEC2 /NONE + JMS PDIG + CLA STL RAR /FORCE SIGNIFICANCE + DCA OCNT + JMP I DEC2 + / +TENTH, -111 + 1463;1463;1463 + 1463;1463;1463 +TEN, 1 +PDIG, 0 + TAD P260 + JMS I PC + JMP I PDIG +P260, 260 + 5 +/ +/ OCTAL CONVERSION, THE HARD WAY +/ +OCTOUT, 0 + DCA OTEMP + STL RAR /NO ZERO SUPPRESS + DCA OCNT + JMS DEC2 + -1000 + JMS DEC2 + -100 + JMS DEC2 + -10 + TAD OTEMP + JMS PDIG + JMP I OCTOUT + PAGE + / +/ OUTPUT ONE WORD +/ + IFNZRO RALF < +/ +/ TEXT TYPE CODES: +TTABS= 0400 +TTORG= 1000 +TTREL= 1400 +/ +OUTREL, DCA WRD /HOLD FIRST WORD + DCA LINKSW /CLEAR ABSOLUTE REF INDICATOR + TAD FPPADR /GET ESD CODE + RTR + RTR /RIGHT IN AC + AND [177 /STRIP TO ESD ONLY + SNA /CHECK FOR ABSOLUTE + JMP PUTABS + DCA FPPADR /SAVE ESD + TAD PASSNO /CHECK FOR PASS 2 + SZA CLA + JMP PRNTRL /IF NOT, TREAT NORMALLY + DCA ABSOP + CLA STL RTL + JMS I (FULCHK /ENSURE 3 WORDS LEFT + TAD FPPADR /GET ESD AGAIN + TAD (TTREL /INSERT CONTROL CODE + DCA I OUTPTR + TAD WRD /FIRST DATUM + DCA I OUTPTR + TAD FPPADR+1 + DCA I OUTPTR + JMS I (FULCHK /IS IT FULL? + JMS BMPLOC /TWO WORDS OUT + JMS BMPLOC /SO LOCCTR +2 + JMP I [NEXTST +PUTABS, ISZ ABREFS /COUNT IT + ISZ LINKSW /SET FLAG +PRNTRL, TAD WRD /GET FIRST WORD + JMS OUTWRD + TAD FPPADR+1 + JMS OUTWRD + JMP I [NEXTST > + / +OUTWRD, 0 /OUTPUT ROUTINE + DCA WRD /SAVE WORD + IFZERO RALF < + TAD LOCTR2 /GET LOW 12 BITS OF LOCATION + JMS I [R6L + AND [37 /GET PAGE NUMBER (WITHIN FIELD) + DCA OTEMP /SAVE PAGE NUMBER + TAD OTEMP + SZA CLA /POINTER TO LITERAL POINTER + IAC + TAD [P0LIT + DCA OWTEMP + TAD LOCTR2 /GET CURRENT ADDRESS DISPLACEMENT + AND [177 + CIA /COMPARE WITH LITERAL BOUNDARY + TAD I OWTEMP + SMA CLA + JMP .+3 /NO PAGE OVER FLOW + JMS I [ERMSG + 2017 /*PO*> + TAD PASSNO /CHECK PASS + SZA + JMP PRNTST /ITS NOT PASS 2 + IFZERO RALF < + TAD WRD /NOW OUTPUT WORD + JMS I [R6R + JMS OOCHAR + TAD WRD + AND [77 + JMS OOCHAR > + IFNZRO RALF < + TAD ABSOP /CHECK FOR ALREADY IN ABS OUTPUT + SZA CLA + JMP INABS /NO PROBLEM + CLA IAC + JMS I (FULCHK + TAD (TTABS /SET ABS CONTROL CODE + DCA I OUTPTR + TAD OUTPTR /SAVE POINTER FOR FUTRUE REF + DCA ABSOP +INABS, ISZ I ABSOP /BUMP COUNT + TAD WRD + DCA I OUTPTR + JMS I (FULCHK /GOOD!> + PRNTST, SMA SZA CLA + TAD LISTSW /IS LIST ON ? + SNA CLA + JMP ENDOUT /NO, DONT PRINT + JMS I [CRLF /NEW LINE + TAD LOCTR1 /PRINT LOCATION COUNTER + AND [7 + JMS I (PDIG + TAD LOCTR2 /NEXT FOUR DIGITS + JMS I [OCTOUT + TAD [240 + JMS I PC + TAD WRD /NOW WORD + JMS I [OCTOUT + TAD LINKSW /LINK GENERATED ON THIS LINE? + SZA CLA + TAD (4700 /IF SO, GIVE APOSTROPHE SPACE + JMS I [PRINT2 + DCA LINKSW /CLEAR SW + JMS I (PRNTLN /PRINT LINE IF NECESSARY +ENDOUT, JMS BMPLOC /BUMP LOC CNTR + JMP I OUTWRD /RETURN +/ +WRD, +BMPLOC, 0 + ISZ LOCTR2 /BUMP LOW ORDER + JMP I BMPLOC + CLA IAC + TAD LOCTR1 + AND (7767 /STOP CARRY INTO BIT 8 + DCA LOCTR1 + JMP I BMPLOC + IFZERO RALF < +/ +/ PUNCH CONTROL +/ +NOPNCX, CLA IAC +ENPNCX, DCA PNCHOF + JMP I [NEXTST +/ +/ OUTPUT AN ORIGIN +/ +PUTORG, 0 + TAD PASSNO /CHECK FOR PASS 2 + SZA CLA + JMP I PUTORG /ELSE FORGET IT + TAD LOCTR2 /OUTPUT FIRST CHAR + JMS I [R6R + TAD [100 + JMS OOCHAR /OUTPUT CHAR + TAD LOCTR2 /NOW LOWER HALF OF ORIGIN + AND [77 + JMS OOCHAR + JMP I PUTORG +OWTEMP, +CHAROO, 0 +OOCHAR, 0 /OUTPUT CHAR AND COMPUTE CHKSUM + DCA CHAROO + TAD PNCHOF /PUNCHING? + SZA CLA + JMP I OOCHAR /NOPE + TAD CHAROO + TAD CHKSUM + DCA CHKSUM + TAD CHAROO + JMS I [OCHAR + JMP I OOCHAR > + / +/ BEGIN NEXT PASS +/ WITH APPROPRIATE THINGS RESET +/ TO DEFAULT VALUES +/ +RESET, JMS I (IOPEN /RE-SELECT FIRST INPUT FILE + TAD USR /EITHER 200 OR 7700 + SPA CLA /IS USR IN CORE? + JMP .+6 /NO + CIF 10 /YES, DISMISS IT + JMS I USR + 11 /USROUT + TAD [7700 + DCA USR /ITS GONE + IFNZRO RALF < + CLA STL RTL /COUNTING FROM 2, + DCA ESDNO /RESET ESD COUNT + JMS I (CLRSCT /ZERO ALL SECTION LENGTHS> + DCA ASMOF /ZERO CONDITIONAL SWITCH + DCA SCSWT /ZERO SEMICOLON SWITCH + TAD SYONLY /IF NOT SYM MAP ONLY + DCA LISTSW /FORCE LIST ENABLE + CLA IAC + DCA LPAGE1 + DCA LPAGE2 + CLA CMA + DCA LINPAG + IFZERO RALF < + TAD [177 + DCA P0LIT /RESET LITERAL BUFFER POINTERS + TAD [177 + DCA CPLIT + TAD [200 > + DCA LOCTR2 /LOCATION COUNTER + IFNZRO RALF < + TAD (20 > + DCA LOCTR1 + CLL CML RAR /4000 + DCA BASER /SET BASE BEYOND BELIEF + DCA INDXR + DCA INDXR+1 + DCA RADIX /RESET DEFAULT OCTAL + DCA ERRORS /ZERO ERROR COUNT + DCA LINKS + ISZ PASSNO /BUMP PASS NUMBER + JMP I (NEWLIN + JMP I (NEWLIN /DO NEXT PASS + PAGE + / +/ END OF A PASS +/ +ENDX, IFZERO RALF < + DCA PNCHOF /RE-ENABLE PUNCH> + IFNZRO RALF < + JMS I (BORG /SET MAX LEN OF CURRENT SECT> + TAD PASSNO + SMA CLA /WHAT PASS WAS THIS? + JMP EOP2 /NOT THE FIRST + IFNZRO RALF < + TAD (INBUF-400 + DCA I (INBUFP /MOVE INPUT BUFFER OVER DMPESD> + TAD BFILE + SNA CLA + JMP START3 /NO BINARY, START PASS 3 + IFZERO RALF < + TAD [200 /START BIN OUT WITH L/T + JMS I [OCHAR + JMP I (RESET > + IFNZRO RALF < + JMP I (DMPESD /OUTPUT EXT SYM TABLE> +/ +EOP2, IFZERO RALF < + CLA IAC /DUMP CURRENT PAGE LITERALS + JMS I (DMPLIT + JMS I (DMPLIT /THEN DUMP PAGE 0 LITERALS> + TAD PASSNO + SMA SZA CLA + JMP EOP3 /YES, PRINT SYMBOL TABLE + IFZERO RALF < + TAD CHKSUM /OUTPUT CHECKSUM + JMS I [R6R + JMS I [OCHAR + TAD CHKSUM + AND [77 + JMS I [OCHAR /LOWER HALF + TAD [200 /TRAILER CHAR + JMS I [OCHAR > + IFNZRO RALF < + DCA I OUTPTR /SET OUTPUT END INDICATOR> + JMS I (OCLOSE /CLOSE THE BINARY FILE +START3, DCA PASSNO /SKIP PASS TWO + JMS I (OOPEN /OPEN LISTING FILE + IFZERO RALF < + JMP NOP3 /NO LISTING, GIVE INFO ON TTY> + IFNZRO RALF < + JMP I (RETSYS > + TAD [OCHAR /CHANGE PRINT ROUTINE + DCA PC + JMP I (RESET /NO,RESET EVERYTHING + / +/ END OF LAST PASS +/ GIVE SOME STATISTICS +/ +EOP3, CLA CMA + DCA LINPAG + JMS I [CRLF +NOP3, JMS I (7607 /READ IN OVERLAY + 0100 +OVERLY, OVBUFR + 40 /USE SYS SCRATCH BLK + JMP I (7605 + JMP I OVERLY + +CHCKMR, 0 + TAD OPCODE /BE SURE ALL REFS ARE + AND [200 /ARE ON SAME PG + SZA CLA + TAD LOCTR2 + AND [7600 + CIA + TAD EXPVAL+2 + AND [7600 + SZA CLA +ADRERR, JMS I [ERMSG + 0201 /**BA** + TAD EXPVAL+2 + AND [177 + TAD OPCODE + JMS I [OUTWRD + JMP I [NEXTST + +IOERR, TAD INOP /REMOVE JMS PRNTLN + DCA PLINE + JMS I [ERMSG1 + 1117 /**IO** +INOP, NOP + + PAGE + IFZERO RALF < +/ ORG THINGS FOR ABSOLUTE ASSEMBLIES +/ +TRYSTR, JMS I [GETCHR + JMP I [NEXTST /WHAT CAN YOU DO? + TAD (-252 /IS IT AN ORG + SZA CLA + JMP I (GETEXP /NO, SOME FUNNY EXPR, MAYBE +ORGX, JMS I (ADRGET + TAD LOCTR1 /CHECK FOR NEW FIELD + CIA + TAD EXPVAL+1 + SNA CLA + JMP SAMFLD /NOT A DIFFERENT FIELD + CLA IAC + JMS DMPLIT /DUMP CURRENT PAGE LITERALS + JMS DMPLIT /DUMP PAGE 0 LITERALS + TAD EXPVAL+1 + AND [7 + DCA LOCTR1 + TAD PNCHOF /PUNCHING ENABLED? + SNA + TAD PASSNO /PASS 2? + SZA CLA + JMP SAMPAG /NO, DON'T OUTPUT CHANGE FIELD + TAD LOCTR1 /NEW FIELD BITS + RTL CLL + RAL + TAD (300 /TURN ON THE LEFT TWO BITS + JMS I [OCHAR /PUT IT OUT (NOT IN CHECK SUM) + JMP SAMPAG /DO THE SAME FOR CURRENT PAGE +SAMFLD, TAD LOCTR2 + AND [7600 /CHECK FOR SAME PAGE + DCA LTEMP + TAD EXPVAL+2 + AND [7600 + CIA + TAD LTEMP + SNA CLA + JMP SAMPAG /PAGE IS THE SAME + CLA IAC + JMS DMPLIT /DUMP CURRENT PAGE LITERALS +SAMPAG, TAD EXPVAL+2 + DCA LOCTR2 + JMS I (PUTORG + JMP I [NEXTST /DONE +PAGEX, TAD LOCTR2 /ADVANCE TO NEXT PAGE + CLL + TAD [177 + AND [7600 + DCA EXPVAL+2 + RAL + TAD LOCTR1 + DCA EXPVAL+1 + JMP ORGX+1 /DO ORG THINGS + DMPLIT, 0 + DCA PAGEN /SAVE PAGE INDICATOR + TAD OUTSWT /SAVE OUTPUT SWITCH + DCA SWTOUT + ISZ OUTSWT /DONT PRINT LINE WITH LITERALS + TAD PAGEN + TAD [P0LIT /GET BOUNDARY POINTER + DCA LTEMP + TAD PAGEN /WHICH LITERAL BUFFER ? + SNA CLA + TAD (P0LBUF-CPLBUF /PAGE 0 BUFFER + TAD (CPLBUF /CURRENT PAGE BUFFER + TAD I LTEMP /PLUS PAGE ADDRESS + DCA X10 /GIVES START OF LITERALS -1 + TAD PAGEN + SZA CLA + TAD LOCTR2 /UPPER FIVE BITS OF ADDRESS + AND [7600 + TAD I LTEMP /PLUS LOWER SEVEN + IAC /PLUS ONE + DCA LOCTR2 /GIVES LOCATION COUNTER + TAD LOCTR2 + AND [177 /ANYTHING TO DUMP? + SNA CLA + JMP DMPFIN /NO + TAD PASSNO + SMA SZA CLA + JMS I [CRLF /ONLY IF PASS 3 + JMS I (PUTORG + TAD [177 /STORE SPURIOUS LITERAL BOUNDARY + DCA I LTEMP /TO PREVENT FALLACIOUS *PO* MESSAGES +LITLUP, TAD I X10 /NO, GET NEXT LITERAL + JMS I [OUTWRD /OUTPUT WORD AND BUMP LC + TAD X10 /DONE? + IAC + AND [77 + SZA CLA + JMP LITLUP /LOOP +DMPFIN, TAD SWTOUT /RESTORE OUTPUT SWITCH + DCA OUTSWT + JMP I DMPLIT /ALL DONE +SWTOUT, 0 > + EXPON, TAD LASTOP + DCA TMP + DCA LASTOP + JMS I (GETSGN /GET SIGN OF EXPONENT + TAD RADIX + DCA OTEMP + ISZ RADIX /SET RADIX TO DECIMAL + JMS I (NUMBER /GET EXPONENT + NOP + TAD OTEMP + DCA RADIX /RESTORE RADIX + TAD TMP + CLL RAR + TAD LASTOP + RAR /LASTOP TO LINK, + DCA LASTOP /TMP TO SIGN OF LASTOP + TAD WORD2 + SZL + CIA /PUT SIGN ON EXP + JMP I (OVER +TMP, 0 + IFZERO RALF < PAGE / > + IFNZRO RALF < +/ +/ IF ALL CONDITIONS ARE RIGHT, CALL THE LOADER +/ +RETSYS, JMS I (DELFIL /THIS LOCATION USED BY INIT CODE +/MAY BE ZEROED BY IT. USED TO DELETE F4 OUTPUT FILE WHEN CHAINING +/FROM COMPILER + OUTPUT DEV IS NOT SYS + CDF 10 + TAD (7604 /POINT TO 2ND OUT FILE THING + DCA X11 + TAD (7611 /POINTER TO 3RD + DCA X10 + TAD (-5 /LENGTH OF SUCH THINGS + DCA LTEMP + TAD I X10 /MOVE 3RD TO 2ND + DCA I X11 /FOR LOADER MAP FILE + ISZ LTEMP + JMP .-3 + TAD I [7600 /WAS THERE A FIRST OUT FILE + AND NP17 /(BINARY OUT)* + DCA LTEMP + TAD OUTBLK /GET FILE LENGTH + AND (377 + CLL RTL + RTL + CIA + TAD LTEMP /COMBINE UNIT AND LEN + DCA I X10 /FOR FIRST INPUT FILE TO LOADER + TAD PASBLK /STARTING BLOCK + DCA I X10 + DCA I X10 /THAT'S THE END OF INPUT + CDF 0 + TAD ERRORS /IF NO ERRORS + SNA CLA + ISZ CHNSW /SHOULD WE CHAIN? + JMP I (7605 /NO!!! + ISZ I (7746 /** + CIF 10 + JMS I USR + 6 /CHAIN +LDRBLK, 0 /FIRST BLOCK OF LOADER +/ +PASBLK, 0 /FIRST BLOCK OF FILE PASSED +CHNSW, 0 /-1 TO ENABLE CHAIN LOADER + / +/ OUTPUT A BLOCK OF BINARY +/ +OUTBLK, 0 /AT END OF PASS2, BECOMES + /LENGTH OF BINARY FILE + TAD (OUCTL /DEV HNDLR CONTROL WORD + JMS I (OUTDMP /CALL THE HANDLER + TAD MOUBUF + DCA OUTPTR /RESET BUFFER POINTER + DCA ABSOP /FORCE NEW ABS OUTPUT CONTROL + JMP I OUTBLK +MOUBUF, OUBUF-1 +/ +TYPCOD, 2500 /UNDEFINED + 0000 /ADDRESS + 3000 /XTERNAL + 0300 /COMMON + 2300 /SECTION + -1 /? + -1 /? + 7000 /8-M0DE SECTION + 3200 /8-MODE PAGE0 COMMON SECTION + 0600 /8-MODE FIELD1 SECTION + BORG, 0 + CDF FLD0 + TAD LOCTR1 + RTR + RTR + AND [177 + TAD (ESDBUF-1 /POINT INTO ESD TABLE + DCA LTEMP + TAD I LTEMP + TAD (4 /ADDRESS VALUE + DCA LTEMP + CDF FLD1 + TAD LOCTR1 + AND [7 /GET ADDR BITS ONLY + DCA BOTMP /SAVE EM + TAD I LTEMP /OLD HIGH VALUE BITS + AND [7 + CIA + TAD BOTMP /COMPARE THEM + SPA + JMP BOXIT /NO UPDATE REQUIRED + SNA CLA + JMP BOCHKL /NO DIFFERENCE YET + TAD LOCTR1 + DCA I LTEMP /RESET TO NEW HIGH + ISZ LTEMP + JMP BOSETL /SKIP OVER TEST +BOCHKL, ISZ LTEMP /POINT TO LO-ORDER + TAD I LTEMP + CIA CLL + TAD LOCTR2 /COMPARE LOW ORDERS + SNL CLA + JMP BOXIT /NO REPLACE +BOSETL, TAD LOCTR2 + DCA I LTEMP +BOXIT, CLA + CDF FLD0 + JMP I BORG /WHEW! +BOTMP= EXTMP + PAGE + NEWESD, 0 + TAD ESDNO + TAD (-177 /CHECK LIMIT + SPA CLA + JMP .+3 + JMS I [ERMSG1 /TOO MANY + 3023 /*XS* + ISZ ESDNO /BUMP COUNT + TAD PASSNO /DON'T CHANGE TABLE AFTER PASS 1 + SMA CLA + JMP I NEWESD + TAD ESDNO + TAD (ESDBUF-1 /INDEX BUFFER + DCA ESDTMP + CDF FLD1 + TAD I OLDN3 /GET POINTER TO THIS SYMBOL + CDF FLD0 + DCA I ESDTMP + TAD ESDTMP + TAD [200 + DCA ESDTMP /NOW ADDRESS CHAR TABLE + TAD BUCKET + DCA I ESDTMP + JMP I NEWESD +ESDTMP= EXTMP +/ +/ RELOCATION CONTROL PSEUDO-OPS +/ +ENTRX, JMS I [GETNAM /NAME OF ENTRY POINT + JMP ESDERR + JMS I [LOOKUP /FIND IT + JMP QENT /UNDEFINED + CLL RAR /MUST BE USER ADDR TYPE + SNA CLA + TAD I X10 /LOOK AT ESD + AND [7770 + SZA CLA /IS IT RELOCATABLE? + JMP OKENT /YES +QENT, JMS I [ERMSG /NO MESSAGE ON PASS 1 + 1105 /*IE* +OKENT, JMS NEWESD /CREATE AN ENTRY FOR IT + JMP I [NEXTST + / +EXTRNX, CLA STL RTL + DCA STYPE /EXTERNS ARE TYPE 2 + JMS I [GETNAM + JMP ESDERR + JMS I [LOOKUP + JMS CRESD /IF UNDEFINED, DEFINE IT + CLL RTR /IF DEFINED, CHECK LEGALITY + SZA CLA +ESDERR, JMS I [ERMSG + 0523 /*ES* + JMP I [NEXTST +/ + CLA IAC /FIELD1 SECT=11 + IAC /COMMZ SECT=10 +SECT8X, TAD [7 + JMP COMMX+1 +SECTX, CLA IAC +COMMX, TAD (COMMN /GET DESIRED CODE + DCA STYPE /FOR SECTION TYPE + JMS I [GETNAM + DCA BUCKET /IF NO NAME, BLANK COMMON + JMS I [LOOKUP + JMP NEWSCT /UNDEFINED + CIA /OLD FRIEND + TAD STYPE /SAME? + SNA CLA + JMP SETSCT /YUP, DO IT + JMP ESDERR +/ +CRESD, 0 + JMS NEWESD /CREATE NEW ESD ENTRY + CDF FLD1 + TAD I LTEMP /SET TYPE CODE + AND [7700 + TAD STYPE + DCA I LTEMP + ISZ LTEMP + TAD ESDNO + CLL RTL /ESD NO TO SYMBOL VLAUE + RTL + DCA I LTEMP + CDF FLD0 + JMP I CRESD +/ +NEWSCT, JMS CRESD /CREATE AN ESD +SETSCT, JMS I (BORG /ADJUST LOC CTR'S + CDF FLD1 + TAD I X10 /GET NEW LOC CTR VALUE + DCA LOCTR1 + TAD I X10 + DCA LOCTR2 /LOW LOC CTR + CDF FLD0 + JMP PUTORG + / +ORGX, JMS I (ADRGET /GET ORG EXPR + JMS I (BORG + TAD EXPVAL+1 + AND [7770 /DOES IT HAVE AN ESD? + SNA CLA + TAD LOCTR1 /IF NOT, KEEP CURRENT ESD + AND [7770 + TAD EXPVAL+1 + DCA LOCTR1 /RESET PC + TAD EXPVAL+2 + DCA LOCTR2 +PUTORG, TAD PASSNO /OUTPUT ON PASS 2 ONLY + SZA CLA + JMP I [NEXTST + DCA ABSOP /CLEAR ABS OUTPUT SW + CLA STL RTL + JMS I (FULCHK /ROOM FOR MORE? + TAD LOCTR1 + RTR + RTR /GET ESD + AND [177 + TAD (TTORG + DCA I OUTPTR + TAD LOCTR1 + AND [7 /FIELD BITS + DCA I OUTPTR + TAD LOCTR2 /ADDRESS + DCA I OUTPTR + JMS I (FULCHK + JMP I [NEXTST + PAGE /> + / +/ VARIOUS PSEUDO-OP HANDLERS +/ +LSTONX, TAD SYONLY /ENABLE LISTING UNLESS SYM MAP ONLY +LSTOFX, DCA LISTSW + JMP I [NEXTST +/ +DECX, CLA IAC +OCTALX, DCA RADIX + JMP I [NEXTST +/ +TEXTX, JMS I [GETCHR /GET DELIMITER + JMP I [NEXTST /NULL STMT + CIA + DCA EXTMP /SAVE - DELIM +LOOP6B, JMS GETCHT /GET HIG ORDER CHAR + JMP I [NEXTST + JMS I [R6L /SHIFT IT UP + DCA LTEMP /SAVE HALF + JMS GETCHT /GET LOWER CHAR + JMP OUTTXT /GO PUT LAST + TAD LTEMP /PUT 2 CHARS TOGETHER + JMS I [OUTWRD /OUTPUT WORD + JMP LOOP6B /LOOP +OUTTXT, TAD LTEMP /PUT OUT HALF WORD + JMS I [OUTWRD /OR ZERO WORD + JMP I [NEXTST +GETCHT, 0 /GET CHAR FOR TEXT STMT + ISZ NCHARS /BUMP COUNT + SKP + JMP I GETCHT /END OF TEXT + TAD I CHRPTR /GET CHAR + DCA BUCKET /SAVE IT + TAD BUCKET /IS IT THE DELIM ? + TAD EXTMP + SNA CLA + JMP I GETCHT /YES, RETURN NO SKIP + ISZ GETCHT /BUMP RETURN + TAD BUCKET /GET CHAR + AND [77 /LOW 6 BITS + JMP I GETCHT /RETURN + / +/ CONDITIONAL ASSEMBLY HANDLERS +/ +IFNZRX, CLA CMA +IFZROX, JMS GETCON /GET CONDITION EXPR + TAD EXPVAL+1 /HIGH ORDER + AND [7 + SNA + TAD EXPVAL+2 /LOW ORDER +SWTCH, SNA CLA + JMP TRUE /PRESENT CONDITION OF ASMOF IS OK +FALSE, TAD ASMOF /GOTTA REVERSE IT + CMA + DCA ASMOF /THAT DOES IT +TRUE, CDF FLD0 + JMS I [GETCHR + JMP BADCND /FORGOT THE ANGLE + TAD [-240 /IGNORE BLANK, IF ANY + SNA + JMP TRUE /TRY AGAIN + TAD (240-274 + SNA CLA + JMP I (ASMBL /GO FROM HERE + JMS I [BACK1 /LET SOMEONE ELSE WORRY ABOUT IT + JMP BADCND +/ +GETCON, 0 + DCA ASMOF /SET INITIAL TRUTH + JMS I [EXPR /COLLECT EXPR + JMP OKCND /BAD MAY MEAN GOOD +BADCND, JMS I [ERMSG /BUT GOOD MEANS BAD + 1103 /*IC* + DCA ASMOF /ENABLE ASSEMBLY + JMP I (ASMBL +OKCND, TAD EXPSW /WAS THERE AN EXPR, AT LEAST? + SNA CLA + JMP I GETCON /YES + JMP BADCND +/ +IFNEGX, CLA CMA +IFPOSX, JMS GETCON + CLA CLL IAC RTL /4 + AND EXPVAL+1 /SIGN OF EXPR + JMP SWTCH /GO FROM THERE +/ +IFNDFX, CLA CMA +IFREFX, DCA ASMOF + JMS I [GETNAM /GET SYMBOL NAME + JMP BADCND /GOTTA GIVE SOMETHING + JMS I [FIND /IS IT KNOWN TO US? + JMP FALSE /NOT REFERENCED YET + SNA CLA /SKIP IF DEFINED + DCA ASMOF /ELSE ASSEMBLE + JMP TRUE + IFSWX, CLA CMA +IFNSWX, DCA ASMOF + TAD (7642 /ADDRESS OF OPTION WORDS + DCA WORD2 /A TEMP + JMS I (LETTER /ALLOW LETTER + JMP .+4 /AC BETWEEN 1 AND 32 + JMS I (DIGIT /OR NUMBER + JMP BADCND /ALL ELSE IS BAD + TAD (33 /MAKE 0 = Z+1 + ISZ WORD2 /BUMP POINTER + TAD (-14 /IS IT IN THIS WORD? + SMA SZA + JMP .-3 /NO, POINT TO NEXT + CIA + CMA STL /BIT COUNT AWAY FROM LINK + DCA WORD1 + RAL /SHIFT + ISZ WORD1 /COUNT + JMP .-2 + CDF 10 /OPTIONS FIELD + AND I WORD2 /GET SELECTED BIT + JMP SWTCH /AND TEST IT +/ +ZBLKX, JMS I (ADRGET /EVALUATE EXPR + TAD EXPVAL+2 + CIA + DCA ZBCNT /HOLD COUNT + TAD LISTSW /SAVE LISTSWITCH + DCA ZBTMP + JMS I [OUTWRD /PUT A WORD + DCA LISTSW /NO LIST AFTER FIRST + ISZ ZBCNT /COUNT THEM + JMP .-3 /MORE + TAD ZBTMP /RESTORE + DCA LISTSW /LISTING + JMP I [NEXTST +ZBCNT= EXTMP +ZBTMP= EXTMP2 + PAGE + + + PTP=20 + DCB=7760 + INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER + OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER +IN7400, 7400 +NINCTL, INCTL+1 +NINREC, INRECS +IOPEN, 0 + TAD (7617 + DCA INFPTR /RESET FILE POINTER + JMS INNEWF /FETCH NEW HNDLR, ETC + /WHILE USR IS STILL IN CORE + CLA CMA + DCA INCHCT /FORCE A READ ON NEXT CHAR + JMP I IOPEN + +ICHAR, 0 +IN7600, 7600 +INCHAR, CDF INFLD + ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH + ISZ INCHCT +INJMPP, JMP INJMP + TAD INEOF + SZA CLA /DID LAST READ GIVE EOF ? +GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE + TAD INCTR + CLL + TAD NINREC + SNL + DCA INCTR /RESTORE INCR IF NOT OVERFLOWED + SZL /IS THIS THE LAST READ? + ISZ INEOF /YES - SET END-OF-FILE FLAG + CLL CML CMA RTR /MAKE CONTROL WORD + RTR /FROM THE AMOUNT OF THE OVERFLOW + RTR /(IF ANY) AND THE STANDARD CNTRL WD + TAD NINCTL + DCA INCTLW + CDF + JMS I INHNDL /CALL THE DEVICE HANDLER +INCTLW, 0 +INBUFP, INBUF +INREC, 0 + JMP INERRX /SOME KIND OF HANDLER ERROR +INBREC, TAD INREC + TAD NINREC + DCA INREC /UPDATE THE RECORD NUMBER + TAD INCTLW + AND IN7600 + CLL RAL + TAD INCTLW + AND IN7600 + CMA + DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT + TAD INJMPP + DCA INJMP /RESET THE CHARACTER SWITCH + TAD INBUFP + DCA INPTR /AND THE WORD POINTER + JMP INCHAR /MAKE BELIEVE THIS NEVER HAPPENED +INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE + SMA CLA /WHICH TYPE WAS IT ? + JMP INBREC /END OF FILE - RESUME PROCESSING + JMP I [IOERR /BADDIE, GIVE ERROR MESSAGE +INJMP, HLT /THIS IS THE 3 WAY CHARACTER SWITCH + JMP ICHAR1 + JMP ICHAR2 + TAD INJMPP + DCA INJMP + TAD I INPTR + AND IN7400 + CLL RTR + RTR /COMBINE HIGH-ORDER FOUR BITS OF + TAD INCTLW + RTR /THE 2 WORD TO FORM THE 3RD CHAR + RTR + ISZ INPTR + JMP INCOMN +ICHAR2, TAD I INPTR + AND IN7400 + DCA INCTLW /SAVE THE HI ORDER BITS FOR THE 3RD + ISZ INPTR /BUMP THE WORD POINTER +ICHAR1, TAD I INPTR +INCOMN, AND (177 /PHPH WAS 277 + TAD (-32 /PHPH WAS 232 + SNA /IS THE CHARACTER A ^Z? + JMP GETNEW /YES - GET A NEW FILE + TAD (232 /RESTORE THE CHARACTER /PHPH NOW WE HAVE PARITY ON! + CDF + JMP I ICHAR /AND RETURN +INFPTR, 7617 +INEOF, 1 /PARAMETERS ARE SET UP SO THAT +INCHCT, /IOPEN IS UNNECESSARY. +INNEWF, -1 + TAD NINDEV + DCA INHNDL /INITIALIZE HANDLER ADDRESS + CDF 10 + TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY + CDF + SNA /ANY MORE? + JMP I (ENDX /NO MORE INPUT + CIF 10 + JMS I USR + 1 /ASSIGN, FETCH HANDLER + +INHNDL, 0 + JMP I [IOERR /HUH? + CDF 10 + TAD I INFPTR + AND (7760 /GET LENGTH PART OF WORD + SZA /LENGTH OF 0 MEANS LENGTH GE 256 + TAD [17 /ADD HIGH ORDER BITS + CLL CML RTR + RTR + DCA INCTR /STORE LENGTH OF FILE + ISZ INFPTR + TAD I INFPTR + CDF + DCA INREC /STARTING RECORD NUMBER OF FILE + ISZ INFPTR + DCA INEOF /ZERO END-OF-FILE FLAG + JMP I INNEWF +INCTR, 0 +INPTR, 0 +OUFNAM, 0;0;0;0 /OUTPUT FILE NAME +NINDEV, INDEVH + PAGE + OOPEN, 0 + TAD OUFILE /INCR OUTPUT FILE POINTER + TAD (5 + DCA OUFILE + CDF 10 + TAD I OUFILE /GET DEVICE CODE, LEN + DCA OUELEN /HOLD IT A MO + JMS I (OFNAME /GET FILE NAME INTO FIELD 0 + TAD OUELEN /CHECK FOR NULL FILE + SNA CLA + JMP ONOFIL /INHIBIT OUTPUT + JMS GETUSR /LOAD USR IF NOT ALREADY IN + TAD OUNAME /RESET ENTER CALL + DCA OUBLK + TAD NOUDEV + DCA OUHNDL + TAD OUELEN /THE UNIT + CIF 10 + JMS I USR + 1 /ASSIGN, FETCH HANDLER +OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY + JMP I [IOERR /HUH? + TAD OUELEN /UNIT AGAIN + CIF 10 + JMS I USR + 3 /ENTER OUTPUT FILE +OUBLK, OUFNAM /REPLACED WITH STARTING BLOCK +OUELEN, 0 /REPLACED WITH LENGTH OF HOLE + JMP I [IOERR /YOU BLEW IT!!! + DCA OUCCNT + DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG + JMS I (OUSETP + ISZ OOPEN + JMP I OOPEN +ONOFIL, ISZ I (OUTINH + JMP I OOPEN +OUTDMP, 0 + DCA OUCTLW /STORE THE CONTROL WORD + TAD OUCCNT + SNA + ISZ OUCTLW + TAD OUBLK + DCA OUREC /COMPUTE STARTING BLOCK + TAD OUCTLW + JMS I [R6L + AND [17 /COMPUTE THE NUMBER OF RECORDS + TAD OUCCNT /UPDATE SIZE OF FILE + DCA OUCCNT + TAD OUCCNT + CLL CML + TAD OUELEN + SNL SZA CLA /EXCEED GIVEN LENGTH ? + JMP I [IOERR /YES - ERROR + CDF + JMS I OUHNDL +OUCTLW, 0 +LOUBUF, OUBUF +OUREC, 0 + JMP I [IOERR + JMP I OUTDMP +OCLOSE, 0 + JMS GETUSR /ENSURE USR IN CORE + IFNZRO RALF < + TAD PASSNO + SZA CLA + JMP .+6 + TAD (377 + JMS I (FULCHK /DUMP LAST BLOCK + TAD OUCCNT /SAVE FILE LENGTH + DCA I (OUTBLK /FOR CHAIN + JMP NODUMP > + JMS I (OTYPE + AND (770 + TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT + SZA CLA /AND SKIP ^Z OUTPUT IF TRUE + TAD (232 /OUTPUT A ^Z + JMS I [OCHAR +FILLLP, JMS I [OCHAR + JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE + SPA CLA + TAD [100 + TAD [77 + AND I (OUDWCT + SZA CLA /UP TO THE BOUNDARY YET? + JMP FILLLP /NO - FILL WITH ZEROS + TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT + TAD (OUCTL&3700 + SNA /A FULL WRITE LEFT? + JMP NODUMP /YES DON'T DO IT + TAD (4000+OUFLD /PUT IN FIELD AND WRITE BITS + JMS OUTDMP +NODUMP, CIF CDF 10 + TAD I OUFILE + CDF + JMS I USR + 4 /CLOSE THE OUTPUT FILE +OUNAME, OUFNAM /POINTER TO OUTPUT FILE NAME +OUCCNT, 0 + JMP I [IOERR /ERROR WHILE CLOSING - BAD!! + JMP I OCLOSE /ALL DONE +NOUDEV, OUDEVH + / +/ LOAD USR IF NOT IN CORE ALREADY +/ +GETUSR, 0 + TAD USR /CURRENT CALL ADDR + SMA CLA + JMP I GETUSR /WE GOT IT + CIF 10 + JMS I USR /THE ANSWERING SERVICE + 10 /CALLS THE SR + TAD [200 + DCA USR /RESET THE CALL ADDRESS + JMP I GETUSR /JES FINE + PAGE + FULCHK, 0 + IFNZRO RALF < +/ +/ IF THE RELOCATABLE BINARY OUTPUT +/ BLOCK IS FULL (WITHIN THE CONTENTS OF THE AC) +/ FILL THE REST WITH NOP CODES AND OUTPUT THE +/ BLOCK. +/ + TAD OUTPTR + TAD KOUBUF + SPA CLA + JMP I FULCHK +FULLUP, TAD OUTPTR + TAD KOUBUF + SMA CLA + JMP .+4 + CLA IAC + DCA I OUTPTR + JMP FULLUP + JMS I (OUTBLK + JMP I FULCHK +KOUBUF, -OUBUF-377 > +/ +/ +/ GET SIGN CHARACTER IF ANY +/ BUMP LASTOP IF MINUS +/ +GETSGN, 0 + JMS I [GETCHR + JMP I GETSGN + TAD (-255 /MINUS? + SNA + ISZ LASTOP + SZA + CLL CMA RAR /IF IT WAS PLUS, BECOMES 0 + SZA CLA /SKIP IF PLUS OR MINUS + JMS I [BACK1 /OTHERWISE PUT IT BACK + JMP I GETSGN + / AS PER RICHIE LARY +/ +/ SINGLE AND DOUBLE PRECISION +/ FLOATING POINT INPUT +/ +/ +EX, TAD M3 +FX, TAD M3 + DCA DESW /STORE LENGTH + TAD (-7 + JMS CLEAR /CLEAR FAC+OP + DCA LASTOP + JMS GETSGN /GET SIGN + STA /CLA CMA + DCA DPSW /SET NO DP +GETD, DCA DCNT + JMS I (DIGIT /GET A DIGIT + JMP LOOKP /NO + DCA OTEMP /SAVE IT + JMS I (FMPTEN /MULT FAC*10 + JMS CLEAR + TAD OTEMP + SZA + JMS I (FAD /ADD DIGIT TO FAC IF NOT= 0 + TAD DPSW + CMA + TAD DCNT /BUMP IF FP SEEN + JMP GETD + LOOKP, JMS I [GETCHR + JMP OVER /DONE + TAD (-256 + SNA + JMP DECPT + TAD (256-304 + CLL RAR + SNA CLA + JMP I (EXPON /E OR D +DEXERR, JMS I [ERMSG + 0620 /FP + JMP NOTNEG +DECPT, ISZ DPSW + JMP DEXERR /2 PERIODS + JMP GETD +/ +OVER, TAD DCNT /EXPON COMES HERE W EXP IN AC + SNA + JMP NOSCAL /NO SCALING NEEDE + CLL + SMA + CIA CML /SIGN IN LINK,MAGNITUDE IN AC + DCA DCNT /AS A COUNT + SNL + TAD (TENTH-TEN /OFFSET KLUDGE + DCA OTEMP +SCALUP, TAD OTEMP + JMS I (FMPTEN /MULT BY 10.0 OR 0.1 + ISZ DCNT + JMP SCALUP +NOSCAL, JMS CLEAR + STL RAR + DCA OP+5 /ROUNDING CONSTANT + JMS I (ADD + TAD AC + SZA CLA + JMS I (NORM /WATCH IT! + DCA AC+5 + TAD LASTOP + SNA CLA /SIGN -? + JMP NOTNEG /NO + TAD (AC+5 + JMS I (SETUP +ACNGLP, RAL + TAD I P /NEGATE FAC + CLL CIA + DCA I P + STA + TAD P + DCA P + ISZ CT + JMP ACNGLP +NOTNEG, JMS CLEAR /SET UP X10 + TAD I X10 + JMS I [OUTWRD + ISZ DESW /OUTPUT # + JMP .-3 + JMP I [NEXTST + CLEAR, 0 /AC MAY NOT BE 0 + TAD (-7 + DCA CT + TAD (OPX-1 + DCA X10 + DCA I X10 + ISZ CT + JMP .-2 + JMP I CLEAR + DCNT=FULCHK + DPSW=NCTMP + DESW=OPCODE + PAGE + OVBUFR=. +FAD, 0 /FLOATING ADD DIGIT IN AC + DCA OP + TAD (13 + DCA OPX +ALNLP, TAD OPX + CIA + TAD ACX + SNA /ALIGNED? + JMP GOADD /YES + SMA CLA + TAD (OPX-ACX + JMS RSHFT /NO-SHIFT 1 OF THEM RIGHT 1 + JMP ALNLP /TRY AGAIN +GOADD, JMS ADD /ADD FRACTIONS + JMS NORM /NORMALIZE RESULT + JMP I FAD /RETURN +/ +RSHFT, 0 /SHIFT RIGHT + TAD (ACX /DEFAULT IS FAC + JMS SETUP + ISZ I P /BUMP EXPONENT +RSLP, ISZ P + TAD I P + RAR + DCA I P + ISZ CT + JMP RSLP + JMP I RSHFT +/ +ADD, 0 /ADD TO FAC + TAD (OP+5 + DCA PP2 + TAD (AC+5 + JMS SETUP +ADDLP, RAL /CARRY + TAD I PP2 + TAD I P + DCA I P /ADD ONE WORD + STA + TAD P /COMPLEMENT LINK + DCA P + STA + TAD PP2 /COMPLEMENT LINK + DCA PP2 + ISZ CT + JMP ADDLP + JMP I ADD + NORM, 0 /NORMALIZE FAC + TAD AC + SPA CLA /CHECK FOR OVERNORMALIZATION + JMS RSHFT /AND CORRECT +NORMLP, STL RTR + AND AC + SZA CLA /NORMALIZED? + JMP I NORM /YES + TAD (AC+5 + JMS SETUP +LSLP, TAD I P + RAL /LEFT SHIFT + DCA I P /FAC 1 BIT + STA CML /COMPLEMENT LINK + TAD P + DCA P + ISZ CT + JMP LSLP + STA + TAD ACX /BUMP EXP + DCA ACX /DOWN 1 + JMP NORMLP + FMPTEN, 0 /FLTG MULTIPLY BY 10.0 OR .1 + TAD (TEN + JMS SETUP + TAD AC + SNA CLA /AC=0 MEANS RESULT=0 + JMP I FMPTEN + TAD I P + TAD ACX /FUDGE FAC + DCA ACX /EXPONENT + TAD (MUX + DCA X11 + TAD (ACX + DCA SETUP + TAD (OPX + DCA X10 + DCA MUX /CLEAR MULT TEMP EXP +MPLP1, ISZ SETUP + TAD I SETUP /MOVE FAC + DCA I X10 /TO OP + DCA I SETUP /CLEAR FAC + ISZ P + TAD I P /MOVE MULTIPLIER + DCA I X11 /TO MULT TEMP + ISZ CT + JMP MPLP1 +/ +MPLP2, TAD (MUX-ACX + JMS RSHFT /SHIFT MULT TEMP RIGHT 1 + SZL + JMS ADD /ADD IF LOW ORDER BIT WAS 1 + JMS RSHFT /SHIFT FAC RIGHT + TAD MU+5 + SZA CLA /12 SUCCESSIVE 0 BITS + JMP MPLP2 /IN MULTIPLIER MEANS DONE + JMS NORM + JMP I FMPTEN +/ +SETUP, 0 /COMMON CODE + DCA P + TAD (-6 + DCA CT + CLL + JMP I SETUP +/ +MUX, 0 /MULT TEMP +MU, ZBLOCK 6 + CT=CPTMP + P=EXTMP + PP2=PAGEN + PAGE + IFNZRO RALF < +ESDBUF, PNDL+6 /ESD ENTRY FOR SECTION #MAIN + PNDL /DITTO FOR BLANK COMMON + ZBLOCK 376 /FILL TO 400 LOCS +/ +/ BEGIN OF PASS 2: +/ DUMP EXTERNAL SYMBOL DICTIONARY +/ DURING PASSES 2 AND 3, THIS IS INPUT BUFFER +/ +DMPESD, CLA CLL CMA RAL /-2 + DCA EXTMP2 /PASS CONTROL + TAD (3 /RALF OUTPUT IDENTIFIER + DCA I OUTPTR + TAD VERS + DCA I OUTPTR /THIS MAKES 6-WORD ENTRIES + TAD DPFLG /4000=NEED DP HARDWARE + DCA I OUTPTR /EXACTLY FILL A BLOCK + DCA I OUTPTR +ESDSCN, TAD (ESDBUF-1 + DCA X10 /POINT TO POINTERS + TAD (ESDBUF+177 + DCA X12 /POINT TO INITAIL CHARS + TAD ESDNO + CIA + DCA EXTMP +ESDLUP, TAD (-3 + DCA LTEMP /NAME LENGTH COUNT + TAD (EQUN-1 /WHERE WE'LL KEEP THE NAME + DCA X13 + TAD I X10 /GET POINTER + DCA X11 + TAD I X12 /GET FIRST CHAR + SNA /BLANK BECOMES # + TAD (43 +ESDNLP, JMS I [R6L + DCA EQUN+2 + CDF FLD1 + TAD I X11 /GET NEXT PAIR FROM SYMBOL TABLE + DCA EQUN+3 /HOLD IT + CDF FLD0 + TAD EQUN+3 + JMS I [R6R /GET LEFT CHAR + TAD EQUN+2 /COMBINE THEM + DCA I X13 + TAD EQUN+3 /GET RIGHT HALF OF PAIR + AND [77 + ISZ LTEMP + JMP ESDNLP + AND [37 /DROP FORCE BIT FROM TYPE + DCA EQUN+3 + CDF FLD1 + TAD I X11 /HIGH VALUE + DCA EQUN+4 + TAD I X11 /LOW VALUE + DCA EQUN+5 + CDF FLD0 + TAD EXTMP2 /WHAT PASS IS THIS? + RAR /LINK 0 IF FIRST, 1 IF SECOND + SNL CLA + JMP NOENTS /FIRST, ENTRYS NOT OUTPUT + TAD EQUN+3 /OUTPUT ENTRIES ONLY ON 2ND + CLL RAR + SNA CLA + SNL + JMP ESDLND /NO GO + JMP ESDOUT /YES, PUT IT +NOENTS, TAD EQUN+3 /EXT, COMM, OR SCTN + CLL RAR + SNA /SKIP IF OK + JMP ESDLND /UNDEFINED OR ENTRY + RAR + SNA CLA + JMP ESDOUT /IF EXTERN, DO IT + TAD EQUN+4 /IF SECTION, CHECK + AND [7 /THAT LENGTH + SNA /IS NON-ZERO + TAD EQUN+5 + SNA CLA + JMP ESDLND /ZERO LEN JUST GETS IN THE WAY +ESDOUT, TAD (EQUN-1 + DCA X13 + TAD (-6 + DCA LTEMP + TAD I X13 /GET OUTPUT WORD + DCA I OUTPTR + ISZ LTEMP + JMP .-3 /6-WORD ENTRIES + TAD OUTPTR + TAD OUTBUF + SPA CLA + JMP ESDLND /NOT END OF BLOCK YET + JMS I (OUTBLK + TAD (3 + DCA I OUTPTR + DCA I OUTPTR + DCA I OUTPTR + DCA I OUTPTR +ESDLND, ISZ EXTMP /GO THRU ESD LIST + JMP ESDLUP + ISZ EXTMP2 /WHOLE LIST TWO PASSES + JMP ESDSCN + TAD (-6 /THEN STORE END-OF-ESD + DCA LTEMP + DCA I OUTPTR + ISZ LTEMP + JMP .-2 + TAD (377 /FORCE BLOCK OUTPUT + JMS I (FULCHK + CDF FLD1 /THEN DEFAULT ORG + TAD I (LMAIN /IF MAIN LEN .NE. 0 + AND [7 + SNA + TAD I (LMAIN+1 + CDF FLD0 + SNA CLA + JMP I (RESET /FIRST SECTION WILL GET IT + TAD (TTORG+1 /ORG TO ZERO OF MAIN + DCA I OUTPTR + DCA I OUTPTR + DCA I OUTPTR + JMP I (RESET +OUTBUF, 1001 + PAGE /> + / +/ INITIALIZATION CODE +/ +BEGIN, JMP CHNIN /IF ENTERED BY CHAIN +GCMND, CIF 10 /IF ENTERED BY .R, ETC + JMS I USR /USR IS LEFT OVER + 5 /DECODE + IFZERO RALF < + 620 /DEFAULT EXT = .FP> + IFNZRO RALF < + 2201 /DEFAULT EXT = .RA> + DCA I (RETSYS /NO NEED FOR IT IF NOT CHAINED +CHNIN, JMS I (7607 + 4100 /TEMP WRITE OUT OVERLAY + 6600 /NOW AT 6600 + 40 /TO SYS SCRATCH BLK 40 + JMP I (7605 /ERROR + CDF 10 + IFNZRO RALF < + TAD I [7600 /BIN FILE UNIT + AND NP17 + SNA /IS THERE ONE? + JMP DEFBIN /NO, SET DEFAULT + TAD (7757 /POINT TO DEV CTRL WORD + DCA WORD1 + TAD I WORD1 + SPA CLA + JMP OKBIN /FILE-STRUCTURED, OK + CDF 0 + JMS I (PRTXT /TYPE MESSAGE + TXBBIN-1 + -TXBLN + JMS I [CRLF + JMP GCMND /TRY AGAIN +/ +DEFBIN, CLA IAC /DEFAULT BIN UNIT IS SYS + DCA I [7600 /SET UNIT + TAD [7600 + DCA X10 /SET POINTER + TAD (0617 /FO + DCA I X10 + TAD (2224 /RT + DCA I X10 + TAD (2216 /RN + DCA I X10 /FORTRN. + DCA I X10 + CDF 0 + JMP I (NOEXT /NOW, OPEN THE FILE> + OKBIN, CDF 0 /HAVE TO GO TO ANOTHER PAGE + JMP I (NOKBIN /ONLY SO MANY PATCHES TO A PAGE +GBIN, CDF 10 + TAD I (7644 + AND (20 + SNA CLA + ISZ SYONLY /=NO SLASH T + CDF 0 + JMS I (NEW /**SEE IF NEED 2 PG HANDLER + 7600 + JMS I (OOPEN + DCA BFILE + IFNZRO RALF < + TAD R41 /L OR G SWITCH** + CDF 10 + AND I (7643 /TEST /L OR /G SWITCH + CDF 0 + SNA CLA /** + JMP KCHN /KILL CHAIN, IT'S SET + CIF 10 + CLA IAC /UNIT IS SYS + JMS I USR + 2 /LOOKUP +LBLK, LDRNAM /LOADER.SV +R41, 41 /** + JMP KCHN /NO FIND, NO CALL + TAD LBLK /STARTING BLOCK + DCA I (LDRBLK /FOR CHAIN + TAD I (OUBLK /OUTPUT STARTING BLOCK + DCA I (PASBLK /SAVED FOR CHAIN TO LOADER + CLA CMA /ENABLE CHAIN +KCHN, DCA I (CHNSW /OR KILL IT, WHATEVER> + JMS I (INCHK /NOW CHECK INPUT DEVICES FOR 2 PG HANDLERS + JMS I (INNEWF /GET INPUT HANDLER + CLA CMA + DCA I (INCHCT /SET INITIAL COUNT + TAD NP7700 + DCA USR /FROM NOW ON, USE THE HIGH CALL + JMS I (NEW + 7605 /CHECK LIST DEV TOO** + CDF 10 + TAD I (7611 /LST FILE EXT + SNA + TAD (1423 /LS DEFAULT + DCA I (7611 + TAD I (7666 /GET DATE + DCA WORD1 +/ +/ MOVE SYMBOL TABLE TO ITS PROPER LOCATION +/ + TAD (1777 + DCA X10 /LOADED ADDRESS OF SYMBOL TABLE + CLA CMA + DCA X11 /WE MOVE IT TO ASSEMBLED ADDRESS + TAD (-FREE /LENGTH OF SYMBOL TABLE + DCA WORD2 /SET COUNT + TAD I X10 + DCA I X11 /THIS SAVES SWAPS OF USR + ISZ WORD2 + JMP .-3 + CDF 0 + JMP I (GDATE /CHECK FOR FPP PRESENCE** + PAGE + / +/ PUT THE DATE INTO THE PAGE HEADING +/ +GDATE, TAD (1000 + DCA I (7746 /SET NO-RESTART BIT + /PUT VERNUM IN TITLE LINE + TAD VMSG + DCA I (VMTXT + TAD VMSG+1 /PATCH LEVEL + DCA I (VMTXT+1 + DCA OCNT /CLEAR OCNT + TAD WORD1 /RE-GET DATE + SNA + JMP I (NEWLIN /GOLLY, AND ALL THIS CODE WASTED + AND (370 + CLL RTR + RAR + TAD (-12 + SPA + JMP .+3 + ISZ OCNT + JMP .-4 + TAD (72 /60+12 + DCA OTEMP + TAD (TITDAT-1 + DCA X11 + TAD OCNT + JMS I (R6L + SZA + TAD (6000 + TAD OTEMP + DCA I X11 + TAD WORD1 + AND (7400 /MONTH + JMS I (R6L + TAD (MONTHS-3 + DCA X10 + TAD I X10 + DCA I X11 + TAD I X10 + DCA I X11 + DCA OCNT + TAD WORD1 + AND [7 + DCA OTEMP + TAD I (7777 + AND (600 + RTR CLL + RTR + TAD OTEMP + TAD (106 + TAD (-12 + SPA + JMP .+3 + ISZ OCNT + JMP .-4 + TAD (72 + DCA OTEMP + TAD (5560 + TAD OCNT + DCA I 11 + TAD OTEMP + JMS I (R6L + TAD (40 + DCA I X11 + JMP I (NEWLIN +VMSG, VNUM&70^10+VNUM&707+6060 + PATCH&77^100+40 + IFNZRO RALF < +LDRNAM, TEXT "LOAD@@SV" +TXBBIN, TEXT "BIN OUT DEV NOT FILE-STRUCTURED" +TXBLN= .-TXBBIN > +MONTHS, TEXT "-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC" + PAGE +/PAGE FOR NEW CODE REQUIRED FOR OS/8 FORTRAN +NEW, 0 + TAD NT2 /CHECK IF ALREADY CHECKED + SZA CLA + JMP NEWDON + TAD I NEW /NO. GET THE DEV TO CHECK + DCA NTEMP + CDF 10 + TAD I NTEMP /GET DEV.NUM + AND [17 + DCA NT1 /INCHK NEEDS TO KNOW TOO + TAD NT1 + SNA /IF 0,THEN NO DEVICE + JMP NEWDON + DCA NTEMP + CLA CMA + TAD I (37 /GET PTR TO DEV TBL + TAD NTEMP + DCA NTEMP /PTS TO ENTRY IN DEV TBL + TAD I NTEMP + CDF 0 + SMA CLA + JMP FIX /NOT A 2 PG HANDLER + TAD (6377 /FIX ALL LOCATIONS THAT REFER TO +/THE BUFFER VARIABLES. +/THE CHANGES ARE: +/OUBUF=6000,LINE=6400,INDEVH=6600,OUDEVH=7200 +/INRECS=1,INCTL=200 + DCA I (BLINE + TAD (6000 + DCA I (NOUBUF + IFNZRO RALF < + TAD (5777 + DCA I (MOUBUF > /FLAP DOESN'T USE ALL THE RALF LOCNS + TAD (6601 + DCA I (NINDEV + TAD (201 + DCA I (NINCTL + JMS TPNSH /TWO-PAGE NON-SYSTEM HANDLER + DCA I (NINREC + TAD (6000 + DCA I (LOUBUF + TAD (7201 + DCA I (NOUDEV + TAD (5777 + DCA I (OUTPTR + TAD (6377 + DCA I (CHRPTR + IFNZRO RALF < + TAD (1401 + DCA I (KOUBUF > + TAD (7201 +FIX, DCA NT2 /SET SO IF DID 2 PGS., DONT DO IT AGAIN +NEWDON, ISZ NEW /GET CORRECT ADDR + JMP I NEW +NTEMP, 0 +NT1, 0 /DEV. NUM. +NT2, 0 /0 IF NO 2PG HANDLERS YET +INCHK, 0 /CHECK THE INPUT DEVICES + JMS NEW +INLOC, 7617 + TAD INLOC + DCA NEXTIN +ANOTH, TAD NT1 + SNA CLA /SKIP IF FILE USED + JMP I INCHK + TAD NT2 + SZA CLA /SKIP IF STILL 1 PAGE HANDLERS + JMP I INCHK + TAD NP2 + TAD NEXTIN + DCA NEXTIN /INCREMENT TO PT TO NEXT INPUT FILR + JMS NEW +NEXTIN, 0 + JMP ANOTH +NP2, 2 +NOKBIN, CDF 10 /BELONGS WITH INIT CODE + TAD I [7600 + AND NP17 + TAD (7646 + DCA WORD1 /CREATE POINTER INTO DEV TBL + TAD I WORD1 + CDF 0 + TAD (-7607 + SNA CLA /IF ITS SYS, NO PROBLEMS + DCA I (RETSYS /SO CAN ZERO CALL TO DELETE ROUTINE + CDF 10 + TAD I (7604 + SZA + JMP FEND /AN EXT WAS SPECIFIED + IFZERO RALF < + TAD (0216 /.BN DEFAULT FOR FLAP + JMP FEND > + IFNZRO RALF < +NOEXT, CDF 10 + TAD I (7643 /CHECK IF L OR G SPEC + AND L41 + SNA CLA + TAD (0610 /NO-NEEDS RL EXT + TAD (1404 > /YES-NEEDS LD +FEND, DCA I (7604 + CDF 0 + JMP I (GBIN +L41, 41 +TPNSH, 0 + TAD (1401 /CHANGE OUTPUT BUFFER + DCA I (OUTBUF + IAC + JMP I TPNSH +/ + PAGE + LDADR, RELOC OVBUFR + TAD ERRORS /ERROR COUNT + JMS I (DECOUT + JMS I (PRTXT /"ERRORS" + TXERR-1 + -TXELN + JMS I [CRLF + IFZERO RALF < + TAD PASSNO /IF NOT LISTING PASS + SPA SNA CLA /ERROR COUNT IS ENUF + JMP I (RETSYS > + TAD NEXT + TAD (-FREE+1 /DON'T COUNT BASIC SYMBOLS + CLL RAR /DIVIDE + JMS I (OVER3 /BY 6 + JMS I (DECOUT + JMS I (PRTXT /"SYMBOLS, " + TXSYM-1 + -TXSLN + IFZERO RALF < + TAD LINKS + JMS I (DECOUT + JMS I (PRTXT /"LINKS" + TXLNK-1 + -TXLLN > + IFNZRO RALF < + TAD ABREFS + JMS I (DECOUT + JMS I (PRTXT /"ABS REFS" + TXABR-1 + -TXALN > + JMS I [CRLF + TAD (-33 /27 BUCKETS + DCA LTEMP + DCA BUCKET + CLA CMA + DCA OPCODE /SYMBOLS PER LINE COUNTER + STPRNT, TAD BUCKET + DCA EXTMP /BUCKET START ADDRESS +LUPBKT, CDF FLD1 + TAD I EXTMP /WAS THAT LAST SYMBOL ? + SNA + JMP NXTBKT /YES, GO GET NEXT BUCKET + DCA EXTMP /SAVE LINK ADDR + TAD EXTMP + DCA X14 /SET UP POINTER FOR NAME + ISZ OPCODE /IS LINE FULL? + JMP .+4 /NO + TAD (-4 + DCA OPCODE + JMS I [CRLF + TAD BUCKET + SNA /WATCH FOR # + TAD (43 + JMS I [PRINT2 /PRINT BUCKET (FIRST) CHAR + CDF FLD1 + TAD I X14 /SYMBOL + JMS I [PRINT2 /PRINT 2 AND 3 + CDF FLD1 + TAD I X14 + JMS I [PRINT2 /PRINT 4 AND 5 + CDF FLD1 + TAD I X14 + IFNZRO RALF < + DCA OTEMP /HOLD + TAD OTEMP > + AND [7700 /PRINT 6 AND BLANK + JMS I [PRINT2 + IFNZRO RALF < + TAD OTEMP /GET TYPE + AND [17 + TAD (TYPCOD /POINT TO TABLE + DCA OTEMP + TAD I OTEMP /GET TYPE INDICATOR + JMS I [PRINT2 > + CDF FLD1 + TAD I X14 /PRINT FIRST DIGIT + AND [7 + JMS I (PDIG /FIELD DIGIT + CDF FLD1 + TAD I X14 /LOW 12 BITS + JMS I [OCTOUT + JMS I [PRINT2 /TWO BLANKS + JMP LUPBKT + NXTBKT, ISZ BUCKET /NEXT BUCKET CHAR + CDF FLD0 + ISZ LTEMP /INCREMENT COUNT + JMP STPRNT + JMS I [CRLF /DO FINAL CRLF** + TAD (214 /DO NOT PAGEJ + JMS I PC /THAT WOULD GIVE A HEADING + JMS I (OCLOSE + JMP I (RETSYS /FINISH IT OFF + PAGE + RELOC + / PAGE 0 LITERALS + FIELD 1 + *10000 + / +/ SYMBOL TABLE IS IN FIELD ONE. +/ EACH ENTRY HAS THE FOLLOWING FORMAT +/ +/ 0: POINTER TO NEXT ENTRY IN BUCKET, 0 IF LAST +/ 1: 2ND AND 3RD CHARS OF SYMBOL +/ 2: 4TH AND 5TH +/ 3: 6TH AND TYPE CODE +/ 4: ESD # AND HIGH-ORDER VALUE +/ 5: LOW-ORDER VALUE +/ + USER=1 + XTERN=2 + COMMN=3 + SECTN=4 + PSUDO=5 + PDPMR=6 + FPPMRF=7 + FPPSF1=10 /JXN, TRAP + FPPSF2=11 /JA, SETB, SETX + FPPSF3=12 /CLA, EXIT, NEG, NOP, NORM, + /PAUS, JAC, STARTD, STARTF + FPPSF4=13 /ALN, ATX, XTA + FPPSF5=14 /ADDX, LDX + FPPMRI=15 /% + FPPMRS=16 /' + FPPMRL=17 /# + PDPOP=20 +/ +/ THE FOLLOWING CODE TRICKS THE LOADER INTO PUTTING +/ THE SYMBOL TABLE AT 2000, WHERE THE USR IS NOT, +/ THUS SAVING SOME SWAPPING AT LOAD AND INITIALIZE. +/ IT IS MOVED TO THE ASSEMBLED ADDRESS AFTER WE'RE +/ DONE WITH THE USR, AND BEFORE THE FIRST PASS BEGINS +/ + *12000 + NOPUNCH + *10000 + ENPUNCH + / +/ BUCKETS FOR USER-DEFINED SYMBOLS +/ AND PDP8 OPERATES AND IOTS +/ + PNDL + ZBLOCK 33 + / +/ BUCKETS FOR INTERNALLY DEFINED SYMBOLS +/ + AL + BL + CL + DL + EL + FL + GL + HL + IL + JL + KL + LL + ML + NL + OL + PL + QL + RL + SL + TL + UL + VL + WL + XL + YL + ZL + AL, .+5 /ADDR + 0404;2200 + FPPSF2 + 0 + .+5 /ADDX + 0404;3000 + FPPSF5 + 0110 + .+5 /ALN + 1416;0 + FPPSF4 + 0010 + IFZERO RALF < + .+5 /AND + 1604;0 + PDPMR + AND 0 > + IFNZRO RALF < + .+5 /AND . + 1604;0 + PDPMR + 200 + .+5 /AND% + 1604;0 + PDPMR+500 + 600 + .+5 /ANDZ + 1604;3200 + PDPMR + 0 + .+5 /ANDZ% + 1604;3200 + PDPMR+500 + 400 > + 0 /ATX + 2430;0 + FPPSF4 + 0020 +BL, 0 /BASE + 0123;0500 + PSUDO + BASEX +CL, .+5 /CDF + 0406;0 + PDPOP + CDF + .+5 /CIA + 1101;0 + PDPOP + CIA + .+5 /CIF + 1106;0 + PDPOP + CIF + .+5 /CLA + 1401;0 + PDPOP + CLA + .+5 /CLL + 1414;0 + PDPOP + CLL + .+5 /CMA + 1501;0 + PDPOP + CMA + IFZERO RALF < 0 > + IFNZRO RALF < .+5 > + 1514;0 /CML + PDPOP + CML + IFNZRO RALF < + .+5 /COMMON + 1715;1517 + PSUDO+1600 + COMMX + 0 /COMMZ (8-MODE COMM SECT) + 1715;1532 + PSUDO + SECT8X-1 > + DL, IFZERO RALF < + .+5 /DCA + 0301;0 + PDPMR + DCA 0 > + IFNZRO RALF < + .+5 /DCA . + 0301;0 + PDPMR + 3200 + .+5 /DCA% + 0301;0 + PDPMR+500 + 3600 + .+5 /DCAZ + 0301;3200 + PDPMR + DCA 0 + .+5 /DCAZ% + 0301;3200 + PDPMR+500 + DCA I 0 > + IFZERO RALF < 0 > /DECIMAL + IFNZRO RALF < .+5 > + 0503;1115 + PSUDO+0100 + DECX + IFNZRO RALF < 0 /DPCHK + 2003;1013 + PSUDO + DPCHKX > +EL, .+5 /E + 0;0 + PSUDO + EX + .+5 /END + 1604;0 + PSUDO + ENDX + IFZERO RALF < + 0 /ENPUNCH + 1620;2516 + PSUDO+0300 + ENPNCX > + IFNZRO RALF < + .+5 /ENTRY + 1624;2231 + PSUDO + ENTRX + 0 /EXTERN + 3024;0522 + PSUDO+1600 + EXTRNX > + FL, .+5 /F + 0;0 + PSUDO + FX + .+5 /FADD + 0104;0400 + FPPMRF + 1000 + .+5 /FADD# + 0104;0400 + FPPMRL+300 + 1000 + .+5 /FADD% + 0104;0400 + FPPMRI+500 + 1000 + .+5 /FADD' + 0104;0400 + FPPMRS+700 + 1000 + .+5 /FADDM + 0104;0415 + FPPMRF + 5000 + .+5 /FADDM# + 0104;0415 + FPPMRL+300 + 5000 + .+5 /FADDM% + 0104;0415 + FPPMRI+500 + 5000 + .+5 /FADDM' + 0104;0415 + FPPMRS+700 + 5000 + .+5 /FCLA + 0314;0100 + FPPSF3 + 0002 + .+5 /FDIV + 0411;2600 + FPPMRF + 3000 + .+5 /FDIV# + 0411;2600 + FPPMRL+300 + 3000 + .+5 /FDIV% + 0411;2600 + FPPMRI+500 + 3000 + .+5 /FDIV' + 0411;2600 + FPPMRI+700 + 3000 + .+5 /FEXIT + 0530;1124 + FPPSF3 + 0 + IFNZRO RALF < + .+5 /FIELD1 (8-MODE FIELD1 SECT) + 1105;1404 + PSUDO+6100 + SECT8X-2 > + .+5 /FLDA + 1404;0100 + FPPMRF + 0000 + .+5 /FLDA# + 1404;0100 + FPPMRL+300 + 0000 + .+5 /FLDA% + 1404;0100 + FPPMRI+500 + 0000 + .+5 /FLDA' + 1404;0100 + FPPMRS+700 + 0000 + .+5 /FMUL + 1525;1400 + FPPMRF + 4000 + .+5 /FMUL# + 1525;1400 + FPPMRL+300 + 4000 + .+5 /FMUL% + 1525;1400 + FPPMRI+500 + 4000 + .+5 /FMUL' + 1525;1400 + FPPMRS+700 + 4000 + .+5 /FMULM + 1525;1415 + FPPMRF + 7000 + .+5 /FMULM# + 1525;1415 + FPPMRL+300 + 7000 + .+5 /FMULM% + 1525;1415 + FPPMRI+500 + 7000 + .+5 /FMULM' + 1525;1415 + FPPMRS+700 + 7000 + .+5 /FNEG + 1605;0700 + FPPSF3 + 0003 + .+5 /FNOP + 1617;2000 + FPPSF3 + 0040 + .+5 /FNORM + 1617;2215 + FPPSF3 + 0004 + .+5 /FPAUSE + 2001;2523 + FPPSF3+0500 + 0001 + .+5 /FPCOM + 2003;1715 + PDPOP + 6553 + .+5 /FPHLT + 2010;1424 + PDPOP + 6554 + .+5 /FPICL + 2011;0314 + PDPOP + 6552 + .+5 /FPINT + 2011;1624 + PDPOP + 6551 + .+5 /FPIST + 2011;2324 + PDPOP + 6557 + .+5 /FPRST + 2022;2324 + PDPOP + 6556 + .+5 /FPST + 2023;2400 + PDPOP + 6555 + .+5 /FSTA + 2324;0100 + FPPMRF + 6000 + .+5 /FSTA# + 2324;0100 + FPPMRL+300 + 6000 + .+5 /FSTA% + 2324;0100 + FPPMRI+500 + 6000 + .+5 /FSTA' + 2324;0100 + FPPMRS+700 + 6000 + .+5 /FSUB + 2325;0200 + FPPMRF + 2000 + .+5 /FSUB# + 2325;0200 + FPPMRL+300 + 2000 + .+5 /FSUB% + 2325;0200 + FPPMRI+500 + 2000 + 0 /FSUB' + 2325;0200 + FPPMRS+700 + 2000 + GL= 0 /AINT NONE +HL, 0 /HLT + 1424;0 + PDPOP + HLT +IL, .+5 /IAC + 0103;0 + PDPOP + IAC + .+5 /IFFLAP + 0606;1401 + PSUDO+2000 + IFZERO RALF + IFNZRO RALF + .+5 /IFNDEF + 0616;0405 + PSUDO+0600 + IFNDFX + .+5 /IFNEG + 0616;0507 + PSUDO + IFNEGX + .+5 /IFNSW + 0616;2327 + PSUDO + IFNSWX + .+5 /IFNZRO + 0616;3222 + PSUDO+1700 + IFNZRX + .+5 /IFPOS + 0620;1723 + PSUDO + IFPOSX + .+5 /IFRALF + 0622;0114 + PSUDO+0600 + IFNZRO RALF + IFZERO RALF + .+5 /IFREF + 0622;0506 + PSUDO + IFREFX + .+5 /IFSW + 0623;2700 + PSUDO + IFSWX + .+5 /IFZERO + 0632;0522 + PSUDO+1700 + IFZROX + .+5 + 1604;0530 + PSUDO + INDXX + .+5 /IOF + 1706;0 + PDPOP + IOF + .+5 /ION + 1716;0 + PDPOP + ION + IFZERO RALF < + 0 /ISZ + 2332;0 + PDPMR + ISZ 0 > + IFNZRO RALF < + .+5 /ISZ . + 2332;0 + PDPMR + ISZ .&7600 + .+5 /ISZ% + 2332;0 + PDPMR+500 + ISZ I .&7600 + .+5 /ISZZ + 2332;3200 + PDPMR + ISZ 0 + 0 /ISZZ% + 2332;3200 + PDPMR+500 + ISZ I 0 > + JL, .+5 /JA + 0100;0 + FPPSF2 + 1030 + .+5 /JAC + 0103;0 + FPPSF3 + 0007 + .+5 /JAL + 0114;0 + FPPSF2 + 1070 + .+5 /JEQ + 0521;0 + FPPSF2 + 1000 + .+5 /JGE + 0705;0 + FPPSF2 + 1010 + .+5 /JGT + 0724;0 + FPPSF2 + 1060 + .+5 /JLE + 1405;0 + FPPSF2 + 1020 + .+5 /JLT + 1424;0 + FPPSF2 + 1050 + IFZERO RALF < + .+5 /JMP + 1520;0 + PDPMR + JMP 0 + .+5 /JMS + 1523;0 + PDPMR + JMS 0 > + IFNZRO RALF < + .+5 /JMP . + 1520;0 + PDPMR + JMP .&7600 + .+5 /JMP% + 1520;0 + PDPMR+500 + JMP I .&7600 + .+5 /JMPZ + 1520;3200 + PDPMR + JMP 0 + .+5 /JMPZ% + 1520;3200 + PDPMR+500 + JMP I 0 + .+5 /JMS . + 1523;0 + PDPMR + JMS .&7600 + .+5 /JMS% + 1523;0 + PDPMR+500 + JMS I .&7600 + .+5 /JMSZ + 1523;3200 + PDPMR + JMS 0 + .+5 /JMSZ% + 1523;3200 + PDPMR+500 + JMS I 0 > + .+5 /JNE + 1605;0 + FPPSF2 + 1040 + .+5 /JSA + 2301;0 + FPPSF2 + 1120 + .+5 /JSR + 2322;0 + FPPSF2 + 1130 + 0 /JXN + 3016;0 + FPPSF1 + 2000 +KL, .+5 /KCC + 0303;0 + PDPOP + KCC + .+5 /KRB + 2202;0 + PDPOP + KRB + .+5 /KRS + 2223;0 + PDPOP + KRS + 0 /KSF + 2306;0 + PDPOP + KSF +LL, .+5 /LAS + 0123;0 + PDPOP + LAS + .+5 /LDX + 0430;0 + FPPSF5 + 0100 + .+5 /LISTOFF + 1123;2417 + PSUDO+0600 + LSTOFX + 0 /LISTON + 1123;2417 + PSUDO+1600 + LSTONX + ML= 0 /NO LIST +NL, IFZERO RALF < .+5 > + IFNZRO RALF < 0 > + 1720;0 /NOP + PDPOP + NOP + IFZERO RALF < + 0 /NOPUNCH + 1720;2516 + PSUDO+0300 + NOPNCX > +OL, .+5 /OCTAL + 0324;0114 + PSUDO + OCTALX + .+5 /ORG + 2207;0 + PSUDO + ORGX + 0 /OSR + 2322;0 + PDPOP + OSR + IFZERO RALF < +PL, 0 /PAGE + 0107;0500 + PSUDO + PAGEX > + IFNZRO RALF +QL= 0 /WHAT DID YOU EXPECT? +RL, .+5 /RAL + 0114;0 + PDPOP + RAL + .+5 /RAR + 0122;0 + PDPOP + RAR + .+5 /RDF + 0406;0 + PDPOP + RDF + .+5 /REPEAT + 0520;0501 + PSUDO+2400 + REPETX + .+5 /RIB + 1102;0 + PDPOP + RIB + .+5 /RIF + 1106;0 + PDPOP + RIF + .+5 /RMF + 1506;0 + PDPOP + RMF + .+5 /RTL + 2414;0 + PDPOP + RTL + 0 /RTR + 2422;0 + PDPOP + RTR + SL, .+5 /S + 0;0 + PSUDO + SX + IFNZRO RALF < + .+5 /SECT + 0503;2400 + PSUDO + SECTX + .+5 /8 MODE SECT + 0503;2470 + PSUDO + SECT8X > + .+5 /SETB + 0524;0200 + FPPSF2 + 1110 + .+5 /SETX + 0524;3000 + FPPSF2 + 1100 + .+5 /SKP + 1320;0 + PDPOP + SKP + .+5 /SMA + 1501;0 + PDPOP + SMA + .+5 /SNA + 1601;0 + PDPOP + SNA + .+5 /SNL + 1614;0 + PDPOP + SNL + .+5 /SPA + 2001;0 + PDPOP + SPA + .+5 /STARTD + 2401;2224 + FPPSF3+0400 + 0006 + .+5 /STARTE + 2401;2224 + FPPSF3+0500 + 0050 + .+5 /STARTF + 2401;2224 + FPPSF3+0600 + 0005 + .+5 /STL + 2414;0 + PDPOP + STL + .+5 /SZA + 3201;0 + PDPOP + SZA + 0 /SZL + 3214;0 + PDPOP + SZL + TL, IFZERO RALF < + .+5 /TAD + 0104;0 + PDPMR + TAD 0 > + IFNZRO RALF < + .+5 /TAD . + 0104;0 + PDPMR + TAD .&7600 + .+5 /TAD% + 0104;0 + PDPMR+500 + TAD I .&7600 + .+5 /TADZ + 0104;3200 + PDPMR + TAD 0 + .+5 /TADZ% + 0104;3200 + PDPMR+500 + TAD I 0 > + .+5 /TCF + 0306;0 + PDPOP + TCF + .+5 /TEXT + 0530;2400 + PSUDO + TEXTX + .+5 /TLS + 1423;0 + PDPOP + TLS + .+5 /TPC + 2003;0 + PDPOP + TPC + .+5 /TRAP3 + 2201;2063 + FPPSF1 + 3000 + .+5 /TRAP4 + 2201;2064 + FPPSF1 + 4000 + .+5 /TRAP5 + 2201;2065 + FPPSF1 + 5000 + .+5 /TRAP6 + 2201;2066 + FPPSF1 + 6000 + .+5 /TRAP7 + 2201;2067 + FPPSF1 + 7000 + 0 /TSF + 2306;0 + PDPOP + TSF + UL= 0 +VL= 0 +WL= 0 +XL, 0 /XTA + 2401;0 + FPPSF4 + 0030 +YL= 0 +ZL, 0 /ZBLOCK + 0214;1703 + PSUDO+1300 + ZBLKX + IFZERO RALF < PNDL=0 > + IFNZRO RALF < +PNDL, .+6 /BLANK COMMON + 0;0 + 3 /CODE FOR COMMON + 40;0 /ESD #2, LEN=0 + 0 /#MAIN + 1501;1116 + 4 /CODE FOR SECTION +LMAIN, 20;0 /ESD #1, LEN=0> +FREE, +END, END /NICE WHEN FLAP ASSEMBLES + $ + diff --git a/sw/f4/FRTSRC/RALF.err b/sw/f4/FRTSRC/RALF.err new file mode 100644 index 0000000..078a1fa --- /dev/null +++ b/sw/f4/FRTSRC/RALF.err @@ -0,0 +1,30 @@ +RALF.PA(303:8) : error: illegal blank at Loc = 00366 +RALF.PA(424:8) : error: illegal blank at Loc = 00544 +RALF.PA(437:8) : error: illegal blank at Loc = 00563 +RALF.PA(992:8) : error: illegal blank at Loc = 01520 +RALF.PA(1033:8) : error: illegal blank at Loc = 01563 +RALF.PA(1535:8) : error: illegal blank at Loc = 02364 +RALF.PA(1536:8) : error: illegal blank at Loc = 02364 +RALF.PA(1537:8) : error: illegal blank at Loc = 02364 +RALF.PA(1538:8) : error: illegal blank at Loc = 02364 +RALF.PA(1614:19) : error: no literal value at Loc = 02462 +RALF.PA(1842:8) : error: illegal blank at Loc = 03000 +RALF.PA(1843:8) : error: illegal blank at Loc = 03000 +RALF.PA(1844:8) : error: illegal blank at Loc = 03000 +RALF.PA(2353:8) : error: illegal blank at Loc = 03562 +RALF.PA(2379:8) : error: illegal blank at Loc = 03630 +RALF.PA(2614:8) : error: illegal blank at Loc = 04167 +RALF.PA(2615:8) : error: illegal blank at Loc = 04167 +RALF.PA(3417:8) : error: illegal blank at Loc = 06325 +RALF.PA(3568:2) : error: duplicate label "STPRNT" at Loc = 06631 +RALF.PA(3570:1) : error: duplicate label "LUPBKT" at Loc = 06633 +RALF.PA(3615:2) : error: duplicate label "NXTBKT" at Loc = 06706 +RALF.PA(4025:8) : error: illegal blank at Loc = 10655 +RALF.PA(4232:8) : error: illegal blank at Loc = 11230 +RALF.PA(4261:8) : error: illegal blank at Loc = 11254 +RALF.PA(4425:8) : error: illegal blank at Loc = 11557 +RALF.PA(4426:8) : error: illegal blank at Loc = 11557 +RALF.PA(4427:8) : error: illegal blank at Loc = 11557 +RALF.PA(4432:8) : error: illegal blank at Loc = 11564 + + 28 detected errors diff --git a/sw/f4/FRTSRC/READ.ME b/sw/f4/FRTSRC/READ.ME new file mode 100644 index 0000000..54d9fe8 --- /dev/null +++ b/sw/f4/FRTSRC/READ.ME @@ -0,0 +1 @@ +START WITH "SUBMIT BUILD"! diff --git a/sw/f4/FRTSRC/TMP.BI b/sw/f4/FRTSRC/TMP.BI new file mode 100644 index 0000000..b50c152 --- /dev/null +++ b/sw/f4/FRTSRC/TMP.BI @@ -0,0 +1,239 @@ +$JOB FORTRAN IV BUILD - MAIN PART +/ ******************************************************************* +/ ******************************************************************* +/ ******************************************************************* +/ +/ STUPID ASSEMBLER PROCEDURES +/ +/ ******************************************************************* +/ ******************************************************************* +/ ******************************************************************* +/ THE RALF ASSEMBLER REFUSES TO ACCEPPT THE .RA FILES AS THEY +/ COME FROM KERMIT. I CANNOT INVESTIGATE WHICH PARITY IS GENERATED +/ BY KERMIT-12. BUT I KNOW THAT PIP MAKES EVERYTHING RIGHT AGAIN. +/ SO ALL .RA FILES ARE MOVED TROUGH PIP ONCE. +/ +.R PIP +*ABS.RA + IFNSW 8 < + TAD CHANEL+2 /CREATE FIRST SAM + TAD SAM0 + DCA DOSAM + IOF + LINC /ENTER LINC MODE WITHOUT INTERRUPTS + ESF /DISABLE FAST SAM +DOSAM, 0 + PDP + ION /BACK IN 8 MODE, TURN ON INTERRUPTS> + DCA SAMPLE+1 /SAVE SAMPLE + CIF CDF + JMP% ADC8 + IFNSW 8 < +SAM0, SAM 0> + diff --git a/sw/f4/FRTSRC/alog.ra b/sw/f4/FRTSRC/alog.ra new file mode 100644 index 0000000..3c710f7 --- /dev/null +++ b/sw/f4/FRTSRC/alog.ra @@ -0,0 +1,149 @@ +/ +/ +/ A L O G +/ - - - - +/ +/SUBROUTINE ALOG(X) +/ +/ VERSION 5A 4-26-77 (MH) +/ + SECT ALOG + JA #ALOG + 0 /WORKING SPACE FOR EXPONENT DIDDLE. + 0 + 0 +ALOGTM, 0 + 0 + 0 + 0 +F2ALOG, F 2. +FPI2, 1 + 3110 + 3755 +/ + EXTERN #ARGER +ALOG0, TRAP4 #ARGER + JA ALGRTN /RETURN NOW. +/ + EXTERN #ARGER +ALOGM1, TRAP4 #ARGER + JA ALGRTN + TEXT +ALOG + +ALOGXR, +BPALOG, F 0.0 +XRALOG, F 0.0 +ALOG1, F 0.0 +ALOG2, F 0.0 +F1ALOG, F 1. +/ +ALOGMG, 0 + 0 + 13 /CORRECT EXPONENT DIDDLER. +/ +/ +/ +/ +ALOGL1, 0 + 3777 + 7742 +/ +ALOGE2, 0 + 2613 + 4414 +/ + ORG 10*3+BPALOG + FNOP + JA ALOGXR + 0 +ALGRTN, JA . +ALOGL2, 7777 + 4000 + 4100 +/ +ALOGL3, 7777 + 2517 + 0310 +/ +ALOGL4, 7776 + 4113 + 7211 +/ +ALOGL5, 7776 + 2535 + 3301 +/ +ALOGL6, 7775 + 4746 + 0771 +/ +ALOGL7, 7774 + 2236 + 4304 +/ +ALOGL8, 7771 + 4544 + 1735 + BASE 0 +#ALOG, STARTD + FLDA 10*3 + FSTA ALGRTN + FLDA 0 + SETX XRALOG + SETB BPALOG + BASE BPALOG + LDX 1,1 + FSTA BPALOG + FLDA% BPALOG,1 /ADDR OF X + FSTA BPALOG + STARTF + FLDA% BPALOG /GET X + JEQ ALOG0 /IF =0 THEN ERROR + JLT ALOGM1 /IF<0 THEN ERROR + LDX -1,0 /IF >0 THEN START DOING + FSTA ALOG1 /SAVE IN A TEMP. + FSUB F1ALOG /KNOCK OFF ONE. + JEQ ALGRTN /IF ZERO EXIT. LOG(1)=0 + JGE ALOGST /IF POSITIVE LOG>0 + FLDA F1ALOG /NEGITE. INVERT IT. + FDIV ALOG1 /BY DIVIDING INTO ONE. + FSTA ALOG1 + LDX 0,0 /RESET SIGN TO NEGATIVE. + JA .+3 /AVOID USELESS LOAD INSTRUCTION. +/ +ALOGST, FLDA ALOG1 /RECALL NUMBER. + FDIV F2ALOG /CUT IN HALF. + FSTA ALOGTM /PREPARE FOR EXPONENT DIDDLE. + FLDA ALOGMG /SET THE EXPONENT OF THE EXPONENT TO 13. + FSTA ALOGTM-3 /SO THAT NORMALIZE WILL DO JOB. + FSTA ALOGTM+1 /AND ALSO ZERO OUT LOW ORDER POART OF EX. MANT. + FLDA ALOGTM-1 /RECALL THE NUMBER + FNORM /NORMALIZE IT. + FMUL ALOGE2 /NOW MULITPLY EXPONENT BY LOG E 2 + FSTA ALOG2 /AND SAVE IT FOR A SECOND. + FLDA ALOG1 /RECALL THE NUMBER AGAIN. + FSTA ALOGTM /STORE IN THE TEMPORARY WORKER. + FLDA FPI2-2 /RECALL WORD WITH LOW ORDER ONE. + FSTA ALOGTM-2 /STORE AWAY. + FLDA ALOGTM /RECALL NUMBER WITH AN EXPONENT OF 1 + FSUB F1ALOG /SUBTRACT AWAY. + FSTA ALOG1 /AND STORE + FMUL ALOGL8 /MULTIPLY BY THE CONSTANT. + FADD ALOGL7 /ADD IN + FMUL ALOG1 /MULT. + FADD ALOGL6 /AND SO ON DOWN THE LINE. + FMUL ALOG1 + FADD ALOGL5 + FMUL ALOG1 + FADD ALOGL4 + FMUL ALOG1 + FADD ALOGL3 + FMUL ALOG1 + FADD ALOGL2 + FMUL ALOG1 + FADD ALOGL1 + FMUL ALOG1 + FADD ALOG2 /CORRECT NOW.ADD IN EXPONENT. + JXN ALGRTN,0 /EXIT IF SIGN IS OK. + FNEG /ELSE NEGATE IT. + JA ALGRTN + diff --git a/sw/f4/FRTSRC/alog10.ra b/sw/f4/FRTSRC/alog10.ra new file mode 100644 index 0000000..1517ea7 --- /dev/null +++ b/sw/f4/FRTSRC/alog10.ra @@ -0,0 +1,48 @@ +/ +/ +/ A L O G 1 0 +/ - - - - - - +/ +/ VERSION 5A 4-27-77 PT +/ +/SUBROUTINE ALOG10(X) + SECT ALOG10 + JA #ALOG + TEXT +ALOG10+ +LOGXR, SETX XRLOG + SETB BPLOG +BPLOG, FNOP + 0 + 0 +XRLOG, F 0.0 +LOG1, F 0.0 +ALOG1C, 7777 /FUDGE CONSTANT + 3362 + 6754 + ORG 10*3+BPLOG + FNOP + JA LOGXR + 0 +LOGRTN, JA . + BASE 0 +#ALOG, STARTD + FLDA 10*3 + FSTA LOGRTN + FLDA 0 + SETX XRLOG + SETB BPLOG + BASE BPLOG + LDX 1,1 + FSTA BPLOG + FLDA% BPLOG,1 /ADDR OF X + FSTA BPLOG + STARTF + FLDA% BPLOG /GET X + FSTA LOG1 + EXTERN ALOG + JSR ALOG /CALL ALOG + JA .+4 + JA LOG1 + FMUL ALOG1C /CORRECT FOR THE LOG BASE E. + JA LOGRTN + diff --git a/sw/f4/FRTSRC/amax.ra b/sw/f4/FRTSRC/amax.ra new file mode 100644 index 0000000..1004595 --- /dev/null +++ b/sw/f4/FRTSRC/amax.ra @@ -0,0 +1,57 @@ +/ +/ VERSION 5A 4/27/77 MH +/ + SECT AMAX0 + ENTRY AMAX1 + ENTRY MAX0 + ENTRY MAX1 + BASE 0 +AMAX1, SETX XR + LDX 1,3 /DON'T INTEGERIZE RESULT +MAXCOM, STARTD + FLDA 0 /ADDRESS OF JA .+2+2*N + FSTA 3 + FLDA 30 /RETURN ADDRESS + FSTA RETN + FLDA% 3 / JA .+2+2*N + FSUB 0 /-JA . + FSUB TWO /- 2 + LDX 1,1 + ALN 1 /DIVIDE BY TWO + FNEG /-N + ATX 1 + LDX 0,2 /FOR ARG PICKUP + FLDA% 0,2+ /ADDRESS OF FIRST ARG + FSTA 3 + STARTF +NEW, FLDA% 3 /SAVE NEW MAX + FSTA MAX +SAME, JXN MORMAX,1+ /ANY MORE ARGS ? + FLDA MAX /GET RESULT + JXN RETN,3 /DON'T FIX + JLT NEGFIX /NEGATIVE FIX + ALN 0 + FNORM + JA RETN +NEGFIX, FNEG + ALN 0 + FNORM + FNEG +RETN, JA . +MORMAX, STARTD /NEXT ARG ADDRESS + FLDA% 0,2+ + FSTA 3 + STARTF + FLDA MAX /COMPARE + FSUB% 3 + JGE SAME /SAME MAX + JA NEW /NEW MAX +TWO, 0;2 +MAX, 0;0;0 +MAX0, +MAX1, SETX XR + LDX 0,3 /INTEGERIZE RESULT + JA MAXCOM /GO DO IT +XR, 0;0;0;0;0;0;0;0 + END + diff --git a/sw/f4/FRTSRC/amin.ra b/sw/f4/FRTSRC/amin.ra new file mode 100644 index 0000000..a5addcf --- /dev/null +++ b/sw/f4/FRTSRC/amin.ra @@ -0,0 +1,57 @@ +/ +/ VERSION 5A 4/27/77 MH +/ + SECT AMIN0 + ENTRY AMIN1 + ENTRY MIN0 + ENTRY MIN1 + BASE 0 +AMIN1, SETX XR + LDX 1,3 /DON'T INTEGERIZE RESULT +MINCOM, STARTD + FLDA 0 /ADDRESS OF JA .+2+2*N + FSTA 3 + FLDA 30 /RETURN ADDRESS + FSTA RETN + FLDA% 3 / JA .+2+2*N + FSUB 0 /-JA . + FSUB TWO /- 2 + LDX 1,1 + ALN 1 /DIVIDE BY TWO + FNEG /-N + ATX 1 + LDX 0,2 /FOR ARG PICKUP + FLDA% 0,2+ /ADDRESS OF FIRST ARG + FSTA 3 + STARTF +NEW, FLDA% 3 /SAVE NEW MIN + FSTA MIN +SAME, JXN MORMIN,1+ /ANY MORE ARGS ? + FLDA MIN /GET RESULT + JXN RETN,3 /DON'T FIX + JLT NEGFIX /NEGATIVE FIX + ALN 0 + FNORM + JA RETN +NEGFIX, FNEG + ALN 0 + FNORM + FNEG +RETN, JA . +MORMIN, STARTD /NEXT ARG ADDRESS + FLDA% 0,2+ + FSTA 3 + STARTF + FLDA MIN /COMPARE + FSUB% 3 + JLE SAME /SAME MIN + JA NEW /NEW MIN +TWO, 0;2 +MIN, 0;0;0 +MIN0, +MIN1, SETX XR + LDX 0,3 /INTEGERIZE RESULT + JA MINCOM /GO DO IT +XR, 0;0;0;0;0;0;0;0 + END + diff --git a/sw/f4/FRTSRC/amod.ra b/sw/f4/FRTSRC/amod.ra new file mode 100644 index 0000000..47f3352 --- /dev/null +++ b/sw/f4/FRTSRC/amod.ra @@ -0,0 +1,65 @@ +/ +/ +/ +/ A M O D +/ - - - - +/ +/SUBROUTINE AMOD(X,Y) +/ +/ VERSION 5A 4-27-77 PT +/ + SECT AMOD + ENTRY MOD + JA #AMOD + TEXT +AMOD + +AMODXR, SETX XRAMOD + SETB BPAMOD +BPAMOD, F 0.0 +XRAMOD, F 0.0 +AMODX, F 0.0 + ORG 10*3+BPAMOD + FNOP + JA AMODXR + 0 + AMDRTN, JA . + EXTERN #ARGER +AMODER, TRAP4 #ARGER + FCLA + JA AMDRTN + BASE 0 +MOD, +#AMOD, STARTD + FLDA 10*3 + FSTA AMDRTN + FLDA 0 + SETX XRAMOD + SETB BPAMOD + BASE BPAMOD + LDX 1,1 + FSTA BPAMOD + FLDA% BPAMOD,1 /ADDR OF X + FSTA AMODX + FLDA% BPAMOD,1+ /ADDR OF Y + FSTA BPAMOD + STARTF + FLDA% BPAMOD /GET Y + JEQ AMODER /Y=0 IS ERROR + JGT .+3 + FNEG /ABS VALUE + FSTA BPAMOD + FLDA% AMODX /GET X + JGT .+5 + FNEG /ABS VALUE + LDX 0,1 /NOTE SIGN + FSTA AMODX /SAV IN A TEMPORARY + FDIV BPAMOD /DIVIDE BY Y + JAL AMODER /TOO BIG. + ALN 0 /FIX IT UP NOW. + FNORM + FMUL BPAMOD /MULITPLY IT. + FNEG /NEGATE IT. + FADD AMODX /AND ADD IN X. + JXN AM,1 /CHECK SIGN + FNEG +AM, JA AMDRTN + diff --git a/sw/f4/FRTSRC/asin.ra b/sw/f4/FRTSRC/asin.ra new file mode 100644 index 0000000..a4c9b4f --- /dev/null +++ b/sw/f4/FRTSRC/asin.ra @@ -0,0 +1,73 @@ +/ +/ +/ A S I N +/ - - - - +/ +/SUBROUTINE ASIN(X) +/ +/ VERSION 5A 4-27-77 PT +/ + SECT ASIN + JA #ASIN +ASINEQ, FLDA FPI2AS /RETURN PI OVER TWO. + FMUL ASIN8 /TIMES ARG. + JA ASNRTN + TEXT +ASIN + +ASINXR, SETX XRASIN + SETB BPASIN +BPASIN, FNOP + 0 + 0 +XRASIN, F 0.0 +ASIN8, F 0.0 +ASIN7, F 0.0 +F1ASIN, F 1. +FPI2AS, 1 /PI OVER 2 + 3110 + 3755 + ORG 10*3+BPASIN + FNOP + JA ASINXR + 0 +ASNRTN, JA . + BASE 0 +#ASIN, STARTD + FLDA 10*3 + FSTA ASNRTN + FLDA 0 + SETX XRASIN + SETB BPASIN + BASE BPASIN + LDX 1,1 + FSTA BPASIN + FLDA% BPASIN,1 /ADDR OF X + FSTA BPASIN + STARTF + FLDA% BPASIN /GET X + FSTA ASIN8 /STORE ARG AWAY. + JGE .+3 /TAKE ABSOLUTE VALUE. + FNEG + FSUB F1ASIN /SEE IF >1 + JLE ASINOK /CONTINUE PROCESS. + EXTERN #ARGER + TRAP4 #ARGER /TRAP OUT. + JA ASNRTN /RETURN. +ASINOK, FLDA ASIN8 /X USES STRAIGHT TRIG RELATION. + FNEG + FMUL ASIN8 /-X^2 + FADD F1ASIN /1.-X^2 + JEQ ASINEQ /IF 0,FAC=PI OVER 2 + FSTA ASIN7 + EXTERN SQRT + JSR SQRT + JA .+4 + JA ASIN7 + FSTA ASIN7 /SQRT(1.-X^2) + FLDA ASIN8 + FDIV ASIN7 /X/SQRT(1.X^2) + FSTA ASIN7 + EXTERN ATAN + JSR ATAN /TAKE THE ARCTANGENT. + JA ASNRTN + JA ASIN7 + diff --git a/sw/f4/FRTSRC/atan.ra b/sw/f4/FRTSRC/atan.ra new file mode 100644 index 0000000..ab73d75 --- /dev/null +++ b/sw/f4/FRTSRC/atan.ra @@ -0,0 +1,137 @@ +/ +/ +/ A T A N +/ - - - - +/ +/SUBROUTINE ATAN(X) +/ +/ VERSION 5A 4-27-77 PT +/ + SECT ATAN + JA #ATAN + TEXT +ATAN + +ATANXR, SETX XRATAN + SETB BPATAN +BPATAN, F 0.0 +XRATAN, F 0.0 +ATAN1, F 0.0 +ATAN22, F 0.0 +ATAN3, F 0.0 +ATAN4, F 0.0 +F1ATAN, F 1. + ORG 10*3+BPATAN + FNOP + JA ATANXR + 0 +ATNRTN, JA . +/ +ATANC1, -15 /LOWER LIMIT TEST. + 2000 + 0000 +/ +ATANC2, 0 /UPPER LIMIT TEST. + 3777 + 7000 +/ +ATANC3, -1 + 2111 + 4121 +/ +ATANC4, 1 + 3355 + 4754 +/ +ATANC5, 0 + 2060 + 2511 +/ +ATANC6, -3 + 3023 + 1227 +/ +ATANC7, -2 + 5566 + 7220 +/ +ATANC8, -2 + 3146 + 0740 +/ +ATANC9, -1 + 5252 + 5262 +/ +ATANCH, 1 + 3110 + 3755 +/ +ATANCJ, F -4. + BASE 0 +#ATAN, STARTD + FLDA 10*3 + FSTA ATNRTN + FLDA 0 + SETX XRATAN + SETB BPATAN + BASE BPATAN + LDX 1,1 + FSTA BPATAN + FLDA% BPATAN,1 /ADDR OF X + FSTA BPATAN + STARTF + FLDA% BPATAN /GET X + LDX -1,0 /REMEMBER SIGN + JGE .+5 + LDX 0,0 /SAVE THE SIGN. + FNEG /NEGATE THE FAC [ABS] + FSTA ATAN1 /AND STORE AWAY. + FSTA ATAN22 + FSUB ATANC1 /TEST TO SEE IF TOO SMALL. + JLE ATANBG /IT IS. ATAN(X)=X + FSUB ATANC2 /TEST TO SEE IF TOO BIG. + JLE ATANLW /IT ISNT. + FLDA F1ATAN /TO BIG. INVERT IT. + FDIV ATAN1 + FSTA ATAN1 +/ +ATANLW, FCLA /CLEAR OUT TEMP. + FSTA ATAN3 + FLDA ATAN1 /RECALL NUMBER. + FSUB ATANC3 /START THE KNOCKING OFF PROCESS. + JLT ATANNT /WRONG SECTOR. + FLDA ATANC4 /BOP UP ORIGINAL. + FADDM ATAN1 + FLDA ATANCJ /GET MAGIC NUMBER. + FDIV ATAN1 + FADD ATANC4 + FSTA ATAN1 + FLDA ATANC5 + FSTA ATAN3 +/ +ATANNT, FLDA ATAN1 /RECALL AND SQUARE IT. + FMUL ATAN1 + FSTA ATAN4 /YET ANOTHER TEMP. + FLDA ATANC6 + FMUL ATAN4 + FADD ATANC7 + FMUL ATAN4 + FADD ATANC8 + FMUL ATAN4 + FADD ATANC9 + FMUL ATAN4 + FADD F1ATAN + FMUL ATAN1 + FADD ATAN3 + FSTA ATAN1 + FLDA ATAN22 + FSUB F1ATAN + JLE ATANBG + FLDA ATANCH + FSUB ATAN1 + JA .+3 +/ +ATANBG, FLDA ATAN1 + JXN ATNRTN,0 + FNEG + JA ATNRTN + diff --git a/sw/f4/FRTSRC/atan2.ra b/sw/f4/FRTSRC/atan2.ra new file mode 100644 index 0000000..0c1df14 --- /dev/null +++ b/sw/f4/FRTSRC/atan2.ra @@ -0,0 +1,80 @@ +/ +/ +/ +/ A T A N 2 +/ - - - - - +/ +/SUBROUTINE ATAN2(Y,X) +/ +/ VERSION 5A 4-27-77 PT +/ + SECT ATAN2 + JA #ATAN2 + TEXT +ATAN2 + +ATN2XR, SETX XRATN2 + SETB BPATN2 +BPATN2, FNOP + 0 + 0 +XRATN2, F 0.0 +YCOR, F 0.0 +XCOR, F 0.0 +FPIAT2, 2 /PI + 3110 + 3755 +ATPI, F 1.570796 /PI/2 + ORG 10*3+BPATN2 + FNOP + JA ATN2XR + 0 +AT2RTN, JA . + BASE 0 +#ATAN2, STARTD + FLDA 10*3 + FSTA AT2RTN + FLDA 0 + SETX XRATN2 + SETB BPATN2 + BASE BPATN2 + LDX 1,1 + FSTA BPATN2 + FLDA% BPATN2,1 /ADDR OF Y + FSTA YCOR + FLDA% BPATN2,1+ /ADDR OF X + FSTA XCOR + STARTF + FLDA% YCOR /GET Y - THE TAN + FSTA YCOR /SAV FOR A SECOND + LDX 1,2 /POSITIVE X + JEQ ATN0 + JGT ATN1 + LDX 0,2 +ATN1, FLDA% XCOR /GET X - THE QUADRAND + FSTA XCOR /+MOVE IT TO A SAFE PLACE + JEQ ATASP + FLDA YCOR /Y/X + FDIV XCOR + FSTA YCOR + EXTERN ATAN + JSR ATAN /CALL ATAN + JA .+4 /TAKE ARCTAN OF Y/X + JA YCOR + FSTA YCOR /SAVE IT AWAY + JGE A2 /SKIP IF 1 OR 3 Q + FADD FPIAT2 /ADD PI FOR 4TH Q + FSTA YCOR +A2, JXN AT2RTN,2 + FLDA YCOR + FSUB FPIAT2 /SUB PI FOR 2ND+3RD QUADS + JA AT2RTN +ATASP, FLDA ATPI /X=0 MEANS +-PI/2 + JXN ATNG,2 + FNEG +ATNG, JA AT2RTN +ATN0, FLDA% XCOR + JLT POSX /IF X POS,ANS IS 0 + FCLA + JA AT2RTN +POSX, FLDA FPIAT2 /OTHERWISE,ANS IS PI + JA AT2RTN + diff --git a/sw/f4/FRTSRC/cabs.ra b/sw/f4/FRTSRC/cabs.ra new file mode 100644 index 0000000..ab166b0 --- /dev/null +++ b/sw/f4/FRTSRC/cabs.ra @@ -0,0 +1,57 @@ +/ +/ C A B S +/ - - - - +/ +/ VERSION 5A 4-27-77 PT +/ +/ENTER IN COMPLEX, EXIT IN REAL +/ +/Z=X+IY +/ +/CABS(Z)=SQRT(X^2+Y^2) +/ + DPCHK + SECT CABS + JA #CABS + TEXT +CABS + +CABSXR, SETX XRCABS + SETB BPCABS + JA .+3 +BPCABS, F 0.0 +XRCABS, F 0.0 +ARG, F 0.0 + F 0.0 + ORG 10*3+BPCABS + FNOP + JA CABSXR + 0 +CABSRT, JA . + BASE 0 +#CABS, STARTD + FLDA 10*3 + FSTA CABSRT + FLDA 0 + SETB BPCABS + SETX XRCABS + BASE BPCABS + LDX 1,1 + FSTA BPCABS + FLDA% BPCABS,1 + FSTA BPCABS + STARTE + FLDA% BPCABS + FSTA ARG + STARTF + FLDA ARG + FMULM ARG /X^2 + FLDA ARG+3 /Y + FMUL ARG+3 /Y^2 + FADD ARG /X^2+Y^2 + FSTA ARG + EXTERN SQRT + JSR SQRT + JA RT1 + JA ARG +RT1, JA CABSRT + EXTERN #CAC + diff --git a/sw/f4/FRTSRC/carith.ra b/sw/f4/FRTSRC/carith.ra new file mode 100644 index 0000000..e2770c3 --- /dev/null +++ b/sw/f4/FRTSRC/carith.ra @@ -0,0 +1,110 @@ +/COMPLEX ARITHMETIC ROUTINES +/ (A+BI)+-*/(C+DI) +/ +/ VERSION 5A 4-26-77 MH +/ + DPCHK + SECT #CAD + JA . + FSTA #CARG /SAVE SECOND ARG + STARTF + FLDA #CARG /STARTF ROUNDS + FADDM #CAC /A+C + FLDA #CARG+3 + FADDM #CAC+3 /B+D + STARTE + JA #CAD + ENTRY #CSB +#CSB, JA . + FSTA #CARG + STARTF + FLDA #CARG /STARTF ROUNDS + FNEG + FADDM #CAC /A-C + FLDA #CAC+3 + FSUB #CARG+3 /B-D + FSTA #CAC+3 + STARTE + JA #CSB + ENTRY #CNG +#CNG, JA . + STARTF + FLDA #CAC + FNEG + FSTA #CAC + FLDA #CAC+3 + FNEG + FSTA #CAC+3 + STARTE + JA #CNG + ENTRY #CEQ +#CEQ, JA . + JSA #CSB + STARTF + FLDA #CAC + JNE NOTEQ + FLDA #CAC+3 + JNE NOTEQ + FLDA ONE + JA #CEQ +NOTEQ, FCLA + JA #CEQ +ONE, F 1.0 + ENTRY #CML +#CML, JA . + FSTA #CARG + STARTF + FLDA #CARG /STARTF ROUNDS + FMUL #CAC /A*C + FSTA TEMP + FLDA #CARG+3 + FMUL #CAC+3 /B*D + FSTA TEMP2 + FLDA #CARG + FMULM #CAC+3 /B*C + FLDA #CAC + FMUL #CARG+3 /A*D + FADDM #CAC+3 /A*D+B*C + FLDA TEMP + FSUB TEMP2 /A*C-B*D + FSTA #CAC + STARTE + JA #CML + ENTRY #CDV +#CDV, JA . + FSTA #CARG + STARTF + FLDA #CARG /STARTF ROUNDS + FMUL #CAC+3 /B*C + FSTA TEMP + FLDA #CARG+3 + FMUL #CAC /A*D + FSTA TEMP2 + FLDA #CARG + FMULM #CAC /A*C + FLDA #CAC+3 + FMUL #CARG+3 /B*D + FADDM #CAC /A*C+B*D + FLDA #CARG + FMULM #CARG /C*C + FLDA #CARG+3 + FMUL #CARG+3 /D*D + FADDM #CARG /C*C+D*D + FLDA TEMP + FSUB TEMP2 /B*C-A*D + FDIV #CARG /(B*C-A*D)/(C*C+D*D) + FSTA #CAC+3 + FLDA #CAC + FDIV #CARG /(A*C+B*D)/(C*C+D*D) + FSTA #CAC + STARTE + JA #CDV +TEMP, 0;0;0 +TEMP2, 0;0;0 +#CARG, 0;0;0 + 0;0;0 + ENTRY #CAC +#CAC, 0;0;0 + 0;0;0 + END + diff --git a/sw/f4/FRTSRC/cexp.ra b/sw/f4/FRTSRC/cexp.ra new file mode 100644 index 0000000..7a9dbd0 --- /dev/null +++ b/sw/f4/FRTSRC/cexp.ra @@ -0,0 +1,71 @@ +/ +/ C E X P +/ - - - - +/ +/ COMPLEX EXPONENT ROUTINE +/Z=X+IY +/ +/ VERSION 5A 4-25-77 MH +/ +/ +/CEXP(Z)=EXP(X)*(COS(Y)+I*SIN(Y)) +/ENTER+EXIT IN COMPLEX +/EXTERNAL EXP,SIN,COS +/ + SECT CEXP + JA #CEXP + DPCHK + TEXT +CEXP + +CEXPXR, SETX XR + SETB BP + JA .+3 +BP, F 0.0 +XR, F 0.0 +ARG, F 0.0 + F 0.0 + ORG 10*3+BP + FNOP + JA CEXPXR + 0 +RT, JA . + BASE 0 +#CEXP, STARTD + FLDA 10*3 + FSTA RT + FLDA 0 + SETB BP + SETX XR + BASE BP + LDX 1,1 + FSTA BP + FLDA% BP,1 + FSTA BP + STARTE + FLDA% BP + FSTA ARG + STARTF + EXTERN EXP + JSR EXP /EXP(X) + JA CEX1 + JA ARG +CEX1, FSTA ETEMP + EXTERN COS + JSR COS /COS(Y) + JA CEX2 + JA ARG+3 +CEX2, FSTA ARG + EXTERN SIN + JSR SIN /SIN(Y) + JA CEX3 + JA ARG+3 +CEX3, FSTA ARG+3 + FLDA ETEMP + FMULM ARG + FMULM ARG+3 + STARTE + FLDA ARG + FSTA #CAC + JA RT + EXTERN #CAC +ETEMP, F 0.0 + diff --git a/sw/f4/FRTSRC/chars.ra b/sw/f4/FRTSRC/chars.ra new file mode 100644 index 0000000..58ae83d --- /dev/null +++ b/sw/f4/FRTSRC/chars.ra @@ -0,0 +1,176 @@ +/ +/ VERSION 5A 4-27-77 PT +/ + SECT CHARS + ENTRY CGET + ENTRY CPUT + TEXT +CHARS+ +CHARXR, SETX XRCHAR + SETB BPCHAR +BPCHAR, F 0. +XRCHAR, F 0. +FROM, F 0. +NCHAR, F 0. + ORG 10*3+BPCHAR + FNOP + JA CHARXR + 0 +CHARTN, JA . + BASE 0 +START, JA . + STARTD + FLDA 10*3 + FSTA CHARTN + FLDA 0 + SETX XRCHAR + SETB BPCHAR + BASE BPCHAR + LDX 1,1 + FSTA BPCHAR /STR SAVED IN BPCHAR + FLDA% BPCHAR,1 + FSTA STR + FLDA% BPCHAR,1+ + FSTA NCHAR + FLDA% BPCHAR,1+ + FSTA FROM /ADDR OF F + STARTF + FLDA% NCHAR + ATX 0 + JA START +/ +CGET, JSA START + TRAP4 CGETIT + XTA 0 + FSTA% FROM /TO 3 WORDS + JA CHARTN +/ +CPUT, JSA START + FLDA% FROM + ATX 1 + FCLA + TRAP4 CPUTIT + JA CHARTN +/ + SECT8 CHAR /ALL IN 1 PAGE +CGETIT, 0 + JMS FLDRTN + TAD O2FLD + DCA ORGFLD + TAD XFLD + DCA XR2FLD + TAD PFLD + DCA GFLD +GFLD, 0 /STR FIELD + TAD% STR-1 +ORGFLD, 0 /THIS ROUTINE + DCA LOC + TAD XR /N + RAR + SNL CLA + JMP RIGHT + CLL + TAD LOC + RTR + RTR + RTR +BOTH, AND P77 +XR2FLD, 0 + DCA% QXR+1 /PASS TO FPP + CDF CIF 0 + JMP% CGETIT +RIGHT, TAD LOC + JMP BOTH +CADD, ADDR CGETIT + 0 +STR, 0 + 0 +/ +CPUTIT, 0 + JMS FLDRTN + TAD QXR1 + AND P7 + RTL + RAL + TAD CDFINS + DCA XR1FLD + TAD O2FLD + DCA O1FLD + TAD O2FLD + DCA O3FLD + TAD PFLD + DCA P1FLD +XR1FLD, 0 + TAD% QXR1+1 /F VALUE +O1FLD, 0 + AND P77 + DCA LOC +P1FLD, 0 + TAD% STR-1 +O3FLD, 0 + DCA XR1FLD /USE AS A TMP + TAD XR + RAR + SNL CLA + JMP PRIGHT + CLL + TAD XR1FLD + AND P77 /SAVE RIGHT HALF + DCA XR1FLD + TAD LOC + RTL + RTL + RTL + TAD XR1FLD +PFLD, 0 + DCA% STR-1 + CIF CDF 0 + JMP% CPUTIT +PRIGHT, TAD XR1FLD + AND P7700 + TAD LOC + JMP PFLD +/ +FLDRTN, 0 + TAD CADD + AND P7 + RTL + RAL + TAD CDFINS + DCA O2FLD + TAD QXR + AND P7 + RAL + RTL + TAD CDFINS + DCA XFLD +XFLD, 0 + TAD% QXR+1 +O2FLD, 0 + DCA XR + TAD XR + RAR + SNL + TAD M1 + CLL + TAD STR+1 + DCA STR-1 + SZL CLA + IAC + CLL + TAD STR + AND P7 + RAL + RTL + TAD CDFINS + DCA PFLD /STR FLD + JMP% FLDRTN +P77, 77 +CDFINS, 6203 +P7, 7 +QXR, ADDR XRCHAR +LOC, 0 +XR, 0 +M1, -1 +QXR1, ADDR XRCHAR+1 +P7700, 7700 + diff --git a/sw/f4/FRTSRC/chkeof.ra b/sw/f4/FRTSRC/chkeof.ra new file mode 100644 index 0000000..18416a0 --- /dev/null +++ b/sw/f4/FRTSRC/chkeof.ra @@ -0,0 +1,35 @@ +/ +/ VERSION 5A 4-26-77 MH +/ + SECT CHKEOF +/CHECKS END OF FILE CONDITION. +/ZEROS PASSED VARIABLE + PASSES ITS ADDRESS TO #EOFSW +/FRTS DOES REST + EXTERN #EOFSW + BASE CHKBAS + JA CODE +NAME, TEXT +CHKEOF+ +CHKBAS, F 0. +CHKXR, F 0. + BASE 0 +CODE, STARTD + FLDA 30 + FSTA CHKRTN /RETURN ADDR + FLDA 0 /GET PTR TO VARIABLE LIST + BASE CHKBAS + SETB CHKBAS + SETX CHKXR + FSTA CHKBAS + LDX 1,1 + FLDA% CHKBAS,1 /HERES PTR TO VAR ADDR + FSTA CHKBAS + JA PART2 + ORG 10*3+CHKBAS + FNOP + JA NAME+3 +PART2, FLDA CHKBAS + FSTA #EOFSW /PASS ADDR TO SYS + STARTF + FCLA + FSTA% CHKBAS /ZERO VAR +CHKRTN, JA . diff --git a/sw/f4/FRTSRC/clk8a.ra b/sw/f4/FRTSRC/clk8a.ra new file mode 100644 index 0000000..ccf875e --- /dev/null +++ b/sw/f4/FRTSRC/clk8a.ra @@ -0,0 +1,450 @@ +/PDP-8A OPTION 1 (100 HZ) CLOCK ROUTINE................CLK8A +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1975 +/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. +/ +/ +/ +/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A +/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- +/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE,OR ANY OTHER +/COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE +/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH A SYSTEM AND TO ONE WHO +/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE +/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. +/ +/ +/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT +/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL +/EQUIPMENT CORPORATION. +/ +/ +/DEC ASSUMES NO RESPONSIBILITY FOR THE USEOR RELIABILITY OF ITS +/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + + + + +/ +/E.P. 11/6/75 +/ VERSION 5A 4/26/77 MH +/ +/ + + + + + + + + EXTERN #DISP /SYSTEM PAGE 0,NEEDED TO + /PUT CLOCK STATUS ON PG0 + /(CSTAT) FOR USE BY GEN + /USER CLOCK SERVICE ROUTS + EXTERN #T812 /RTS CPTYP + EXTERN ONQI /INTERRUPT QUEUER + CLLE= 6135 /AC11=1 INTRRUPTS ON. + CLCL= 6136 /CLEAR CLOCK FLAG + CLSK= 6137 /SKIP ON CLOCK FLAG. + CSTAT=157 /IDOCLK PUTS CLSA BITS + /IN HERE + BASE FTMP0 + INDEX FCNWD + FIELD1 SYNC + JSA SETUP /HERE TO READ A STRIG + /INITIALIZE ARGS + TRAP4 DOSYNC /FCNWD (XR) HOLDS STRIG + /TO READ + XTA FCNWD /=ANS=0,1 + FSTA% FTMP1 /GIVE ANS TO CALLER + JA GOBAK +FTMP0, F 0.0 /BASE PAGE +FTMP1, F 0.0 +RPTR, 27;ADDR RTBL /PTR TO RATE TBL, ALSO + /USED TO FLT OVRCNT (NOTE + /THAT THE EXPONENT=27) +MINRAT, F .02 /MIN ALLOWABLE RATE +TOVR, F 0.0 +NAME, TEXT +CLOCK + + ORG 10*3+FTMP0 + FNOP + JA NAME+3 + 0 +GOBAK, JA . +RTBL, F 16.0 /CONSTANT USED TO CHK FOR + /EXT CLK BIT IN FCNWD + /THIS CONST MUST BE NE 0 +MAXRAT, +F4096, F 4096.0 /USED TO GET OVRFLO COUNT + F 100000.0 /FASTEST RATE IN HERTZ + F 10000.0 /NEXT FASTEST RATE + F 1000.0 + F 100.0 /SLOWEST RATE + F 1.0 /USED BY TIME FOR EXT CLK + BASE 0 + +SETUP, 0;0 /HERE TO INIT ALL FPP SUBS + STARTD + FLDA 30 /PICK UP RTN TO CALLER + FSTA GOBAK + FLDA 0 /GET PTR TO CALLERS ARGS + SETX FCNWD /CLOCK XR AND BASE + SETB FTMP0 + BASE FTMP0 + FSTA FTMP1 + FLDA% FTMP1,P1 + FSTA FTMP0 /PTR TO 1ST ARG + FLDA% FTMP1,P2 + FSTA FTMP1 /PTR TO 2ND ARG + FLDA #T812 /TELLS PDP8,PDP12 + ATX CPTYP /0=8=DK8ES,1=12=KW12A + STARTF + FLDA% FTMP0 /=1ST ARG + ATX FCNWD /ALWAYS IN FCNWD + JA SETUP + ENTRY CLOCK +CLOCK, JSA SETUP /HERE FOR CLOCK START + FLDA% FTMP0 + FSUB RTBL /FCNWD IS IN FAC,IF GE 16 + JGE ITSEXT /(RTBL=16.0) THEN USER IS + /REQUESTING AN EXTERNAL + /CLOCK I.E. B8 OF FCNWD + /IS SET. + FLDA% FTMP1 /=REQUESTED RATE IN HERTZ + FSUB MINRAT /.LE. MINUMUM RATE + JLE GOTR-2 /MEANS STOP CLOCK. + FADD MINRAT + FSUB MAXRAT /CHK FOR TOO FAST + JGT GOTR-2 + LDX -4,OVRFLO /THERE ARE 4 BASIC RATES + LDX 1,RATE /=INDEX INTO RTBL; UPON + /TRAP(CLOCK) RATE=(0, + /2,3,4,5,6) 0=STOP, + /6=EXTERNAL + /2-5=PROGRAMMABLE RATES +LOP0, FLDA% RPTR,RATE+ + /GET NEXT SLOWEST RATE + FDIV% FTMP1 /=REQUESTED RATE IN HZ. + /FAC=OVRFLO COUNT; + FSUB F4096 /MUST BE MODULO 12 BITS. + JLE GOTR /FOUND IT + JXN LOP0,OVRFLO+ + LDX 0,RATE /RATE IS TOO SLOW, STOP + /CLOCK. +GOTR, FADD F4096 /RESTORE + FSTA TOVR + ATX OVRFLO /OVER FLOW COUNT + TRAP4 SETCLK /GO START CLOCK + JA GOBAK /RTN TO CALLER +ITSEXT, LDX 6,RATE /=RATE FOR EXT CLK + FLDA% FTMP1 /REQUESTED RATE IS + /INTERPRETED AS OVRFLO + JA GOTR+1 /WHEN RATE IS EXTERNAL + /MAGIC TABLE USED BY SETCLK TO SET CLOCK ENABLE +/BITS. EVEN NUMBERED ENTRIES ARE FOR THE DK8ES; +/ODD NUMBERED ONES ARE FOR THE KW12A. + +CLKTBL, 0675 /"STANDARD" DK BITS + 300 /STND KW BITS + 1 /DK STRIG1 BIT + 60 /KW STRIG1 BITS + 2 /DK S2 + 14 /KW S2 + 4 /S3 +P3, 3 /S3 + 40 /DK ADC ON OVR BIT + 400 /KW ADC ON OVR BIT + + /IF NOT NEXT PAGE DO ORG + IFNEG .-200 < ORG .-SYNC&7600+200+SYNC > + SETCLK, 0 /TRAP HERE TO START CLK + /THIS ROUT HANDLES BOTH + /DK8ES AND KW12A. + CLCL /TRY AND CLEAR IT HERE???? +/ CLLR /STOP KW AND SET MODE 0; + /NOP FOR DK. +/ CLEN /CLR KW12 ENABLE OR + /READ DK ENABLE. +/ CLA +/ TAD P7540 /TOGGLE KW MODE 0 TO 1 TO +/ CLLR /CLR CLK COUNTER, OR SET + /DK ENABLE BITS, RATE FOR +/ CLA CMA /BOTH NOW=7=STOP. +/ CLZE /CLR ALL DK ENABLE BITS, +/ CLSA /CLR STATUS OF BOTH, ALL + CLA /IS NOW CLEAR. + TAD FCNTBL+1 /SET PTR TO CLKTBL FOR + /SETTING OF ENABLE REGS. + TAD CPTYP /=0 IF PDP8 =1 IF PDP12 + DCA FCNPTR /TBL ENTRIES ALTERNATE + /FOR 8 AND 12. CPTYP SETS + /PTR TO 1ST 8 OR 1ST 12 + /ENTRY + TAD IDOCLK /(AC=JMP AROUND). THE + /FOLLOWING IS ONCE ONLY + /CODE. THESE LOCS ARE + /SUBSEQUENTLY USED AS + /OPERANDS + DCA .-1 + /THE TAG "ISVBIT" MUST BE + /IN FRONT OF THE STRIG + /FLAGS (STFLG) TO COVER + /THE ILLEGAL CASE OF + /STRIG 0 IN A FORT CALL + /TO SYNC. +ISVBIT, TAD CPTYP /(AC=0,1) MAKE THE INST + /RAR CLL (FOR DK) OR THE + /INST RTR CLL FOR IDOCLK; +STFLG, RAL CLL /BECAUSE STATUS BITS FOR + TAD RARCLL /STRIGS DIFFER ON DK,KW. + DCA LOP2+1 /SEE SUB IDOCLK. + /THE ABOVE 3 LOCS ARE + /SCHMITT TRIGGER FLAGS. + /THE ORDER IS S1,S2,S3 + /FOR PDP8 AND S3,S2,S1 + /FOR PDP12. (CHK THE STATUS + /BITS FOR DK AND KW). + JMS% KONQI+1 /PUT CLOCK ON THE +ITMP0, CLSK /INTERRUPT QUE + /VIA ONQI. +CLENAB, ADDR IDOCLK /THIS LOC WILL HOLD THE + /ENABLE BITS FOR DK,KW +AROUND, TAD RATE /(AC=0,2,3,4,5,6) RATE IS + /SET BY FPP + RTR CLL /START TO POSITION RATE + RAR /BITS. B3-B5 FOR DK + /B0-B2 FOR KW + TAD CPTYP /(THIS IS TRICKY) NEED + RAR /CPTYP IN LNK BECAUSE + /POSITION OF RATE BITS + /DIFFER FOR DK KW. + TAD% FCNPTR /AC="STANDARD" + /ENABLE BITS FOR DK,KW. + SZL /IF ITS A KW THE RATE AND + /AND STND BITS ARE ALREADY + /POSITIONED AS FOLLOWS: + /RRR011000000 + /B0-B3 AND B5 WILL GO TO + /KW CONTROL. B4,B5 WILL + /GO TO ENABLE. B3 IS ADC + /ON OVRFLO AND MAY BE SET + /BELOW. B5 ON CONTROL IS + /MODE 1. B4 AND B5 ON + /ENABLE ARE BUFF PRESET TO + /CLOCK COUNTER AND INTRUPT + /ON OVRFLO RESPECTIVELY. + JMP NOBIT-1 /ITS KW GO PUT IN CLENAB. + RTR /ITS DK; POSITION RATE TO + RAR /B3-B5. NOTE THAT THE LNK + /(CPTYP=0) IS BEING USED. + CMA /NOTE ALSO THAT THE RATE + /AND STND BITS ARE THE 1S + /COMP. OF WHAT THEY SHOULD + /BE, IE CPTYP=LNK=0 + /BECOMES + /B2=1 OF ENABLE=BUFF + /PRESET TO CLK CNTR ON + /OVERFLO. LOOK AT THE RATE + /BITS IN THE HANDBOOK FOR + /BOTH DK,KW. R2,R5 + /FOR DK IS 100HZ, 100KHZ + /RESPECTIVELY. R2,R5 FOR + /KW IS 100KHZ,100HZ. + /1S COMP.OF 2=5 ETC. + /SMARTEN UP STEVE! + /THE FINAL VALUE OF THE + /STND DK ENABLE BITS (1ST + /ENTRY IN CLKTBL) IS LEFT + /AS AN EXERCISE FOR THE + /PROGRAMMER. + JMP NOBIT-1 /GO PUT IN CLENAB +LOP1, RAR CLL /ROT 1 FCN BIT INTO LNK. + /B7=EXT CLK AND IS + /IGNORED HERE. B8=ADC ON + /OVRFLO, B9-B11 ARE STRIG3 + /-STRIG1 RESP. BX=1=ENABLE + /FCN. 0=DISABLE + DCA FCNWD /PUT IT BACK (FCNWD IS + /SET BY FPP) + SNL /ENABLE FCN ? + JMP NOBIT /NO + TAD% FCNPTR /GET BITS FROM THE MAGIC + TAD CLENAB /TABLE. + DCA CLENAB /UPDATE ENABLE WORD. +NOBIT, ISZ FCNPTR /ADV TO NEXT + ISZ FCNPTR /TBL ENTRY. + TAD FCNWD /WHEN FCNWD GOES TO 0 + AND P17 /WE ARE ALL DONE. + /THE "AND" IS DONE TO + /PROTECT AGAINST A BAD + /ARG FROM THE FORT CALL. +P7540, SMA SZA /SMA IS SUPERFLOUS TO + /THE ROUT; BUT IT + /CREATES A NICE CONST. + JMP LOP1 /MORE TO DO + DCA STFLG /CLR THE SCHMITT + DCA STFLG+1 /TRIGGER FLAGS. + DCA STFLG+2 + TAD OVRFLO /SET BUFF PRESET + CIA /(FPP SET THIS ARG) +/ CLAB + CLA + TAD CLENAB /THIS IS FOR KW ONLY. + AND P377 /AC=3XX. 3= OR BUFF PRE + /INTO CLK CNTR AND ENAB + /INT ON OVRFLO. + /XX ARE THE STRIGS. +/ CLEN /SET KW ENABLE OR + CLA /READ DK ENABLE. + DCA OVRCNT+1 /CLR NUM OF CLK OVRFLOS + DCA OVRCNT /SINCE TIME 0. + TAD CPTYP /NEED TYPE IN ORDER TO +RARCLL, RAR CLL /ISOLATE CONTROL + TAD CLENAB /BITS FOR + SZL /KW ? + AND P7540 /YES, B0-B2 IS RATE, + /B3 IS ADC, B5 IS BUFF + /PRE TO CLK CNTR ON + /OVRFLO, B6 IS MOX NIX. + /IF DK ALL BITS MAY HAVE + /MEANING + CLA IAC /SET BIT 11 + CLLE /ENABLE THE CLOCK INTERRUPTS +/ CLLR /START THE CLOCK + CLA + CIF CDF + JMP% SETCLK /RTN TO RTS + DOSYNC, 0 /HERE TO DISPOSITION A + /A SCHMITT TRIGGER. + TAD CPTYP /DK AND KW FLAGS ARE IN + RAR CLL /REVERSE ORDER. IF DK + /ARG IS OK; IF KW THEN + /MUST SET 1=3, 2=2, 3=1 + /TO GET INDEX TO + /CORRECT FLAG. + TAD FCNWD /=REQUESTED STRIG=1,2,3 + /(SET BY FPP) + SZL /DK ? + CIA /NO KW + AND P3 /IE 1 GOES TO -1 GOES + /TO 3 ETC. "AND" ALSO + /INSURES RANGE IS 0-3. + /IF ARG IS 0 RESULT IS + /ALWAYS 0. + TAD KSTFLG+1 /GET PTR TO FLAG + DCA SETCLK + TAD% SETCLK /FLAG=0 IF TRIG HAS NOT + /TRIPPED SINCE THE LAST + /CALL TO SYNC; =1 + /OTHERWISE IE RTN 0=FALSE + DCA FCNWD /,1=TRUE (FPP WILL PICK + / UP FCNWD) + DCA% SETCLK /CLR FLAG ANYWAY + CIF CDF + JMP% DOSYNC /RTN TO RTS + IDOCLK, JMP AROUND /HERE ON CLOCK INTERRUPT + /(JMP AROUND IS A ONCE + /ONLY CONSTANT). + CLCL /JUST TO MAKE SURE! + TAD KSTFLG+1 /SET PTR TO STRIG FLAGS. + DCA ITMP0 +/ CLSA /GET CLOCK BITS. + CLA CLL CML RAR /SIMULATE TICK + DCAZ CSTAT /SAVE THEM FOR SOME + TADZ CSTAT /BODY ELSE. + SPA /OVER FLOW ? + ISZ OVRCNT+1 /YES BUMP LO ORD CNTR + SKP + ISZ OVRCNT /BUMP HI ORD + JMP DOTRIG /(HI ORD ISZ SKP IS + /HARMLESS) +LOP2, ISZ ITMP0 /ADV STRIG FLAG PTR. + RAR CLL /(OR RTR CLL IF KW) + /IE PUT STRIG BIT IN LNK. + /IF DK THE ORDER OF + /INTERROGATION IS S1,S2,S3 + /IF KW THE ORDER IS S3, + /S2,S1. THE STATUS BITS + /FOR DK ARE ADJACENT IE + / B9(S3),B10(S2),B11(S1) + /FOR KW ITS EVERY OTHER, + /B6(S1),B8(S2),B10(S3). + DCA ISVBIT /SAVE WHATS LEFT. + RAL /COPY LNK INTO FLAG IF=1 + SZA /IE DONT CLR FLAG WHEN + DCA% ITMP0 /ITS SET. + TAD ISVBIT +DOTRIG, AND P377 /THE "AND" INSURES THAT + /THE HI ORD BITS ARE + /CLRED SO THAT ISVBIT + /GOES TO 0 WHEN ALL + /STRIGS HAVE BEEN + /DISPOSITIONED. IE + /CLR OVRFLO BIT FOR DK,KW + /AND CLR PRE-EVENT BIT + /ON KW IF IT IS SET + SZA /DONE ? + JMP LOP2 /NO + TAD #CLINT /CALL USER EXTENDED + SZA CLA /CLOCK ROUT ? + JMS% #CLINT+1 /YES + JMP% IDOCLK /RTN TO IHANDL + FCNPTR, +OVRCNT, +KONQI, ADDR ONQI +P17, 17 +P377, 377 +FCNWD, 0 /FPP XRS +CPTYP, 0 +RATE, 0 +P1, 1 +P2, 2 +OVRFLO, +FCNTBL, ADDR CLKTBL +KSTFLG, ADDR STFLG-1 + ENTRY #CLINT +#CLINT, 0;0 + ENTRY TIME /FIGURE WHAT TIME IT IS +TIME, JSA SETUP + FLDA RPTR /=27;X;X IS USED TO FLOAT + STARTD + FLDA# OVRCNT /NUM OF CLK OVRFLOS SINCE + STARTF /TIME 0 + FNORM + FMUL TOVR /=NUM OF BASIC TICKS PER + /CLOCK OVER FLOW. + /FAC=NUM OF TICKS SINCE + /TIME 0. + FDIV% RPTR,RATE /DIV BY BASIC RATE IN HZ + /OR 1 IF EXTERNAL CLK. + FSTA% FTMP0 /GIVE ANS TO CALLER, ALSO + /LEAVE ANS IN FAC IN + /CASE TIME WAS A FCN + /CALL. ANS=ELAPSED TIME IN + /SECONDS SINCE TIME 0 OR + /NUM OF EXTERNAL UNIT + JA GOBAK /TICKS + diff --git a/sw/f4/FRTSRC/clock.ra b/sw/f4/FRTSRC/clock.ra new file mode 100644 index 0000000..a994281 --- /dev/null +++ b/sw/f4/FRTSRC/clock.ra @@ -0,0 +1,399 @@ +/ +/ VERSION 5A 4/26/77 MH +/ + EXTERN #DISP /SYSTEM PAGE 0,NEEDED TO + /PUT CLOCK STATUS ON PG0 + /(CSTAT) FOR USE BY GEN + /USER CLOCK SERVICE ROUTS + EXTERN #T812 /RTS CPTYP + EXTERN ONQI /INTERRUPT QUEUER + CLZE=6130 /CLOCK IOTS + CLSK=6131 + CLLR=6132 /ALSO CLOE + CLAB=6133 + CLEN=6134 + CLSA=6135 + CSTAT=157 /IDOCLK PUTS CLSA BITS + /IN HERE + BASE FTMP0 + INDEX FCNWD + FIELD1 SYNC + JSA SETUP /HERE TO READ A STRIG + /INITIALIZE ARGS + TRAP4 DOSYNC /FCNWD (XR) HOLDS STRIG + /TO READ + XTA FCNWD /=ANS=0,1 + FSTA% FTMP1 /GIVE ANS TO CALLER + JA GOBAK +FTMP0, F 0.0 /BASE PAGE +FTMP1, F 0.0 +RPTR, 27;ADDR RTBL /PTR TO RATE TBL, ALSO + /USED TO FLT OVRCNT (NOTE + /THAT THE EXPONENT=27) +MINRAT, F .02 /MIN ALLOWABLE RATE +TOVR, F 0.0 +NAME, TEXT +CLOCK + + ORG 10*3+FTMP0 + FNOP + JA NAME+3 + 0 +GOBAK, JA . +RTBL, F 16.0 /CONSTANT USED TO CHK FOR + /EXT CLK BIT IN FCNWD + /THIS CONST MUST BE NE 0 +MAXRAT, +F4096, F 4096.0 /USED TO GET OVRFLO COUNT + F 100000.0 /FASTEST RATE IN HERTZ + F 10000.0 /NEXT FASTEST RATE + F 1000.0 + F 100.0 /SLOWEST RATE + F 1.0 /USED BY TIME FOR EXT CLK + BASE 0 + +SETUP, 0;0 /HERE TO INIT ALL FPP SUBS + STARTD + FLDA 30 /PICK UP RTN TO CALLER + FSTA GOBAK + FLDA 0 /GET PTR TO CALLERS ARGS + SETX FCNWD /CLOCK XR AND BASE + SETB FTMP0 + BASE FTMP0 + FSTA FTMP1 + FLDA% FTMP1,P1 + FSTA FTMP0 /PTR TO 1ST ARG + FLDA% FTMP1,P2 + FSTA FTMP1 /PTR TO 2ND ARG + FLDA #T812 /TELLS PDP8,PDP12 + ATX CPTYP /0=8=DK8ES,1=12=KW12A + STARTF + FLDA% FTMP0 /=1ST ARG + ATX FCNWD /ALWAYS IN FCNWD + JA SETUP + ENTRY CLOCK +CLOCK, JSA SETUP /HERE FOR CLOCK START + FLDA% FTMP0 + FSUB RTBL /FCNWD IS IN FAC,IF GE 16 + JGE ITSEXT /(RTBL=16.0) THEN USER IS + /REQUESTING AN EXTERNAL + /CLOCK I.E. B8 OF FCNWD + /IS SET. + FLDA% FTMP1 /=REQUESTED RATE IN HERTZ + FSUB MINRAT /.LE. MINUMUM RATE + JLE GOTR-2 /MEANS STOP CLOCK. + FADD MINRAT + FSUB MAXRAT /CHK FOR TOO FAST + JGT GOTR-2 + LDX -4,OVRFLO /THERE ARE 4 BASIC RATES + LDX 1,RATE /=INDEX INTO RTBL; UPON + /TRAP(CLOCK) RATE=(0, + /2,3,4,5,6) 0=STOP, + /6=EXTERNAL + /2-5=PROGRAMMABLE RATES +LOP0, FLDA% RPTR,RATE+ + /GET NEXT SLOWEST RATE + FDIV% FTMP1 /=REQUESTED RATE IN HZ. + /FAC=OVRFLO COUNT; + FSUB F4096 /MUST BE MODULO 12 BITS. + JLE GOTR /FOUND IT + JXN LOP0,OVRFLO+ + LDX 0,RATE /RATE IS TOO SLOW, STOP + /CLOCK. +GOTR, FADD F4096 /RESTORE + FSTA TOVR + ATX OVRFLO /OVER FLOW COUNT + TRAP4 SETCLK /GO START CLOCK + JA GOBAK /RTN TO CALLER +ITSEXT, LDX 6,RATE /=RATE FOR EXT CLK + FLDA% FTMP1 /REQUESTED RATE IS + /INTERPRETED AS OVRFLO + JA GOTR+1 /WHEN RATE IS EXTERNAL + /MAGIC TABLE USED BY SETCLK TO SET CLOCK ENABLE +/BITS. EVEN NUMBERED ENTRIES ARE FOR THE DK8ES; +/ODD NUMBERED ONES ARE FOR THE KW12A. + +CLKTBL, 0675 /"STANDARD" DK BITS + 300 /STND KW BITS + 1 /DK STRIG1 BIT + 60 /KW STRIG1 BITS + 2 /DK S2 + 14 /KW S2 + 4 /S3 +P3, 3 /S3 + 40 /DK ADC ON OVR BIT + 400 /KW ADC ON OVR BIT + + /IF NOT NEXT PAGE DO ORG + IFNEG .-200 < ORG .-SYNC&7600+200+SYNC > + SETCLK, 0 /TRAP HERE TO START CLK + /THIS ROUT HANDLES BOTH + /DK8ES AND KW12A. + CLLR /STOP KW AND SET MODE 0; + /NOP FOR DK. + CLEN /CLR KW12 ENABLE OR + /READ DK ENABLE. + CLA + TAD P7540 /TOGGLE KW MODE 0 TO 1 TO + CLLR /CLR CLK COUNTER, OR SET + /DK ENABLE BITS, RATE FOR + CLA CMA /BOTH NOW=7=STOP. + CLZE /CLR ALL DK ENABLE BITS, + CLSA /CLR STATUS OF BOTH, ALL + CLA /IS NOW CLEAR. + TAD FCNTBL+1 /SET PTR TO CLKTBL FOR + /SETTING OF ENABLE REGS. + TAD CPTYP /=0 IF PDP8 =1 IF PDP12 + DCA FCNPTR /TBL ENTRIES ALTERNATE + /FOR 8 AND 12. CPTYP SETS + /PTR TO 1ST 8 OR 1ST 12 + /ENTRY + TAD IDOCLK /(AC=JMP AROUND). THE + /FOLLOWING IS ONCE ONLY + /CODE. THESE LOCS ARE + /SUBSEQUENTLY USED AS + /OPERANDS + DCA .-1 + /THE TAG "ISVBIT" MUST BE + /IN FRONT OF THE STRIG + /FLAGS (STFLG) TO COVER + /THE ILLEGAL CASE OF + /STRIG 0 IN A FORT CALL + /TO SYNC. +ISVBIT, TAD CPTYP /(AC=0,1) MAKE THE INST + /RAR CLL (FOR DK) OR THE + /INST RTR CLL FOR IDOCLK; +STFLG, RAL CLL /BECAUSE STATUS BITS FOR + TAD RARCLL /STRIGS DIFFER ON DK,KW. + DCA LOP2+1 /SEE SUB IDOCLK. + /THE ABOVE 3 LOCS ARE + /SCHMITT TRIGGER FLAGS. + /THE ORDER IS S1,S2,S3 + /FOR PDP8 AND S3,S2,S1 + /FOR PDP12. THE MAIN + /REASON FOR REVERSING + /THE ORDER IS BECAUSE + /ENGINEERS NEVER CONSULT + /PROGRAMMERS WHEN THEY + /ARE BUILDING NEW + /HARDWARE (CHK THE STATUS + /BITS FOR DK AND KW). + JMS% KONQI+1 /PUT CLOCK ON THE +ITMP0, CLSK /INTERRUPT QUE + /VIA ONQI. +CLENAB, ADDR IDOCLK /THIS LOC WILL HOLD THE + /ENABLE BITS FOR DK,KW +AROUND, TAD RATE /(AC=0,2,3,4,5,6) RATE IS + /SET BY FPP + RTR CLL /START TO POSITION RATE + RAR /BITS. B3-B5 FOR DK + /B0-B2 FOR KW + TAD CPTYP /(THIS IS TRICKY) NEED + RAR /CPTYP IN LNK BECAUSE + /POSITION OF RATE BITS + /DIFFER FOR DK KW. + TAD% FCNPTR /AC="STANDARD" + /ENABLE BITS FOR DK,KW. + SZL /IF ITS A KW THE RATE AND + /AND STND BITS ARE ALREADY + /POSITIONED AS FOLLOWS: + /RRR011000000 + /B0-B3 AND B5 WILL GO TO + /KW CONTROL. B4,B5 WILL + /GO TO ENABLE. B3 IS ADC + /ON OVRFLO AND MAY BE SET + /BELOW. B5 ON CONTROL IS + /MODE 1. B4 AND B5 ON + /ENABLE ARE BUFF PRESET TO + /CLOCK COUNTER AND INTRUPT + /ON OVRFLO RESPECTIVELY. + JMP NOBIT-1 /ITS KW GO PUT IN CLENAB. + RTR /ITS DK; POSITION RATE TO + RAR /B3-B5. NOTE THAT THE LNK + /(CPTYP=0) IS BEING USED. + CMA /NOTE ALSO THAT THE RATE + /AND STND BITS ARE THE 1S + /COMP. OF WHAT THEY SHOULD + /BE, IE CPTYP=LNK=0 + /BECOMES + /B2=1 OF ENABLE=BUFF + /PRESET TO CLK CNTR ON + /OVERFLO. LOOK AT THE RATE + /BITS IN THE HANDBOOK FOR + /BOTH DK,KW. R2,R5 + /FOR DK IS 100HZ, 100KHZ + /RESPECTIVELY. R2,R5 FOR + /KW IS 100KHZ,100HZ. + /1S COMP.OF 2=5 ETC. + /SMARTEN UP STEVE! + /THE FINAL VALUE OF THE + /STND DK ENABLE BITS (1ST + /ENTRY IN CLKTBL) IS LEFT + /AS AN EXERCISE FOR THE + /PROGRAMMER. + JMP NOBIT-1 /GO PUT IN CLENAB +LOP1, RAR CLL /ROT 1 FCN BIT INTO LNK. + /B7=EXT CLK AND IS + /IGNORED HERE. B8=ADC ON + /OVRFLO, B9-B11 ARE STRIG3 + /-STRIG1 RESP. BX=1=ENABLE + /FCN. 0=DISABLE + DCA FCNWD /PUT IT BACK (FCNWD IS + /SET BY FPP) + SNL /ENABLE FCN ? + JMP NOBIT /NO + TAD% FCNPTR /GET BITS FROM THE MAGIC + TAD CLENAB /TABLE. + DCA CLENAB /UPDATE ENABLE WORD. +NOBIT, ISZ FCNPTR /ADV TO NEXT + ISZ FCNPTR /TBL ENTRY. + TAD FCNWD /WHEN FCNWD GOES TO 0 + AND P17 /WE ARE ALL DONE. + /THE "AND" IS DONE TO + /PROTECT AGAINST A BAD + /ARG FROM THE FORT CALL. + /IN A FRIENDLY ENIVORN, + /ITS NOT NECESSARY. + /NEVER TRUST A FORTRAN + /"PROGRAMMER". +P7540, SMA SZA /SMA IS SUPERFLOUS TO + /THE ROUT; BUT IT + /CREATES A NICE CONST. + JMP LOP1 /MORE TO DO + DCA STFLG /CLR THE SCHMITT + DCA STFLG+1 /TRIGGER FLAGS. + DCA STFLG+2 + TAD OVRFLO /SET BUFF PRESET + CIA /(FPP SET THIS ARG) + CLAB + CLA + TAD CLENAB /THIS IS FOR KW ONLY. + AND P377 /AC=3XX. 3= OR BUFF PRE + /INTO CLK CNTR AND ENAB + /INT ON OVRFLO. + /XX ARE THE STRIGS. + CLEN /SET KW ENABLE OR + CLA /READ DK ENABLE. + DCA OVRCNT+1 /CLR NUM OF CLK OVRFLOS + DCA OVRCNT /SINCE TIME 0. + TAD CPTYP /NEED TYPE IN ORDER TO +RARCLL, RAR CLL /ISOLATE CONTROL + TAD CLENAB /BITS FOR + SZL /KW ? + AND P7540 /YES, B0-B2 IS RATE, + /B3 IS ADC, B5 IS BUFF + /PRE TO CLK CNTR ON + /OVRFLO, B6 IS MOX NIX. + /IF DK ALL BITS MAY HAVE + /MEANING + CLLR /START THE CLOCK + CLA + CIF CDF + JMP% SETCLK /RTN TO RTS + DOSYNC, 0 /HERE TO DISPOSITION A + /A SCHMITT TRIGGER. + TAD CPTYP /DK AND KW FLAGS ARE IN + RAR CLL /REVERSE ORDER. IF DK + /ARG IS OK; IF KW THEN + /MUST SET 1=3, 2=2, 3=1 + /TO GET INDEX TO + /CORRECT FLAG. + TAD FCNWD /=REQUESTED STRIG=1,2,3 + /(SET BY FPP) + SZL /DK ? + CIA /NO KW + AND P3 /IE 1 GOES TO -1 GOES + /TO 3 ETC. "AND" ALSO + /INSURES RANGE IS 0-3. + /IF ARG IS 0 RESULT IS + /ALWAYS 0. + TAD KSTFLG+1 /GET PTR TO FLAG + DCA SETCLK + TAD% SETCLK /FLAG=0 IF TRIG HAS NOT + /TRIPPED SINCE THE LAST + /CALL TO SYNC; =1 + /OTHERWISE IE RTN 0=FALSE + DCA FCNWD /,1=TRUE (FPP WILL PICK + / UP FCNWD) + DCA% SETCLK /CLR FLAG ANYWAY + CIF CDF + JMP% DOSYNC /RTN TO RTS + IDOCLK, JMP AROUND /HERE ON CLOCK INTERRUPT + /(JMP AROUND IS A ONCE + /ONLY CONSTANT). + TAD KSTFLG+1 /SET PTR TO STRIG FLAGS. + DCA ITMP0 + CLSA /GET CLOCK BITS. + DCAZ CSTAT /SAVE THEM FOR SOME + TADZ CSTAT /BODY ELSE. + SPA /OVER FLOW ? + ISZ OVRCNT+1 /YES BUMP LO ORD CNTR + SKP + ISZ OVRCNT /BUMP HI ORD + JMP DOTRIG /(HI ORD ISZ SKP IS + /HARMLESS) +LOP2, ISZ ITMP0 /ADV STRIG FLAG PTR. + RAR CLL /(OR RTR CLL IF KW) + /IE PUT STRIG BIT IN LNK. + /IF DK THE ORDER OF + /INTERROGATION IS S1,S2,S3 + /IF KW THE ORDER IS S3, + /S2,S1. THE STATUS BITS + /FOR DK ARE ADJACENT IE + / B9(S3),B10(S2),B11(S1) + /FOR KW ITS EVERY OTHER, + /B6(S1),B8(S2),B10(S3). + DCA ISVBIT /SAVE WHATS LEFT. + RAL /COPY LNK INTO FLAG IF=1 + SZA /IE DONT CLR FLAG WHEN + DCA% ITMP0 /ITS SET. + TAD ISVBIT +DOTRIG, AND P377 /THE "AND" INSURES THAT + /THE HI ORD BITS ARE + /CLRED SO THAT ISVBIT + /GOES TO 0 WHEN ALL + /STRIGS HAVE BEEN + /DISPOSITIONED. IE + /CLR OVRFLO BIT FOR DK,KW + /AND CLR PRE-EVENT BIT + /ON KW IF IT IS SET + SZA /DONE ? + JMP LOP2 /NO + TAD #CLINT /CALL USER EXTENDED + SZA CLA /CLOCK ROUT ? + JMS% #CLINT+1 /YES + JMP% IDOCLK /RTN TO IHANDL + FCNPTR, +OVRCNT, +KONQI, ADDR ONQI +P17, 17 +P377, 377 +FCNWD, 0 /FPP XRS +CPTYP, 0 +RATE, 0 +P1, 1 +P2, 2 +OVRFLO, +FCNTBL, ADDR CLKTBL +KSTFLG, ADDR STFLG-1 + ENTRY #CLINT +#CLINT, 0;0 + ENTRY TIME /FIGURE WHAT TIME IT IS +TIME, JSA SETUP + FLDA RPTR /=27;X;X IS USED TO FLOAT + STARTD + FLDA# OVRCNT /NUM OF CLK OVRFLOS SINCE + STARTF /TIME 0 + FNORM + FMUL TOVR /=NUM OF BASIC TICKS PER + /CLOCK OVER FLOW. + /FAC=NUM OF TICKS SINCE + /TIME 0. + FDIV% RPTR,RATE /DIV BY BASIC RATE IN HZ + /OR 1 IF EXTERNAL CLK. + FSTA% FTMP0 /GIVE ANS TO CALLER, ALSO + /LEAVE ANS IN FAC IN + /CASE TIME WAS A FCN + /CALL. ANS=ELAPSED TIME IN + /SECONDS SINCE TIME 0 OR + /NUM OF EXTERNAL UNIT + JA GOBAK /TICKS + diff --git a/sw/f4/FRTSRC/clog.ra b/sw/f4/FRTSRC/clog.ra new file mode 100644 index 0000000..995e613 --- /dev/null +++ b/sw/f4/FRTSRC/clog.ra @@ -0,0 +1,81 @@ +/ +/ C L O G +/ - - - - +/ +/ VERSION 5A 4-27-77 PT +/ +/COMPLEX LOG ROUTINE +/ +/ENTER + EXIT IN COMPLEX +/ +/Z=X+IY +/LOG(Z)=LOG(ABS(Z))+I*THETA +/ABS(Z)=SQRT(X*X+Y*Y) +/THETA=ATAN(Y/X) +/ +/CALLS REAL SQRT,LOG,ATAN2 +/ + SECT CLOG + JA #CLOG + DPCHK + TEXT +CLOG + +CLOGXR, SETX XR + SETB BP + JA .+3 +BP, F 0.0 +XR, F 0.0 + F 0.0 +ARG, F 0.0 + F 0.0 + ORG 10*3+BP + FNOP + JA CLOGXR + 0 +RT, JA . + BASE 0 +#CLOG, STARTD + FLDA 10*3 + FSTA RT + FLDA 0 + SETB BP + SETX XR + BASE BP + LDX 1,1 + FSTA BP + FLDA% BP,1 + FSTA BP + STARTE + FLDA% BP + FSTA ARG + STARTF + EXTERN ATAN2 + JSR ATAN2 + JA CL1 + JA ARG+3 /ATAN(Y/X) + JA ARG +CL1, FSTA ETEMP + FLDA ARG + FMULM ARG + FLDA ARG+3 + FMUL ARG+3 /X*X+Y*Y + FADD ARG + FSTA ARG + EXTERN SQRT + JSR SQRT /TAKE SQRT + JA CL2 + JA ARG +CL2, FSTA ARG + EXTERN ALOG /ALOG(ABS(Z)) + JSR ALOG + JA CL3 + JA ARG +CL3, FSTA ARG /REAL PART + FLDA ETEMP /IMAGINARY PART + FSTA ARG+3 + STARTE + FLDA ARG + FSTA #CAC + JA RT + EXTERN #CAC +ETEMP, F 0.0 + diff --git a/sw/f4/FRTSRC/cmplx.ra b/sw/f4/FRTSRC/cmplx.ra new file mode 100644 index 0000000..a1886ff --- /dev/null +++ b/sw/f4/FRTSRC/cmplx.ra @@ -0,0 +1,51 @@ +/ +/ C M P L X +/ - - - - - +/ +/ VERSION 5A 4-27-77 PT +/ +/ENTER IN REAL,EXIT IN COMPLEX +/CMPLX(X,Y) +/Z=X+IY +/ + SECT CMPLX + JA #CMPLX + DPCHK + TEXT +CMPLX + +CMPXR, SETX XR + SETB BP +BP, F 0.0 +XR, F 0.0 +PTR1, F 0.0 +ARG, F 0.0 + F 0.0 + ORG 10*3+BP + FNOP + JA CMPXR + 0 +RT, JA . + BASE 0 +#CMPLX, STARTD + FLDA 10*3 + FSTA RT + FLDA 0 + SETB BP + SETX XR + BASE BP + LDX 1,1 + FSTA BP + FLDA% BP,1 + FSTA PTR1 /ADDR OF X + FLDA% BP,1+ + FSTA BP /ADDR OF Y + STARTF + FLDA% PTR1 + FSTA ARG /X + FLDA% BP + FSTA ARG+3 /Y + STARTE + FLDA ARG /X+IY + FSTA #CAC /SAVE IN CMPLX AC + JA RT + EXTERN #CAC + diff --git a/sw/f4/FRTSRC/cos.ra b/sw/f4/FRTSRC/cos.ra new file mode 100644 index 0000000..2bc39bd --- /dev/null +++ b/sw/f4/FRTSRC/cos.ra @@ -0,0 +1,48 @@ +/ +/ +/ C O S +/ - - - +/ +/SUBROUTINE COS(X) +/ +/ VERSION 5A 4-27-77 PT +/ + SECT COS + JA #COS + TEXT +COS + +COSXR, SETX XRCOS + SETB BPCOS +BPCOS, FNOP + 0 + 0 +XRCOS, F 0.0 +COS1, F 0.0 +FPI2CS, 1 /PI DIVIDED BY 2 + 3110 + 3755 + ORG 10*3+BPCOS + FNOP + JA COSXR + 0 +COSRTN, JA . + BASE 0 +#COS, STARTD + FLDA 10*3 + FSTA COSRTN + FLDA 0 + SETX XRCOS + SETB BPCOS + BASE BPCOS + LDX 1,1 + FSTA BPCOS + FLDA% BPCOS,1 /ADDR OF X + FSTA BPCOS + STARTF + FLDA% BPCOS /GET X + FADD FPI2CS /ADD IN PI OVER 2 + FSTA COS1 + EXTERN SIN + JSR SIN /AND CALL THE SIN + JA COSRTN + JA COS1 + diff --git a/sw/f4/FRTSRC/cosd.ra b/sw/f4/FRTSRC/cosd.ra new file mode 100644 index 0000000..021d4fa --- /dev/null +++ b/sw/f4/FRTSRC/cosd.ra @@ -0,0 +1,51 @@ +/ +/ +/ +/ C O S D +/ - - - - +/ +/SUBROUTINE COSD(X) +/ +/ VERSION 5A 4-27-77 PT +/ + SECT COSD + JA #COSD + TEXT +COSD + +COSDXR, SETX XRCOSD + SETB BPCOSD +BPCOSD, FNOP + 0 + 0 +XRCOSD, F 0.0 +COSD90, F 90. +COSD91, 6 + 3451 + 3560 +COSD1, F 0.0 + ORG 10*3+BPCOSD + FNOP + JA COSDXR + 0 +CSDRTN, JA . + BASE 0 +#COSD, STARTD + FLDA 10*3 + FSTA CSDRTN + FLDA 0 + SETX XRCOSD + SETB BPCOSD + BASE BPCOSD + LDX 1,1 + FSTA BPCOSD + FLDA% BPCOSD,1 /ADDR OF X + FSTA BPCOSD + STARTF + FLDA% BPCOSD /GET X IN DEGREES + FADD COSD90 /ADD IN 90 + FDIV COSD91 /CONVERT TO REDIANS + FSTA COSD1 + EXTERN SIN + JSR SIN /CALL THE SINE + JA CSDRTN + JA COSD1 + diff --git a/sw/f4/FRTSRC/cosh.ra b/sw/f4/FRTSRC/cosh.ra new file mode 100644 index 0000000..3715b77 --- /dev/null +++ b/sw/f4/FRTSRC/cosh.ra @@ -0,0 +1,83 @@ +/ +/ VERSION 5A 4-27-77 PT +/ +/ C O S H +/ - - - - +/ +/SUBROUTINE COSH(X) +/ +/ VERSION 5A 4-27-77 PT + SECT COSH + JA #COSH +COSHE, FLDA COSHB /GIVE INFINITY IN CASE OF NO REC + EXTERN #ARGER + TRAP4 #ARGER + TEXT +COSH + +COSHXR, SETX XRCOSH + SETB BPCOSH +BPCOSH, FNOP + 0 + 0 +XRCOSH, F 0.0 +COSH7, F 0.0 +COSH8, F 0.0 +F1COSH, F 1. +F2COSH, F 2. + ORG 10*3+BPCOSH + FNOP + JA COSHXR + 0 +CSHRTN, JA . +/ +COSHLG, 0 + 2613 + 4412 +/ +COSHB, 3777 + 3777 + 7777 +/ +/ +COSH1, F 88.029 /LIMIT FACTOR. + BASE 0 +#COSH, STARTD + FLDA 10*3 + FSTA CSHRTN + FLDA 0 + SETX XRCOSH + SETB BPCOSH + BASE BPCOSH + LDX 1,1 + FSTA BPCOSH + FLDA% BPCOSH,1 /ADDR OF X + FSTA BPCOSH + STARTF + FLDA% BPCOSH /GET X + FSTA COSH8 /SAVE ARGUMENT + JGE .+3 /ABS(X) + FNEG + FSTA COSH7 + FSUB COSH1 /TEST FOR LIMITS. + JGE COSHBG + EXTERN EXP + JSR EXP /EXP(X) + JA .+4 + JA COSH8 + FSTA COSH7 + FLDA F1COSH /1. + FDIV COSH7 / 1./EXP(X) + FADD COSH7 / EXP(X)+1./EXP(X) + FDIV F2COSH / (EXP(X)+1./EXP(X))2. + JA CSHRTN /AND THAT IS THE DEFINITION OF COSH. +/ +/ +COSHBG, FSUB COSHLG /SEE IF TOO BIG + JGT COSHE /YEP. ERROR + FADD COSH1 /READD IN SUBTRACTION FACTOR. + FSTA COSH8 / EXP(ABS(X)-LN(2)) + EXTERN EXP + JSR EXP + JA .+4 + JA COSH8 + JA CSHRTN / A VERY GOOD APPROXIMATION. + diff --git a/sw/f4/FRTSRC/csin.ra b/sw/f4/FRTSRC/csin.ra new file mode 100644 index 0000000..cc2b02b --- /dev/null +++ b/sw/f4/FRTSRC/csin.ra @@ -0,0 +1,98 @@ +/ +/ C S I N +/ - - - - +/ +/ VERSION 5A 4-27-77 PT +/ +/COMPLEX SIN AND COS ROUTINE +/ +/CCOS(X+I*Y)=COS(X)*COSH(Y)-SIN(X)*SINH(Y) +/ +/CSIN(X+I*Y)=SIN(X)*COSH(Y)+COS(X)*SINH(Y) +/ +/CALLS SIN,COS,COSH,SINH +/ + SECT CSIN + JA #CSIN + DPCHK + TEXT +CSIN + +CSINXR, SETX XR + SETB BP + JA .+3 +BP, F 0.0 +XR, F 0.0 +ARG, F 0.0 + F 0.0 +C, F 0.0 +CH, F 0.0 +S, F 0.0 + ORG 10*3+BP + FNOP + JA CSINXR + 0 + +RT, JA . +SH, F 0.0 + BASE 0 +#CSIN, SETX XR + LDX 0,0 +COM, STARTD + FLDA 10*3 + FSTA RT + FLDA 0 + SETB BP + BASE BP + LDX 1,1 + FSTA BP + FLDA% BP,1 + FSTA BP + STARTE + FLDA% BP + FSTA ARG + STARTF + EXTERN COS + JSR COS + JA CSA + JA ARG /COS(X) +CSA, FSTA C + EXTERN SIN + JSR SIN + JA CSB + JA ARG +CSB, FSTA S /SIN(X) + EXTERN SINH + JSR SINH + JA CSC + JA ARG+3 +CSC, FSTA SH /SINH(Y) + EXTERN COSH + JSR COSH + JA CSD + JA ARG+3 +CSD, FSTA CH /COSH(Y) +/XR0 IS 0 FOR CSIN AND 1 FOR CCOS + JXN CALCOS,0 + FLDA S + FMUL CH + FSTA ARG /SIN*COSH + FLDA C +CSE, FMUL SH + FSTA ARG+3 /COS*SINH + STARTE + FLDA ARG + FSTA #CAC + JA RT + EXTERN #CAC +/DO COS +/ +CALCOS, FLDA C + FMUL CH + FSTA ARG + FLDA S + FNEG + JA CSE + ENTRY CCOS +CCOS, SETX XR + LDX 1,0 + JA COM + diff --git a/sw/f4/FRTSRC/csqrt.ra b/sw/f4/FRTSRC/csqrt.ra new file mode 100644 index 0000000..161769d --- /dev/null +++ b/sw/f4/FRTSRC/csqrt.ra @@ -0,0 +1,92 @@ +/ +/ C S Q R T +/ - - - - - +/ +/ VERSION 5A 4-27-77 PT +/ +/COMPLEX SQUARE ROOT ROUTINE +/ENTER+ EXIT IN COMPLEX +/Z=X+IX +/ +/SQRT(Z)=SQRT(R)*COS(THETA)+SIN(THETA)) +/ +/R=SQRT(X*X+Y*Y) +/THETA=ATAN2(Y/X)/2 +/ +/CALLS SQRT,ATAN2,SIN,COS +/ + SECT CSQRT + JA #CSQRT + DPCHK + TEXT +CSQRT + +CSQRTX, SETX XR + SETB BP + JA .+3 +BP, F 0.0 +XR, F 0.0 +ARG, F 0.0 + F 0.0 +THETA, F 0.0 +FP2, F 2.0 + ORG 10*3+BP + FNOP + JA CSQRTX + 0 +RT, JA . + BASE 0 +#CSQRT, STARTD + FLDA 10*3 + FSTA RT + FLDA 0 + SETB BP + SETX XR + BASE BP + LDX 1,1 + FSTA BP + FLDA% BP,1 + FSTA BP + STARTE + FLDA% BP + FSTA ARG + STARTF + EXTERN ATAN2 + JSR ATAN2 /ATAN(Y/X) + JA CSA + JA ARG+3 + JA ARG +CSA, FDIV FP2 /ATAN/2 + FSTA THETA + FLDA ARG + FMULM ARG /X*X + FLDA ARG+3 + FMUL ARG+3 /Y*Y + FADD ARG /X*X+Y*Y + FSTA ARG + EXTERN SQRT /SQRT(X*X+Y*Y) + JSR SQRT + JA CSB + JA ARG +CSB, FSTA ARG /R + EXTERN SQRT + JSR SQRT + JA CSC + JA ARG /SQRT(R) +CSC, FSTA ARG /SQRT(R) + EXTERN SIN + JSR SIN /SIN(THETA/2) + JA CSD + JA THETA +CSD, FMUL ARG /*SQRT(X) + FSTA ARG+3 + EXTERN COS + JSR COS /COS(THETA/2)*SQRT(R) + JA CSE + JA THETA +CSE, FMUL ARG + FSTA ARG + STARTE + FLDA ARG + FSTA #CAC + JA RT + EXTERN #CAC + diff --git a/sw/f4/FRTSRC/dabs.ra b/sw/f4/FRTSRC/dabs.ra new file mode 100644 index 0000000..fcdf597 --- /dev/null +++ b/sw/f4/FRTSRC/dabs.ra @@ -0,0 +1,21 @@ +/ +/ VERSION 5A 4-27-77 PT +/ + SECT DABS + BASE 0 + DPCHK +DPABS, FLDA 0 /GET RETURN ADDRESS + STARTD + FSTA RETRN + FADD TWO /GET ADDRESS OF ARG P7S + FSTA 3 + FLDA% 3 + FSTA 3 + STARTE + FLDA% 3 + JGE RETRN /POSITIVE, SKIP NEGATE + FNEG +RETRN, 0;0 +TWO, 0;2 + END + diff --git a/sw/f4/FRTSRC/datan.ra b/sw/f4/FRTSRC/datan.ra new file mode 100644 index 0000000..fcd488b --- /dev/null +++ b/sw/f4/FRTSRC/datan.ra @@ -0,0 +1,203 @@ +/ +/ +/ SUBROUTINE DATAN(X) +/ +/ VERSION 5A 4-26-77 (MH) +/ +/X,THE ARGUMENT, IS REDUCED TO +/01.0 THEN ATAN(X)=PI/2 - ATAN(1/X) +/IF .51? + FLDA DATFP1 /YES + FDIV X /X=1/X + LDX 0,1 /SET FLAG + FSTA X +DATB, FLDA X + FSUB DATP5 />= .5 + JLT DATC + FLDA X /X=(2X-1)/(X+2) + FADD DATFP2 + FSTA DT1 /TEMP + FLDA X + FMUL DATFP2 + FSUB DATFP1 + FDIV DT1 + FSTA X + FLDA ATN1S2 /C0=ATAN(1/2) + FSTA C0 +/COMPUTE ATAN USING ALGORITHM +DATC, FLDA X + FMUL X + FSTA Z /Z=X*X + FLDA Z + FADD DATB3 /Z+B3 + FSTA DT1 + FLDA DATA3 + FDIV DT1 /A3/(Z+B3) + FADD DATB2 + FADD Z /ADD Z+B2 + FSTA DT1 /TEMP + FLDA DATA2 /A2/TEMP + FDIV DT1 + FADD DATB1 + FADD Z /ADD Z +B1 + FSTA DT1 /TEMP + FLDA DATA1 /A1/TEMP + FDIV DT1 + FADD DATB0 /ADD Z+B0 + FADD Z + FSTA DT1 + FLDA LAMBDA /LAMBDA*X + FMUL X + FDIV DT1 /DIV BY THE REST + FADD C0 + FSTA X + JXN DATD,1 /WAS X>1 ORIGINALLY? + FLDA PIS2 /Y ATAN(X)=PI/2-ATAN(X) + FSUB X +DATD, JXN DATRTN,0 /WAS X<0? + FNEG /Y + JA DATRTN +DATGO, FLDA X + JA DATD + diff --git a/sw/f4/FRTSRC/datan2.ra b/sw/f4/FRTSRC/datan2.ra new file mode 100644 index 0000000..7ebae2c --- /dev/null +++ b/sw/f4/FRTSRC/datan2.ra @@ -0,0 +1,91 @@ +/ +/ +/ +/ D A T A N 2 +/ - - - - - - +/ +/SUBROUTINE DATAN2(Y,X) +/ +/ VERSION 5A 4-27-77 PT +/ + SECT DATAN2 + JA #DATN2 + DPCHK + TEXT +DATAN2+ +ATN2XR, SETX XRATN2 + SETB BPATN2 +BPATN2, FNOP + 0 + 0 +XRATN2, F 0.0 +YCOR, F 0.0 + 0;0;0 +XCOR, F 0.0 + 0;0;0 + ORG 10*3+BPATN2 + FNOP + JA ATN2XR + 0 +AT2RTN, JA . +FPIAT2, 2 + 3110 /PI + 3755 + 2421 + 0264 + 3016 +ATPI, 0001 + 3110 /PI/2 + 3755 + 2421 + 0264 + 3016 + BASE 0 +#DATN2, STARTD + FLDA 10*3 + FSTA AT2RTN + FLDA 0 + SETX XRATN2 + SETB BPATN2 + BASE BPATN2 + LDX 1,1 + FSTA BPATN2 + FLDA% BPATN2,1 /ADDR OF Y + FSTA YCOR + FLDA% BPATN2,1+ /ADDR OF X + FSTA XCOR + STARTE + FLDA% YCOR + FSTA YCOR /SAVE FOR A SECOND + LDX 1,2 /POSITIVE Y + JEQ ATN0 + JGT ATN1 + LDX 0,2 +ATN1, FLDA% XCOR /GET X - THE QUADRAND + FSTA XCOR /+MOVE IT TO A SAFE PLACE + JEQ ATASP + FLDA YCOR /Y/X + FDIV XCOR + FSTA YCOR + EXTERN DATAN + JSR DATAN /CALL ATAN + JA .+4 /TAKE ARCTAN OF Y/X + JA YCOR + FSTA YCOR /SAVE IT AWAY + JGE A2 /SKIP IF 1ST OR 3RD QUADS + FADD FPIAT2 /ADD PI FOR 4TH QUAD + FSTA YCOR +A2, JXN AT2RTN,2 /DONE IF 1 OR 4 Q + FLDA YCOR + FSUB FPIAT2 /2ND OR 3RD Q + JA AT2RTN +ATASP, FLDA ATPI /PI/2 + JXN ATNG,2 + FNEG +ATNG, JA AT2RTN +ATN0, FLDA% XCOR + JLT POSX + FCLA /X POS, ANS =0 + JA AT2RTN +POSX, FLDA FPIAT2 /X LT 0, ANS = PI + JA AT2RTN + diff --git a/sw/f4/FRTSRC/date.ra b/sw/f4/FRTSRC/date.ra new file mode 100644 index 0000000..875cd4d --- /dev/null +++ b/sw/f4/FRTSRC/date.ra @@ -0,0 +1,91 @@ +/ +/ VERSION 5A 4/28/77 PT +/ + SECT8 DATE + JA #ST + EXTERN #DATE +#XR, ORG .+10 + TEXT +DATE + +#RET, +#BASE, ORG .+3 +MONTH, ORG .+3 +DAY, ORG .+3 +YEAR, ORG .+3 +TEMP, ORG .+3 +DATADR, 0 + JA #DATE-1 /ADDRESS OF PS8 DATE WORD + ORG 10*3+#BASE + FNOP + JA #RET + 0 +DRTN, JA . + BASE 0 +NEWDAT, 0 + CDF 0 + TAD% BIPCCL + AND BITMSK + CLL RTR + RTR + DCA DATEMP + CDF CIF 0 + JMP% NEWDAT +BIPCCL, 7777 +BITMSK, 600 +#ST, STARTD + 0210 + FSTA DRTN + 0200 + BASE #BASE + SETX #XR + SETB #BASE + LDX 0,1 + FSTA #BASE + FLDA% #BASE,1+ + FSTA MONTH + FLDA% #BASE,1+ + FSTA DAY + FLDA% #BASE,1+ + FSTA YEAR + FLDA% DATADR /GET THE PS-8 DATE WORD + FSTA TEMP /SAVE IT + FCLA + FSTA TEMP,0 /ZERO EXPONENT AND HIGH HALF OF MANTISSA + LDX 10,1 /SHIFT COUNT + FLDA TEMP /GET IT BACK + ALN 1 /ISOLATE THE MONTH + ATX 1 /SAVE THE MONTH + LDX -4,2 /DAY SHIFT COUNT + FLDA TEMP /GET BACK THE DATE + ALN 2 /SHIFT MONTH BITS INTO + /HIGH HALF OF MANTISSA + FSTA TEMP /SAVE THIS + FCLA + FSTA TEMP,0 /ISOLATING DAY/YEAR BITS + FLDA TEMP /GET THEM BACK + LDX 7,2 /NOW ISOLATE DAY + ALN 2 + ATX 2 /AND SAVE IT IN 2 + FLDA TEMP /GET DAY/YEAR BITS + LDX -5,3 /PREPARE TO REMOVE DAY BITS + ALN 3 /BY SHIFTING THEM INTO HIGH HALF OF MANTISSA + FSTA TEMP /SAVE THEM + FCLA + FSTA TEMP,0 /ZERO DAY BITS + FLDA TEMP /RESTORE YEAR BITS + LDX 11,3 /SHIFT BACK + ALN 3 + ATX 3 /PUT THEM INTO XR 3 + TRAP4 NEWDAT + STARTF /RE-ENTER F MODE + XTA 1 /GET MONTH + FSTA% MONTH /RETURN IN ARG + XTA 2 /NOW DAY + FSTA% DAY + ADDX 3662,3 /MAKE IT + 1970 + ADDX 0,3 + DATEMP=.-1 + XTA 3 /NOW YEAR + FSTA% YEAR + JA DRTN /RETURN + END + diff --git a/sw/f4/FRTSRC/dble.ra b/sw/f4/FRTSRC/dble.ra new file mode 100644 index 0000000..46c42e8 --- /dev/null +++ b/sw/f4/FRTSRC/dble.ra @@ -0,0 +1,27 @@ +/ SUBROUTINE DBLE - REAL TO DBL PREC +/ +/ VERSION 5A 4-27-77 PT +/ + SECT DBLE + BASE 0 + DPCHK + FLDA 0 + STARTD + FSTA RETRN /SAVE RETURN + FADD TWO /ADDR OF ARG POINTER + FSTA 3 + FLDA% 3 /ADDR OF ARG + FSTA 3 + STARTF + FLDA% 3 /GET ARG + FSTA DTEMP + FCLA + FSTA DTEMP+3 /0 FOR LAST 3 WORDS + STARTE + FLDA DTEMP +RETRN, 0;0 /FLOAT IS A NOP +TWO, 0;2 +DTEMP, F 0.0 + F 0.0 + END + diff --git a/sw/f4/FRTSRC/dcos.ra b/sw/f4/FRTSRC/dcos.ra new file mode 100644 index 0000000..90fba9d --- /dev/null +++ b/sw/f4/FRTSRC/dcos.ra @@ -0,0 +1,57 @@ +/ +/ +/ D C O S +/ - - - - +/ +/SUBROUTINE DCOS(X) +/ +/ VERSION 5A 4-27-77 PT +/ + SECT DCOS + JA #DCOS + DPCHK + TEXT +DCOS + +COSXR, SETX XRCOS + SETB BPCOS +BPCOS, FNOP + 0 + 0 + 0 + 0 + 0 +XRCOS, F 0.0 + F 0.0 +COS1, F 0.0 + F 0.0 +FPI2CS, 1 /PI DIVIDED BY 2 + 3110 + 3755 + 2421 + 0264 + 3016 + ORG 10*3+BPCOS + FNOP + JA COSXR + 0 +COSRTN, JA . + BASE 0 +#DCOS, STARTD + FLDA 10*3 + FSTA COSRTN + FLDA 0 + SETX XRCOS + SETB BPCOS + BASE BPCOS + LDX 1,1 + FSTA BPCOS + FLDA% BPCOS,1 /ADDR OF X + FSTA BPCOS + STARTE + FLDA% BPCOS /GET X + FADD FPI2CS /ADD IN PI OVER 2 + FSTA COS1 + EXTERN DSIN + JSR DSIN /AND CALL THE SIN + JA COSRTN + JA COS1 + diff --git a/sw/f4/FRTSRC/dexp.ra b/sw/f4/FRTSRC/dexp.ra new file mode 100644 index 0000000..842162d --- /dev/null +++ b/sw/f4/FRTSRC/dexp.ra @@ -0,0 +1,266 @@ +/ +/ +/ SUBROUTINE DEXP +/ +/ VERSION 5A 4-26-77 MH +/ +/E^X=2^(X*LOG2(E)) +/E^X=2^(M+F) +/M=INTEGER; F=FRACTION +/ +/2^(M+F)=2^(M+N+R) +/WHERE 0 +/ +/RESTRICTIONS: +/X=0 IMPLIES E^X=1 +/ +/X>88.028 IMPLIES E^X=3377/3377/3777/7777/777/7777 +/ +/X<-88.028 IMPLIES E^X=0 +/ +/ +/ + SECT DEXP + JA #DEXP + DPCHK + TEXT +DEXP + +/ +DEXPXR, SETX XRDEXP + SETB BPDEXP +/ +/BEGINNING OF BASE PAGE +/ +BPDEXP, F 0.0 +XRDEXP, F 0.0 +X, F 0.0 + F 0.0 +/ + ORG 10*3+BPDEXP + FNOP + JA DEXPXR + 0 +DEXRTN, JA . +/ +TOPLIM, 3377 + 3377 + 3777 + 7777 + 7777 + 7777 +M, F 0.0 + F 0.0 +N, F 0.0 + F 0.0 +R, F 0.0 + F 0.0 +LOG2E, 0001 /1.4426950408889634 + 2705 + 2435 + 4512 + 7013 + 7603 +DFP125, 7775 /.125 + 3777 + 7777 + 7777 + 7777 + 7776 +DEXFP1, F 1.0 + F 0.0 +/ +DFR1S8, 0001 /2^1/8 + 2134 + 5340 + 7437 + 2505 + 7302 +DFP2S8, 0001 /2^2/8 + 2301 + 5770 + 1214 + 3334 + 2524 +DFP3S8, 0001 /2^3/8 + 2457 + 7553 + 2515 + 4250 + 4720 +DFP4S8, 0001 /2^4/8 + 2650 + 1171 + 4637 + 6357 + 1425 +DFP5S8, 0001 /2^5/8 + 3053 + 1625 + 0212 + 5174 + 3070 +DFP6S8, 0001 /2^6/8 + 3272 + 1176 + 3126 + 5516 + 5532 +DFP7S8, 0001 /2^7/8 + 3526 + 0143 + 3476 + 7222 + 0722 +/ +/ +DEXA4, 0006 /60.593191717336463 + 3622 + 7666 + 6462 + 2157 + 5534 +DEXB4, 0007 /87.417497202235527 + 2566 + 5341 + 0613 + 6705 + 7214 +DEXC4, 0005 /30.296595858668232 + 3622 + 7666 + 6462 + 2157 + 5546 +DEXD4, 0001 /1.0500 + 2063 + 1463 + 1463 + 1463 + 1462 +DEXH4, 0010 /214.17286814547704 + 3261 + 3040 + 4261 + 5654 + 0240 +DTEMP1, F 0.0 + F 0.0 +DFP2, F 2.0 + F 0.0 +/ + BASE 0 +#DEXP, STARTD + FLDA 10*3 + FSTA DEXRTN + FLDA 0 + SETX XRDEXP + SETB BPDEXP + BASE BPDEXP + LDX 1,1 + LDX 73,2 /FOR ALIGNING + FSTA BPDEXP + FLDA% BPDEXP,1 /ADDRESS OF X + FSTA BPDEXP + STARTE + FLDA% BPDEXP /GET X + LDX 0,0 + JGT DEX1 /CHECK SIGN + FNEG + LDX -1,0 /SET FLAG +DEX1, JNE DEX2 /X=0 + FLDA DEXFP1 /E^0=1 + JA DEXRTN +DEX2, FSTA X + JA DEX4 +DEX3, FCLA + JA DEXRTN /RETURN 0 FOR TOO SMALL +/ +/SET UP M+N+R=X*LOG2(E) +DEX4, FLDA LOG2E + FMULM X + FLDA X + ALN 2 /FIX + FNORM /FLOAT + FSTA M /INTEGER PART + FLDA X + FSUB M + FSTA N /FRACTION + JNE DEX50 /0 IS SPECIAL CASE + FLDA DEXFP1 /1.0 + FSTA N /N + FSTA R /R + JA DEX20 /SKIP +/ +/CALCULATE N+R +DEX50, LDX 0,1 + FLDA N + FSTA R /IF < .125 ALREADY +DEX5, FSUB DFP125 /-.125 + JLT DEX6 /DONE IF .LT. + FSTA R /STORE REMAINDER + ADDX 1,1 /NEXT POWER OF 2 + JA DEX5 /AND AGAIN +/ +/GET N FROM TABLE +DEX6, FLDA DEXFP1,1 + FSTA N +/ +/NOW CALCULATE R + FLDA R /IF R=0 + JNE DEX7 + FLDA DEXFP1 /2^R=1 + FSTA R + JA DEX20 /NO CALCULATION +/ +/ +DEX7, FLDA DEXB4 + FDIV R /(B4/R) + FSTA X + FLDA DEXD4 /D4*R + FMUL R + FADD X /+(B4/R) + FSUB DEXC4 /-C4 + FSTA DTEMP1 + FLDA R + FADD X /R+(B4/R) + FSTA R + FLDA DEXH4 + FDIV R /H4/(R+B4/R) + FADD DTEMP1 + FSTA DTEMP1 + FLDA DEXA4 + FDIV DTEMP1 + FADD DEXFP1 + FSTA R +/ +/CALCULATE 2^M +/ +DEX20, FLDA M + JNE DEX21 + FLDA DEXFP1 + FSTA M + JA DEX30 +DEX21, FNEG + ATX 1 + FLDA DEXFP1 + FSTA M + FLDA DFP2 +DEX22, FMULM M /M*2 + JXN DEX22,1+ +/CALCULATE M*N*R +DEX30, FLDA M + FMUL N + FMUL R + FSTA X + JXN DEX31,0 /WAS X MINUS + JA DEXRTN +DEX31, FLDA DEXFP1 /.1/X IF -X + FDIV X + JA DEXRTN +  diff --git a/sw/f4/FRTSRC/dexp3.ra b/sw/f4/FRTSRC/dexp3.ra new file mode 100644 index 0000000..7038be8 --- /dev/null +++ b/sw/f4/FRTSRC/dexp3.ra @@ -0,0 +1,70 @@ +/ +/ +/ +/ D E X P 3 +/ - - - - - +/ +/SUBROUTINE DEXP3(B,E) FOR DOUBLE TO DOUBLE +/ +/ VERSION 5A 4-26-77 MH +/ + SECT DEXP3 + JA #DEXP3 + DPCHK + EXTERN #ARGER +EXP3ER, TRAP4 #ARGER + TEXT +DEXP3 + +EXP3XR, SETX XREXP3 + SETB BPEXP3 + JA .+3 +BPEXP3, FNOP + 0 + 0 +XREXP3, F 0.0 +EXP31, F 0.0 + F 0.0 +EXP32, F 0.0 + F 0.0 + ORG 10*3+BPEXP3 + FNOP + JA EXP3XR + 0 +XP3RTN, JA . +FP1XP3, F 1. + F 0.0 + BASE 0 +#DEXP3, STARTD + FLDA 10*3 + FSTA XP3RTN + FLDA 0 + SETX XREXP3 + SETB BPEXP3 + BASE BPEXP3 + LDX 1,1 + FSTA BPEXP3 + FLDA% BPEXP3,1 /ADDR OF B + FSTA EXP31 + FLDA% BPEXP3,1+ /ADDR OF E + FSTA EXP32 + STARTE + FLDA% EXP31 /GET B + JEQ XP3RTN /0 ^ X = 0 + FSTA EXP31 /SAVE BASE + FLDA% EXP32 /GET E + JEQ EXP3ON /X ^ 0 = 1 + FSTA EXP32 /SAVE EXPONENT + FLDA EXP31 + JLT EXP3ER /ALL IS NOT WELL + EXTERN DLOG + JSR DLOG /CALL LOG + JA .+4 /TAKE LOG (B) + JA EXP31 + FMUL EXP32 /MULT BY EXPONENT-E + FSTA EXP31 + EXTERN DEXP + JSR DEXP /CALL EXP. + JA XP3RTN + JA EXP31 +EXP3ON, FLDA FP1XP3 + JA XP3RTN + diff --git a/sw/f4/FRTSRC/dim.ra b/sw/f4/FRTSRC/dim.ra new file mode 100644 index 0000000..88cf1c3 --- /dev/null +++ b/sw/f4/FRTSRC/dim.ra @@ -0,0 +1,32 @@ +/ +/ VERSION 5A 4-27-77 PT +/ + SECT DIM + ENTRY IDIM + JA #ST +#XR, ORG .+10 +#BASE, ORG .+3 +A, ORG .+3 +B, ORG .+3 + BASE #BASE +IDIM, +#ST, STARTD + 0210 + FSTA #RTN,0 + 0200 + SETX #XR + SETB #BASE + LDX 0,1 + FSTA #BASE + FLDA% #BASE,1+ + FSTA A + FLDA% #BASE,1+ + FSTA B + STARTF + FLDA% A + FSUB% B + JGE #RTN + FCLA +#RTN, JA . + END + diff --git a/sw/f4/FRTSRC/dlog.ra b/sw/f4/FRTSRC/dlog.ra new file mode 100644 index 0000000..00a6fe7 --- /dev/null +++ b/sw/f4/FRTSRC/dlog.ra @@ -0,0 +1,234 @@ +/ +/ +/ D L O G +/ - - - - +/ +/ VERSION 5A 4-27-77 PT +/ +/LOGE(X) +/ +/X=2^N*F +/ +/LOGE(X) + /= N*LOGE(2)+LOGE(F) +/ +/ + SECT DLOG + JA #DALOG + DPCHK +/ +/IF X<=0 - IT IS AN ERROR + EXTERN #ARGER +DALERR, TRAP4 #ARGER +/ + TEXT +DLOG + +DALXR, SETX XRDAL + SETB BPDAL +BPDAL, F 0.0 +XRDAL, F 0.0 + F 0.0 + ORG 10*3+BPDAL + FNOP + JA DALXR + 0 +DALRTN, JA . +N, F 0.0 + F 0.0 +F, F 0.0 + F 0.0 +DAL1, F 1.0 + F 0.0 +/ +DT7, 7776 /1/7 + 2222 + 2222 + 2222 + 2222 + 2221 +DT6, 7776 /-1/6 + 5252 + 5252 + 5252 + 5252 + 5252 +DT5, 7776 /1/5 + 3146 + 3146 + 3146 + 3146 + 3146 +DT4, 7776 /-1/4 + 4000 + 0 + 0 + 0 + 0 +DT3, 7777 /1/3 + 2525 + 2525 + 2525 + 2525 + 2524 +DT2, 7777 /-1/2 + 4000 + 0 + 0 + 0 + 0 +/ +A0, F 1.84375 + F 0.0 +A1, F 1.65625 + F 0.0 +A2, F 1.500 + F 0.0 +A3, F 1.375 + F 0.0 +A4, F 1.250 + F 0.0 +A5, F 1.1875 + F 0.0 +A6, F 1.09375 + F 0.0 +A7, F 1.03125 + F 0.0 +LA0, 0 /.6118015411059928976 + 2344 + 7603 + 2325 + 4250 + 3144 +LA1, 0 /.5045560107523952859 + 2011 + 2512 + 4551 + 3503 + 7657 +LA2, 7777 /.4054651081081643810 + 3174 + 6217 + 5457 + 7141 + 1370 +LA3, 7777 /.3184537311185346147 + 2430 + 3057 + 0207 + 0573 + 0232 +LA4, 7776 /.2231435513142097553 + 3443 + 7737 + 0746 + 5150 + 4146 +LA5, 7776 /.1718502569266592214 + 2577 + 6301 + 6051 + 7117 + 2356 +LA6, 7775 /.08961215868968712374 + 2674 + 1512 + 1271 + 2655 + 1272 +LA7, 7773 /.030771658666753687 + 3740 + 5154 + 1636 + 0313 + 7764 +D16, F 16.0 + F 0.0 +D8, F 8.0 + F 0.0 +CUM, F 0.0 + F 0.0 +DLOGE2, 0 + 2613 + 4413 + 7676 + 4347 + 5715 +/ +/PICK UP X + BASE 0 +#DALOG, STARTD + FLDA 10*3 + FSTA DALRTN + FLDA 0 + SETX XRDAL + SETB BPDAL + BASE BPDAL + LDX 1,1 + FSTA BPDAL + FLDA% BPDAL,1 /ADDRESS + FSTA BPDAL + STARTE + FLDA% BPDAL /AND X + JLE DALERR /X <= 0 IS ERROR + FSUB DAL1 /SUB 1.0 + JNE DALA + FCLA /LOG(1)=0 + JA DALRTN +/ +DALA, FADD DAL1 /ADD BACK + FSTA XRDAL /STORE AT X +/EXPONENT STORED IN XR0 +/MANTISSA STORED IN XR1-5 +/PICK UP EXP + MULTIPLY BY LOGE(2) +/ + XTA 0 + FMUL DLOGE2 + FSTA N /N*LOGE(2) +/XRDAL IS NOW FRACTION IN RANGE .5<=F<1.0 +/COMPUTE LOG(F) BY +/LOG(F)=LOG(A(K1)*A(K2)...(F))-(LOG(A(K1))+ +/ LOG(A(K2))...) +/FIT F IN A 1/16 RANGE +/I.E. 1/2-9/16,9/16-10/16,ETC. +/MULTIPLY F BY APPROPRIATE A(K) MULTIPLIER +/KEEP RUNNING SUM OF LOG(A(K)) +/CONTINUE UNTIL F>1 + +/ + LDX 0,0 + FLDA XRDAL + FSTA F + FCLA + FSTA CUM +DALB, FLDA F + FMUL D16 /16 REAL PARTS + FSUB D8 /NEED JUST 8 + ATX 1 + FLDA A0,1 /GET MULTIPLIER + FMULM F + FLDA LA0,1 /ADD LOG(A(K)) TO SUM + FADDM CUM + FLDA F + FSUB DAL1 + JLT DALB +/NOW F>1. USE TAYLOR SERIES +/LOG(T)=Z-(Z^2)/2+(Z^3)/3+... WHERE Z=T-1 + FLDA F + FSUB DAL1 /F-1.0 + FSTA F + FMUL DT7 + FADD DT6 + FMUL F + FADD DT5 + FMUL F + FADD DT4 + FMUL F + FADD DT3 + FMUL F + FADD DT2 + FMUL F + FADD DAL1 + FMUL F + FSUB CUM + FADD N + JA DALRTN + diff --git a/sw/f4/FRTSRC/dlog10.ra b/sw/f4/FRTSRC/dlog10.ra new file mode 100644 index 0000000..f08abc3 --- /dev/null +++ b/sw/f4/FRTSRC/dlog10.ra @@ -0,0 +1,56 @@ +/ +/ +/ D L O G 1 0 +/ - - - - - - +/ +/SUBROUTINE DPLOG10(X) +/ +/ VERSION 5A 4-26-77 (MH) +/ + SECT DLOG10 + JA #DLOG10 + DPCHK + TEXT +DLOG10+ +LOGXR, SETX XRLOG + SETB BPLOG + JA .+3 +BPLOG, FNOP + 0 + 0 + 0;0;0 +XRLOG, F 0.0 +LOG1, F 0.0 + 0;0;0 + ORG 10*3+BPLOG + FNOP + JA LOGXR + 0 +LOGRTN, JA . +ALOG1C, 7777 /DP .4342944819032518276 + 3362 + 6754 + 2511 + 5624 + 1612 + BASE 0 +#DLOG10, STARTD + FLDA 10*3 + FSTA LOGRTN + FLDA 0 + SETX XRLOG + SETB BPLOG + BASE BPLOG + LDX 1,1 + FSTA BPLOG + FLDA% BPLOG,1 /ADDR OF X + FSTA BPLOG + STARTE + FLDA% BPLOG /GET X + FSTA LOG1 + EXTERN DLOG + JSR DLOG /CALL ALOG + JA .+4 + JA LOG1 + FMUL ALOG1C /CORRECT FOR THE LOG BASE E. + JA LOGRTN + diff --git a/sw/f4/FRTSRC/dmax1.ra b/sw/f4/FRTSRC/dmax1.ra new file mode 100644 index 0000000..db589ee --- /dev/null +++ b/sw/f4/FRTSRC/dmax1.ra @@ -0,0 +1,42 @@ +/ +/ VERSION 5A 4-27-77 PT +/ + SECT DMAX1 + BASE 0 + DPCHK +DPMAX, SETX XR +MAXCOM, STARTD + FLDA 0 /ADDRESS OF JA .+2+2*N + FSTA 3 + FLDA 30 /RETURN ADDRESS + FSTA RETN + FLDA% 3 / JA .+2+2*N + FSUB 0 /-JA . + FSUB TWO /- 2 + LDX 1,1 + ALN 1 /DIVIDE BY TWO + FNEG /-N + ATX 1 + LDX 0,2 /FOR ARG PICKUP + FLDA% 0,2+ /ADDRESS OF FIRST ARG + FSTA 3 + STARTE +NEW, FLDA% 3 /SAVE NEW MAX + FSTA MAX +SAME, JXN MORMAX,1+ /ANY MORE ARGS ? + FLDA MAX /GET RESULT +RETN, JA . +MORMAX, STARTD /NEXT ARG ADDRESS + FLDA% 0,2+ + FSTA 3 + STARTE + FLDA MAX /COMPARE + FSUB% 3 + JGE SAME /SAME MAX + JA NEW /NEW MAX +TWO, 0;2 +MAX, 0;0;0 + 0;0;0 +XR, 0;0;0;0;0;0;0;0 + END + diff --git a/sw/f4/FRTSRC/dmin1.ra b/sw/f4/FRTSRC/dmin1.ra new file mode 100644 index 0000000..d28a86e --- /dev/null +++ b/sw/f4/FRTSRC/dmin1.ra @@ -0,0 +1,42 @@ +/ +/ VERSION 5A 4/26/77 MH +/ + SECT DMIN1 + BASE 0 + DPCHK +DPMIN, SETX XR +MINCOM, STARTD + FLDA 0 /ADDRESS OF JA .+2+2*N + FSTA 3 + FLDA 30 /RETURN ADDRESS + FSTA RETN + FLDA% 3 / JA .+2+2*N + FSUB 0 /-JA . + FSUB TWO /- 2 + LDX 1,1 + ALN 1 /DIVIDE BY TWO + FNEG /-N + ATX 1 + LDX 0,2 /FOR ARG PICKUP + FLDA% 0,2+ /ADDRESS OF FIRST ARG + FSTA 3 + STARTE +NEW, FLDA% 3 /SAVE NEW MIN + FSTA MIN +SAME, JXN MORMIN,1+ + FLDA MIN +RETN, JA . +MORMIN, STARTD /NEXT ARG ADDRESS + FLDA% 0,2+ + FSTA 3 + STARTE + FLDA MIN /COMPARE + FSUB% 3 + JLE SAME /SAME MIN + JA NEW /NEW MIN +TWO, 0;2 +MIN, 0;0;0 + 0;0;0 +XR, 0;0;0;0;0;0;0;0 + END + diff --git a/sw/f4/FRTSRC/dmod.ra b/sw/f4/FRTSRC/dmod.ra new file mode 100644 index 0000000..4b40494 --- /dev/null +++ b/sw/f4/FRTSRC/dmod.ra @@ -0,0 +1,79 @@ +/ +/ +/ +/ D M O D +/ - - - - +/ +/SUBROUTINE DMOD(X,Y) +/ +/ VERSION 5A 4-27-77 PT +/ + SECT DMOD + JA #DMOD + DPCHK + TEXT +DMOD + +AMODXR, SETX XRAMOD + SETB BPAMOD +STHREE, 0007 /73 + 2217 + 7777 + 7777 + 7777 + 7777 +BPAMOD, F 0.0 + F 0.0 +XRAMOD, 0;1;73 /73 FOR ALIGNING ON 59 +XSTOR, F 0.0 + F 0.0 +AMODX, F 0.0 + F 0.0 + ORG 10*3+BPAMOD + FNOP + JA AMODXR + 0 +AMDRTN, JA . + EXTERN #ARGER +AMODER, TRAP4 #ARGER + FCLA + JA AMDRTN + BASE 0 +#DMOD, STARTD + FLDA 10*3 + FSTA AMDRTN + FLDA 0 + SETX XRAMOD + SETB BPAMOD + BASE BPAMOD + FSTA BPAMOD + LDX 1,1 + FLDA% BPAMOD,1 /ADDR OF X + FSTA AMODX + FLDA% BPAMOD,1+ /ADDR OF Y + FSTA BPAMOD + STARTE + FLDA% BPAMOD /GET Y + JEQ AMODER /Y=0 IS ERROR + FLDA% BPAMOD + JGT .+3 /GET ABS VALUE + FNEG + FSTA BPAMOD + FLDA% AMODX /GET X + JGT .+5 + FNEG /GET ABS VALUE OF X + LDX 0,1 /NOTE THE SIGN + FSTA AMODX /SAV IN A TEMPORARY + FDIV BPAMOD /DIVIDE BY Y + FSTA XSTOR /SAVE X/Y + XTA 3 /GET EXPONENT + FSUB STHREE /CHECK SIZE + JGE AMODER /TOO BIG + FLDA XSTOR /ABS VALUE X/Y + ALN 2 /FIX IT UP NOW. + FNORM + FMUL BPAMOD /MULITPLY IT. + FNEG /NEGATE IT. + FADD AMODX /AND ADD IN X. + JXN AMR,1 + FNEG /RESTORE SIGN +AMR, JA AMDRTN + diff --git a/sw/f4/FRTSRC/dsign.ra b/sw/f4/FRTSRC/dsign.ra new file mode 100644 index 0000000..a84de31 --- /dev/null +++ b/sw/f4/FRTSRC/dsign.ra @@ -0,0 +1,39 @@ +/ +/ VERSION 5A 4-27-77 PT +/ + SECT DSIGN + JA #ST +#XR, ORG .+10 + TEXT 'DSIGN ' +#BASE, ORG .+6 +A, ORG .+6 +B, ORG .+6 + ORG #BASE+31 + JA #BASE +GOBACK, 0;0;0 + BASE #BASE + DPCHK +#ST, STARTD + 0210 /FLDA 10 + FSTA GOBACK+1,0 + 0200 + SETX #XR + SETB #BASE + LDX 0,1 + FSTA #BASE + FLDA% #BASE,1+ + FSTA A + FLDA% #BASE,1+ + FSTA B + STARTE + FLDA% B /NEG? + JLT #50 /B POS + FLDA% A + JLT #100 + JA GOBACK+1 /A+,B+ +#50, FLDA% A + JLT GOBACK+1 /A-,B- +#100, FNEG /OPP. SIGNS + JA GOBACK+1 + END + diff --git a/sw/f4/FRTSRC/dsin.ra b/sw/f4/FRTSRC/dsin.ra new file mode 100644 index 0000000..4e70550 --- /dev/null +++ b/sw/f4/FRTSRC/dsin.ra @@ -0,0 +1,214 @@ +/ +/ +/ D S I N +/ - - - +/ +/SUBROUTINE DSIN(X) +/ +/ VERSION 5A 4-27-77 PT +/ + SECT DSIN + JA #DSIN + DPCHK + TEXT +DSIN + +SINXR, SETX XRSIN + SETB BPSIN +FPI2SN, 1 /PI DIVIDED BY 2 + 3110 + 3755 + 2421 + 0264 + 3016 +FPISIN, 2 /PI + 3110 + 3755 + 2421 + 0264 + 3016 +F2PISN, 3 /TWO PI + 3110 + 3755 + 2421 + 0264 + 3016 +BPSIN, F 0.0 +XRSIN, F 0.0 +X, F 0.0 + F 0.0 + ORG 10*3+BPSIN + FNOP + JA SINXR + 0 +SINRTN, JA . +SIN1, F 0.0 + F 0.0 +F3PIB2, 0003 /4.71238898038468986 + 2266 + 2761 + 7714 + 6207 + 2212 +F1SIN, F 1.0 + F 0.0 +/ +SINC17, 7720 /1/17! + 3124 + 5435 + 6014 + 1265 + 1236 +SINC15, 7730 /-1/15! + 4506 + 0060 + 3063 + 0437 + 4133 +SINC13, 7740 /1/13! + 2604 + 4430 + 2352 + 0664 + 1151 +SINC11, 7747 /-1/11! + 4506 + 3352 + 3002 + 5354 + 3710 +SINC9, 7756 /1/9! + 2707 + 3616 + 4525 + 5434 + 6350 +/ +SINC7, 7764 /-1/7! + 4577 + 4577 + 4577 + 4577 + 4636 +/ +SINC5, 7772 /1/5! + 2104 + 2104 + 2104 + 2104 + 2104 +/ +SINC3, 7776 /-1/3! + 5252 + 5252 + 5252 + 5252 + 5244 +/ +SINTST, 7770 + 2000 + 0000 + 0000 + 0000 + 0000 +SEVTHR, 0007 + 2217 + 7777 + 7777 + 7777 + 7777 + BASE 0 +#DSIN, STARTD + FLDA 10*3 + FSTA SINRTN + FLDA 0 + SETX XRSIN + SETB BPSIN + BASE BPSIN + LDX 1,1 + LDX 73,2 + FSTA BPSIN + FLDA% BPSIN,1 /ADDR OF X + FSTA BPSIN + STARTE + FLDA% BPSIN /GET X + LDX -1,0 /SET SIGN TO POSITIVE. + JGT SINMOD /IF POSITIVE BYPASS FUDGE. + JEQ SINRTN /IF ZERO EXIT. + FNEG /NEGATIVE. NEGATE AC. SIN(-X)=-SIN(X) + LDX 0,0 /SET SIGN TO MINUS. +SINMOD, FSTA X + FDIV F2PISN /X/2PI + ALN 2 + FNORM + FMUL F2PISN /*2PI + FSTA SIN1 + FLDA X + FSUB SIN1 + FSTA SIN1 + FSTA X +/CHECK FOR QUADRANT +/1 0-PI/2 SIN(PI/2)=1 +/2 PI/2-PI SIN(PI)=0 +/3 PI-3PI/2 SIN(3PI/2)=-1 +/4 3PI/2-2PI SIN(2PI)=0 +/ + FLDA FPI2SN /PI/2 + FSUB SIN1 + JGT TAYLOR + JEQ SPIB2 /=PI/2 + FLDA FPISIN /PI + FSUB SIN1 + JLT S1 + JEQ SPI /=PI + FLDA FPISIN + FSUB SIN1 /SIN(X)=SIN(PI-X) + FSTA X + JA TAYLOR +S1, FLDA F3PIB2 /3PI/2 + FSUB SIN1 + JLT S2 + JEQ S3PIB2 /=3PI/2 + FLDA SIN1 + FSUB FPISIN + FNEG + FSTA X /SIN(X)=-SIN(X-PI) + JA TAYLOR +S2, FLDA F2PISN /2PI + FSUB SIN1 + JLT DSNER /ERROR + JEQ SPI + FNEG + FSTA X +/CALCULATE SIN VIA TAYLOR SERIES +TAYLOR, FLDA X /RECALL NUMBER TO BE WORKED ON. + FMUL X /MULTIPLY OUT. + FSTA SIN1 + FMUL SINC17 /NOW DO THE STANDARD ITERATION. + FADD SINC15 + FMUL SIN1 + FADD SINC13 + FMUL SIN1 + FADD SINC11 + FMUL SIN1 + FADD SINC9 + FMUL SIN1 + FADD SINC7 + FMUL SIN1 + FADD SINC5 + FMUL SIN1 + FADD SINC3 + FMUL SIN1 + FADD F1SIN /ADD IN 1 FOR SERIES + FMUL X /DO THE FINAL MULTIPLY. +SING, JXN SINRTN,0 /SHALL WE NEGATE + FNEG /YEP + JA SINRTN /AND RETURN. +SPIB2, FLDA F1SIN + JA SING +SPI, FCLA + JA SINRTN +S3PIB2, FLDA F1SIN + FNEG + JA SING + EXTERN #ARGER +DSNER, TRAP4 #ARGER + diff --git a/sw/f4/FRTSRC/dsqrt.ra b/sw/f4/FRTSRC/dsqrt.ra new file mode 100644 index 0000000..520a86d --- /dev/null +++ b/sw/f4/FRTSRC/dsqrt.ra @@ -0,0 +1,79 @@ +/ +/ +/ D S Q R T +/ +/ VERSION 5A 4-27-77 PT +/ + SECT DSQRT + JA #DSQRT + DPCHK + TEXT +DSQRT + +/ +DSQXR, SETX XRDSQ + SETB BPDSQ + JA .+3 +BPDSQ, F 0.0 +XRDSQ, F 0.0 +DARSAV, F 0.0 + F 0.0 +DSQ2, F 2.0 + F 0.0 +SNGL, F 0.0 + F 0.0 + ORG 10*3+BPDSQ + FNOP + JA DSQXR +/ + 0 +DSQRTN, JA . +DSQ1, F 0.0 + F 0.0 +/PICK UP ARGUMENTS + BASE 0 +#DSQRT, STARTD + FLDA 10*3 + FSTA DSQRTN + FLDA 0 + SETX XRDSQ + SETB BPDSQ + BASE BPDSQ + LDX 1,1 + FSTA BPDSQ + FLDA% BPDSQ,1 /ADDR OF X + FSTA BPDSQ +/ +/DO GENERAL TESTS ON THE ARGUMENT +/ + STARTE + FLDA% BPDSQ + JEQ DSQRTN /RETURN IF 0 + JLT DSQER /<0 ERROR + FSTA DARSAV /SAVE DOUBLE + STARTF /F MODE + ROUND + FSTA SNGL /SAVE +/ +/GET INITIAL APPROXIMATION BY CALLING +/SINGLE PRECISION ROUTINE +/ + EXTERN SQRT + JSR SQRT + JA .+4 + JA SNGL + FSTA SNGL /FIRST APPROX + STARTE /BACK TO E +/ +/TAKE N ITERATIONS OF +/X(K+1)=1/2(X(K)+X/X(K)) +/ + LDX -3,0 /3 TIMES +DSIT, FLDA DARSAV /GET X + FDIV SNGL /X(K) + FADD SNGL /X(K) + FDIV DSQ2 /DIVIDE BY 2 + FSTA SNGL /X(K+1) + JXN DSIT,0+ /ITERATE + FLDA SNGL /GET ANSWER + JA DSQRTN /RETURN + EXTERN #ARGER +DSQER, TRAP4 #ARGER + diff --git a/sw/f4/FRTSRC/exp.ra b/sw/f4/FRTSRC/exp.ra new file mode 100644 index 0000000..141e20e --- /dev/null +++ b/sw/f4/FRTSRC/exp.ra @@ -0,0 +1,109 @@ +/ +/ +/ E X P +/ - - - +/ +/SUBROUTINE EXP(X) +/ +/ VERSION 5A 4-27-77 PT +/ + SECT EXP + JA #EXP + 0 +EXPFUD, 0 + 0 + 0 +/ + EXTERN #ARGER +EXPER, TRAP4 #ARGER + TEXT +EXP + +EXPXR, SETX XREXP + SETB BPEXP +BPEXP, F 0.0 +XREXP, F 0.0 +EXP1, F 0.0 +EXP2, F 0.0 +EXP33, F 0.0 +EXP4, F 0.0 +F1EXP, F 1. +F2EXP, F 2. + ORG 10*3+BPEXP + FNOP + JA EXPXR + 0 +EXPRTN, JA . +/ +EXPAF, 4 + 2372 + 1402 +/ +EXPBF, 7774 + 2157 + 5157 +/ +EXPCF, 12 + 5454 + 343 +/ +EXPDF, 7 + 2566 + 5341 +/ +EXP2E, 1 + 2705 + 2435 + BASE 0 +#EXP, STARTD + FLDA 10*3 + FSTA EXPRTN + FLDA 0 + SETX XREXP + SETB BPEXP + BASE BPEXP + LDX 1,1 + FSTA BPEXP + FLDA% BPEXP,1 /ADDR OF X + FSTA BPEXP + STARTF + FLDA% BPEXP /GET X + LDX -1,0 /PRESERVE SIGN. + JGE .+5 + FNEG /IF NEGATIVE NEGATE IT. + LDX 0,0 /AND REMEMBER IT,BUBBY. + FMUL EXP2E /MULTIPLY TO BINARY TYPE. + FSTA EXP1 /AND SAVE IT AWAY. + JAL EXPER /CAN T FIX IT, ERROR. + ALN 0 /FIX IT UP. + FSTA EXP33 /AND SAVE IT. + FNORM /NOW NORMALIZE FOR OUR COMPUTATIONS. + FNEG /NEGATE THE FAC + FADD EXP1 /ADD IN BEFORE NORMAL. + FSTA EXP1 /AND STORE BACK. NO FADDM + FMUL EXP1 /NOW SQUARE IT. + FSTA EXP2 /AND SAVE IT. + FADD EXPDF /START THE ITERATION. + FSTA EXP4 /SAVE IN ANOTHER TEMP. + FLDA EXPCF /NEXT CONSTANT. + FDIV EXP4 /AND DIVIDE INTO IT. + FSUB EXP1 /SUBTRACT BACK NOW. + FADD EXPAF /NEXT CONSTANT. + FSTA EXP4 /AND SAVE AGAIN. KEEP THIS UP. + FLDA EXPBF + FMUL EXP2 + FADDM EXP4 + FLDA EXP1 + FDIV EXP4 + FMUL F2EXP + FADD F1EXP + FSTA EXPFUD /NOW FIDDLE THE EXPONENT. + STARTD + FLDA EXP33 + FADDM EXPFUD-1 /EXPONENT UPDATE. + STARTF + JXN EXPP,0 /NO INVERSION NECESSARY. RETURN. + FLDA F1EXP /INVERT IT + FDIV EXPFUD + JA EXPRTN +EXPP, FLDA EXPFUD /AN EXIT. + JA EXPRTN + diff --git a/sw/f4/FRTSRC/exp3.ra b/sw/f4/FRTSRC/exp3.ra new file mode 100644 index 0000000..67da383 --- /dev/null +++ b/sw/f4/FRTSRC/exp3.ra @@ -0,0 +1,65 @@ +/ +/ +/ +/ E X P 3 +/ - - - - +/ +/SUBROUTINE EXP3(B,E) +/ +/ VERSION 5A 4-26-77 MH +/ + SECT EXP3 + JA #EXP3 + EXTERN #ARGER +EXP3ER, TRAP4 #ARGER + TEXT +EXP3 + +EXP3XR, SETX XREXP3 + SETB BPEXP3 +BPEXP3, FNOP + 0 + 0 +XREXP3, F 0.0 +EXP31, F 0.0 +EXP32, F 0.0 +FP1XP3, F 1. + ORG 10*3+BPEXP3 + FNOP + JA EXP3XR + 0 +XP3RTN, JA . + BASE 0 +#EXP3, STARTD + FLDA 10*3 + FSTA XP3RTN + FLDA 0 + SETX XREXP3 + SETB BPEXP3 + BASE BPEXP3 + LDX 1,1 + FSTA BPEXP3 + FLDA% BPEXP3,1 /ADDR OF B + FSTA EXP31 + FLDA% BPEXP3,1+ /ADDR OF E + FSTA EXP32 + STARTF + FLDA% EXP31 /GET B + JEQ XP3RTN /0 ^ X = 0 + FSTA EXP31 /SAVE BASE + FLDA% EXP32 /GET E + JEQ EXP3ON /X ^ 0 = 1 + FSTA EXP32 /SAVE EXPONENT + FLDA EXP31 + JLT EXP3ER /ALL IS NOT WELL + EXTERN ALOG + JSR ALOG /CALL LOG + JA .+4 /TAKE LOG (B) + JA EXP31 + FMUL EXP32 /MULT BY EXPONENT-E + FSTA EXP31 + EXTERN EXP + JSR EXP /CALL EXP. + JA XP3RTN + JA EXP31 +EXP3ON, FLDA FP1XP3 + JA XP3RTN + diff --git a/sw/f4/FRTSRC/expcc.ra b/sw/f4/FRTSRC/expcc.ra new file mode 100644 index 0000000..691dc0c --- /dev/null +++ b/sw/f4/FRTSRC/expcc.ra @@ -0,0 +1,165 @@ +/ +/EXPCC +/COMPLEX RAISED TO COMPLEX +/ +/ VERSION 5A 4-26-77 MH +/ +/(A+I*B)^(C+I*D) +/A+B=0 YIELDS 0 +/B+D=0 MEANS USE EXP3 TO CALCULATTE A^C +/A+B=0,C+D=0 YIELDS 1.0 +/ENTER + EXIT IN STARTE + SECT #EXPCC + DPCHK + EXTERN #CAC + EXTERN EXP + EXTERN COS + EXTERN SIN + EXTERN ALOG + EXTERN EXP3 + EXTERN ATAN2 + EXTERN SQRT + BASE 0 +EXPCC, JA . + FSTA C,0 + FLDA 0 + FSTA A,0 + STARTF + BASE .+2000 + XTA 0 + FSTA T1 /SAVE XR 0 + FLDA A + JNE EX1 /A NOT 0 + FLDA B + JNE EX1 + STARTE /A=B=0 + FCLA +EX, FSTA #CAC /RESULT = 0 + JA EXPCC +EX1, FLDA C /C+D=0? + JNE EX2 + FLDA D + JNE EX2 + STARTE + FLDA FP1 /RESULT = 1 IF C=D=0 + JA EX +EX2, FLDA B + JNE EX3 /USE EXP3 IF B=D=0 + FLDA D + JNE EX3 + STARTF + JSR EXP3 + JA .+6 + JA A + JA C + FSTA A + STARTE + FLDA A /RETURN AS REAL PART + JA EX +EX3, STARTF +/TH=ATAN(B/A) + JSR ATAN2 + JA .+6 + JA B + JA A + FSTA TH +/ +/LOGR=ALOG(SQRT(A*A+B*B)) + FLDA A + FMUL A + FSTA LOGR + FLDA B + FMUL B + FADDM LOGR + JSR SQRT + JA .+4 + JA LOGR + FSTA LOGR + JSR ALOG + JA .+4 + JA LOGR + FSTA LOGR +/ARG=C*TH+D*LOGR + FLDA C + FMUL TH + FSTA ARG + FLDA D + FMUL LOGR + FADDM ARG +/ +/CALCULATE IN AND COS OF ARG. SAVE SIGN OF EACH + JSR SIN + JA .+4 + JA ARG + FSTA SINE + JSR COS + JA .+4 + JA ARG + FSTA CSINE +/CALL C*LOGR-D*TH + FLDA D + FMUL TH + FSTA REST + FLDA C + FMUL LOGR + FSUB REST + FSTA REST +/REAL = EXP(REST+ALOG(CSINE)) + FLDA CSINE /REAL + JLT .+6 + LDX 0,1 /=1 IF POSITIVE + JA .+3 + FNEG + JSA DO + JXN .+3,0 /SKIP IF POS + FNEG + FSTA A + FLDA SINE /IMAG + JLT .+6 + LDX 0,1 + JA .+5 + LDX 0,0 + FNEG + JSA DO + JXN .+3,0 + FNEG /RESTORE SIGN + FSTA B + FLDA T1 /RESTORE XR0 + ATX 0 + STARTE + FLDA A + FSTA #CAC + JA EXPCC +/ +DO, JA . + FSTA TH + JSR ALOG + JA .+4 + JA TH + FADD REST + FSTA ARG + JSR EXP + JA .+4 + JA ARG + FSTA ARG + FLDA TH /CHECK SIGN + JGE DOX + FLDA ARG + FNEG + FSTA ARG +DOX, FLDA ARG + JA DO +A, F 0.0 +B, F 0.0 +C, F 0.0 +D, F 0.0 +LOGR, F 0.0 +TH, F 0.0 +ARG, F 0.0 +SINE, F 0.0 +CSINE, F 0.0 +REST, F 0.0 +FP1, F 1.0 + F 0.0 +T1, F 0.0 + diff --git a/sw/f4/FRTSRC/expci.ra b/sw/f4/FRTSRC/expci.ra new file mode 100644 index 0000000..9b9b76b --- /dev/null +++ b/sw/f4/FRTSRC/expci.ra @@ -0,0 +1,88 @@ +/ +/EXPCI +/COMPLEX RAISED TO INTEGER OR REAL +/ +/ VERSION 5A 4-26-77 MH +/ +/ +/C=A+I*B +/C^D=R^D*EXP(D*I*THETA) +/ +/C IS IN #BASE +/D IS IN AC +/ +/ENTER IN STARTF,EXIT IN STARTE +/ + SECT #EXPCI + ENTRY #EXPCR + DPCHK + EXTERN SQRT + EXTERN ATAN2 + EXTERN SIN + EXTERN COS + EXTERN EXP3 + EXTERN #CAC + BASE 0 +#EXPCR, JA . + FSTA EXPON,0 + FLDA 0 /REAL + FSTA A,0 + FLDA 3 /IMAG + FSTA B,0 +/SET DUMMY BASE PAGE + BASE .+2000 +/ +/R=SQRT(A*A+B*B) + FLDA A + FMUL A + FSTA R + FLDA B + FMUL B + FADDM R + JSR SQRT + JA .+4 + JA R + FSTA R +/R^EXPON + JSR EXP3 + JA .+6 + JA R + JA EXPON + FSTA R +/THETA=ATAN(B/A) + JSR ATAN2 + JA .+6 + JA B + JA A +/THETA*EXPON + FMUL EXPON + FSTA A /PHASE ANGLE +/IMAG=R*SIN(PHASE) + JSR SIN + JA .+4 + JA A + FMUL R + FSTA B +/REAL=R*COS(PHASE) + JSR COS + JA .+4 + JA A + FMUL R + FSTA A + JGE .+3 /SKIP IF RESULT IS POS + FNEG /IF NOT,MAKE IT POS + FSUB LOWLIM /TEST FOR ZERO + JGE .+5 /JUMP IF NOT 0 + FCLA /ASSUME RESULT SHOULD BE 0 + FSTA A /AND STORE A 0 +/RETURN RESULT IN #CAC AND STARTE + STARTE + FLDA A + FSTA #CAC + JA #EXPCR +A, F 0.0 +B, F 0.0 +EXPON, F 0.0 +R, F 0.0 +LOWLIM, F 0.000009 /NUMBERS >= 1.E-5 OK + diff --git a/sw/f4/FRTSRC/expdd.ra b/sw/f4/FRTSRC/expdd.ra new file mode 100644 index 0000000..bdf0e51 --- /dev/null +++ b/sw/f4/FRTSRC/expdd.ra @@ -0,0 +1,22 @@ +/ +/ VERSION 5A 4-25-77 MH +/ + SECT #EXPDD + DPCHK + BASE 0 + EXTERN DEXP3 + JA . + FSTA EXPON,0 /EXPONENT + FLDA 0 /BASE + FSTA BASE,0 + JSR DEXP3 /EXP3(BASE,EXPON) + JA .+6 + JA BASE + JA EXPON + JA #EXPDD +BASE, F 0.0 + F 0.0 +EXPON, F 0.0 + F 0.0 + END + diff --git a/sw/f4/FRTSRC/expdi.ra b/sw/f4/FRTSRC/expdi.ra new file mode 100644 index 0000000..fb3f8ff --- /dev/null +++ b/sw/f4/FRTSRC/expdi.ra @@ -0,0 +1,63 @@ + SECT #EXPDI +/ B**E +/ WHERE E IS INTEGER +/ AND B IS DOUBLE PRECISION +/ +/ VERSION 5A 4-26-77 MH +/ + DPCHK + BASE 0 +EXPDI, JA . + FSTA SIGN /SAVE SIGN OF EXPONENT + JGE POSINT /ITS POSITIVE + FNEG +POSINT, FSTA EXP + XTA 1 /SAVE XR 1 + FSTA XR1 + LDX -27,1 /BIT COUNT + STARTE + FLDA ONE /START WITH ONE + FSTA PROD + STARTF + FLDA EXP +LOOP, JEQ YES /DONE IF ITS ZERO + FDIV TWO /DIVIDE BY TWO + ALN 0 /INTEGERIZE + FNORM + FSTA TEMP /SAVE AT + FMUL TWO /IS EXPONENT ODD ? + FSUB EXP + STARTE + JLT ODD /YES, JUMP + FLDA 0 /SQUARE BASE +SQUARE, FMULM 0 + STARTF + FLDA TEMP /EXPONENT OVER 2 + FSTA EXP + JXN LOOP,1+ /LOOP IF MORE BITS +YES, FLDA XR1 /DONE, RESTORE XR 1 + ATX 1 + FLDA SIGN /CHECK SIGN OF EXPONENT + JLT INVERT /IT WS NEGATIVE, INVERT RESULT + STARTE + FLDA PROD /RETURN ANSWER + JA EXPDI +INVERT, STARTE + FLDA ONE /RETURN WITH 1/PROD + FDIV PROD + JA EXPDI +ODD, FLDA 0 + FMULM PROD + JA SQUARE /GO SQUARE THE BASE +ONE, F 1.0 + F 0.0 +TWO, F 2.0 +PROD, F 0.0 + F 0.0 +SIGN, F 0.0 +TEMP, F 0.0 +XR1, F 0.0 +EXP, F 0.0 + F 0.0 + END + diff --git a/sw/f4/FRTSRC/expdr.ra b/sw/f4/FRTSRC/expdr.ra new file mode 100644 index 0000000..d0ec51c --- /dev/null +++ b/sw/f4/FRTSRC/expdr.ra @@ -0,0 +1,25 @@ +/ +/ VERSION 5A 4-26-77 MH +/ + SECT #EXPDR + DPCHK + BASE 0 + EXTERN DEXP3 + JA . + FSTA EXPON,0 /EXPONENT + FCLA + FSTA EXPON+3 /MUST BE 6 WDS + STARTE + FLDA 0 /BASE + FSTA BASE,0 + JSR DEXP3 /EXP3(BASE,EXPON) + JA .+6 + JA BASE + JA EXPON + JA #EXPDR +BASE, F 0.0 + F 0.0 +EXPON, F 0.0 + F 0.0 + END + diff --git a/sw/f4/FRTSRC/expic.ra b/sw/f4/FRTSRC/expic.ra new file mode 100644 index 0000000..7c2d22c --- /dev/null +++ b/sw/f4/FRTSRC/expic.ra @@ -0,0 +1,142 @@ +/ +/EXPIC +/INTEGER OR REAL RAISED TO COMPLEX +/ +/ VERSION 5A 4-26-77 MH +/ +/(A)^(C+I*D) +/A=0 YIELDS 0 +/D=0 MEANS USE EXP3 TO CALCULATE A^C +/C+D=0 YIELDS 1.0 +/ENTER + EXIT IN STARTE + SECT #EXPIC + DPCHK + EXTERN #CAC + EXTERN EXP + EXTERN COS + EXTERN SIN + EXTERN ALOG + EXTERN EXP3 + EXTERN SQRT + BASE 0 +EXPIC, JA . + FSTA C,0 + STARTF + FLDA 0 /BASE + FSTA A,0 + BASE .+2000 + XTA 0 + FSTA T1 /SAVE XR 0 + FLDA A + JNE EX1 /A NOT 0 + STARTE /A=B=0 + FCLA +EX, FSTA #CAC /RESULT = 0 + JA EXPIC +EX1, FLDA C /C+D=0? + JNE EX2 + FLDA D + JNE EX2 + STARTE + FLDA FP1 /RESULT = 1 IF C=D=0 + JA EX +EX2, FLDA D + JNE EX3 /USE EXP3 IF D=0 + JSR EXP3 + JA .+6 + JA A + JA C + FSTA A + STARTE + FLDA A /RETURN AS REAL PART + JA EX +/ +/LOGR=ALOG(SQRT(A*A)) +EX3, FLDA A + FMUL A + FSTA LOGR + JSR SQRT + JA .+4 + JA LOGR + FSTA LOGR + JSR ALOG + JA .+4 + JA LOGR + FSTA LOGR +/ARG=C+D*LOGR + FLDA D + FMUL LOGR + FADD C + FSTA ARG +/ +/CALCULATE SIN AND COS OF ARG. SAVE SIGN OF EACH + JSR SIN + JA .+4 + JA ARG + FSTA SINE + JSR COS + JA .+4 + JA ARG + FSTA CSINE +/CALL C*LOGR-D + FLDA C + FMUL LOGR + FSUB D + FSTA REST +/REAL = EXP(REST+ALOG(CSINE)) + FLDA CSINE /REAL + JLT .+6 + LDX 0,1 /=1 IF POSITIVE + JA .+3 + FNEG + JSA DO + JXN .+3,0 /SKIP IF POS + FNEG + FSTA C + FLDA SINE /IMAG + JLT .+6 + LDX 0,1 + JA .+5 + LDX 0,0 + FNEG + JSA DO + JXN .+3,0 + FNEG /RESTORE SIGN + FSTA D + FLDA T1 /RESTORE XR0 + ATX 0 + STARTE + FLDA C + FSTA #CAC + JA EXPIC +/ +DO, JA . + FSTA LOGR + JSR ALOG + JA .+4 + JA LOGR + FADD REST + FSTA ARG + JSR EXP + JA .+4 + JA ARG + FSTA ARG + FLDA LOGR /CHECK SIGN + JGE DOX + FLDA ARG + FNEG + FSTA ARG +DOX, FLDA ARG + JA DO +A, F 0.0 +C, F 0.0 +D, F 0.0 +LOGR, F 0.0 +ARG, F 0.0 +SINE, F 0.0 +CSINE, F 0.0 +REST, F 0.0 +FP1, F 1.0 + F 0.0 +T1, F 0.0 + diff --git a/sw/f4/FRTSRC/expid.ra b/sw/f4/FRTSRC/expid.ra new file mode 100644 index 0000000..e37ee9e --- /dev/null +++ b/sw/f4/FRTSRC/expid.ra @@ -0,0 +1,22 @@ +/ +/ VERSION 5A 4-26-77 MH +/ + SECT #EXPID + DPCHK + BASE 0 + EXTERN EXPID2 +EXPID, JA . + FSTA EXPON,0 /EXPONENT + STARTF + FLDA 0 /BASE + FSTA BASE,0 + JSR EXPID2 + JA .+6 + JA BASE + JA EXPON + JA EXPID +BASE, F 0.0 +EXPON, F 0.0 + F 0.0 + END + diff --git a/sw/f4/FRTSRC/expid2.ra b/sw/f4/FRTSRC/expid2.ra new file mode 100644 index 0000000..80f39a4 --- /dev/null +++ b/sw/f4/FRTSRC/expid2.ra @@ -0,0 +1,71 @@ +/ +/ +/ +/ E X P I D 2 +/ - - - - - - +/ +/SUBROUTINE EXPID2(B,E) +/WHERE B IS INTEGER AND E IS DOUBLE +/ +/ VERSION 5A 4-26-77 MH +/ + SECT EXPID2 + JA #EXID2 + EXTERN #ARGER +EXP3ER, TRAP4 #ARGER + TEXT +EXPID2+ +EXP3XR, SETX XREXP3 + SETB BPEXP3 +BPEXP3, FNOP + 0 + 0 +XREXP3, F 0.0 +EXP31, F 0.0 + F 0.0 +EXP32, F 0.0 +FP1XP3, F 1. + F 0.0 + ORG 10*3+BPEXP3 + FNOP + JA EXP3XR + 0 +XP3RTN, JA . + BASE 0 +#EXID2, STARTD + FLDA 10*3 + FSTA XP3RTN + FLDA 0 + SETX XREXP3 + SETB BPEXP3 + BASE BPEXP3 + LDX 1,1 + FSTA BPEXP3 + FLDA% BPEXP3,1 /ADDR OF B + FSTA EXP31 + FLDA% BPEXP3,1+ /ADDR OF E + FSTA EXP32 + STARTF + FLDA% EXP31 /GET B + JEQ XP3RTN /0 ^ X = 0 + JLT EXP3ER + FSTA EXP31 /SAVE BASE + FCLA + FSTA EXP31+3 + STARTE + LDX 73,1 + EXTERN DLOG + JSR DLOG /CALL LOG + JA .+4 /TAKE LOG (B) + JA EXP31 + FSTA EXP31 + FLDA% EXP32 /GET EXPONENT + JEQ EXP3ON /X^0=1 + FMULM EXP31 + EXTERN DEXP + JSR DEXP /CALL EXP. + JA XP3RTN + JA EXP31 +EXP3ON, STARTE + FLDA FP1XP3 + JA XP3RTN + diff --git a/sw/f4/FRTSRC/expii.ra b/sw/f4/FRTSRC/expii.ra new file mode 100644 index 0000000..02a5e33 --- /dev/null +++ b/sw/f4/FRTSRC/expii.ra @@ -0,0 +1,52 @@ + SECT #EXPII +/ B**E +/ WHERE E IS INTEGER +/ AND B IS REAL OR INTEGER +/ +/ VERSION 5A 4/26/77 MH +/ + BASE 0 + JA . + FSTA SIGN /SAVE SIGN OF EXPONENT + JGE POSINT /ITS POSITIVE + FNEG +POSINT, FSTA 3 /PUT IT INTO 3 + XTA 1 /SAVE XR 1 + FSTA XR1 + LDX -27,1 /BIT COUNT + FLDA ONE /START WITH ONE + FSTA PROD + FLDA 3 /GET EXPONENT +LOOP, JEQ YES /DONE IF ITS ZERO + FDIV TWO /DIVIDE BY TWO + ALN 0 /INTEGERIZE + FNORM + FSTA TEMP /SAVE AT + FMUL TWO /IS EXPONENT ODD ? + FSUB 3 + JLT ODD /YES, JUMP + FLDA 0 /SQUARE BASE +SQUARE, FMULM 0 + FLDA TEMP /EXPONENT OVER 2 + FSTA 3 + JXN LOOP,1+ /LOOP IF MORE BITS +YES, FLDA XR1 /DONE, RESTORE XR 1 + ATX 1 + FLDA SIGN /CHECK SIGN OF EXPONENT + JLT INVERT /IT WS NEGATIVE, INVERT RESULT + FLDA PROD /RETURN ANSWER + JA #EXPII +INVERT, FLDA ONE /RETURN 1/PROD + FDIV PROD + JA #EXPII +ODD, FLDA 0 /MULT PROD BY BASE + FMULM PROD + JA SQUARE /GO SQUARE THE BASE +ONE, F 1.0 +TWO, F 2.0 +PROD, F 0.0 +SIGN, F 0.0 +TEMP, F 0.0 +XR1, F 0.0 + END + diff --git a/sw/f4/FRTSRC/expir.ra b/sw/f4/FRTSRC/expir.ra new file mode 100644 index 0000000..3167ba4 --- /dev/null +++ b/sw/f4/FRTSRC/expir.ra @@ -0,0 +1,19 @@ +/ +/ VERSION 5A 4-26-77 MH +/ + SECT #EXPIR + BASE 0 + EXTERN EXP3 + JA . + FSTA EXPON,0 /EXPONENT + FLDA 0 /BASE + FSTA BASE,0 + JSR EXP3 /EXP3(BASE,EXPON) + JA .+6 + JA BASE + JA EXPON + JA #EXPIR +BASE, F 0.0 +EXPON, F 0.0 + END + diff --git a/sw/f4/FRTSRC/f4.pa b/sw/f4/FRTSRC/f4.pa new file mode 100644 index 0000000..8bebc29 --- /dev/null +++ b/sw/f4/FRTSRC/f4.pa @@ -0,0 +1,3661 @@ +/4 OS/8 FORTRAN (PASS ONE) +/ +/ VERSION 4A PT 16-MAY-77 +/ +/ OS/8 FORTRAN COMPILER - PASS 1 +/ +/ BY: HANK MAURER +/ UPDATED BY: R.LARY + M. HURLEY +/ +/ +/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +VERSON=4 + /CHANGES FOR MAINTENANCE RELEASE (S.R.): + +/1. BUMPED VERSION NUMBER TO 304 +/2. INCLUDED PATCH SEQ #4 (OCT DSN) FOR SF ERROR FIX +/3. INCLUDED PATCH SEQ #6 (TEMP VARS IN ASF) +/4. FIXED PROBLEM IN DATA STATEMENT +/5. STOPPED HALT AFTER OT ERROR BY CONVERTING LOGICAL +/ VARS TO INTEGER IN ARITHMETIC IF STATEMENT +/6. FIXED BUG RE /A AND .RA EXTENSION + +/LAST MINUTE CHANGES: + +/7. ALLOWED PARITY INPUT +/8. IGNORE NULLS ON INPUT +/9. FIXED BUG RE IGNORING LAST LINE IF IN ERROR +/ OR IN FACT IGNORING ANY LAST LINE IF NO END STATEMENT +/10. ALLOW MULTIPLE INPUT FILES +/ +/ +/CHANGES FOR OS/8 V3D AND OS/78 BY P.T. +/ .PATCH LEVEL NOW CONTAINED IN LOCATION 1130 + *7 +LINENO, 1 /2.01/ LINE NUMBER +X10, 0 /AUTO INDEX REGISTERS +X11, 0 +X12, 0 +NEXT, FREE-1 /FREE SPACE POINTER +STACK, STACKS-1 /STACK POINTER +CHRPTR, 0 /INPUT BUFFER POINTER +X16, 0 +X17, 0 +STKLVL, STACKS-1 /STACK BASE LEVEL +BUCKET, 0 /FIRST CHAR OF NAME +WORD1, 0 /SIX WORD LITERAL BUFFER +WORD2, 0 +WORD3, 0 +WORD4, 0 +WORD5, 0 +WORD6, 0 +ACO, 0 /FLOATING AC OVERFLOW WORD +OP1, 0 /SEVEN WORD OPERAND FOR "NUMBER" +OP2, 0 +OP3, 0 +OP4, 0 +OP5, 0 +OP6, 0 +OPO, 0 +CHAR, 0 /ICHAR PUTS CHARACTER HERE +NOCODE, 0 /IS 1 IF CODE GENERATION OFF +NCHARS, 0 /SIZE OF INPUT LINE +NUMELM, 0 /NUMBER OF VARS IN TYPED LIST +TEMP, 0 +TEMP2, 0 +DECPT, 0 /SET 1 IF NUMBER CONTAINED . +ESWIT, 0 /1 FOR E 0 FOR D +NDIGIT, 0 /NUMBER OF DIGITS TO RIGHT OF . +HCHAR, HCOUNT /HOLLERITH GETTER ROUTINE +SNUM, 0 /POINTER TO ST ENTRY FOR STMT NUMBER +IFSWIT, 0 /=1 IF INSIDE LOGICAL IF +EXPON, 0 /HOLDS EXPONENT FOR CONVERSION +TMPFIL, 0617;2224;2216;2415 /PASS1 OUTPUT FILE + 0;0;0;0 /PASS2 OUTPUT FILE +DOEND, 0 /SET 1 IF THIS STMT WAS A IF, + /GOTO, RETURN, PAUSE, OR STOP +THSNUM, 0 /CURRENT STATEMENT NUMBER +DIMNUM, 0 /LINEARIZED SS FOR EQ +DPRDCT, 0 /HOLDS DIMENSION PRODUCT +EQTEMP, 0 /TEMP FOR EQUIVALENCE +MQ, 0 /MQ FOR 12 BIT MULTIPLY +MASTER, 0 /POINTER TO MASTER IN EQUIV GROUP +MNUM, 0 /LINEARIZED SS FOR MASTER +NSLAVE, 0 /NUMBER OF SLAVES IN GROUP +PASS2O, 0 /START OF PASS 2 OVERLAY SECTION +OUFILE, 0 /START OF PASS1 OUTPUT FILE +DSERES, 0 /MAGIC NUMBER +PROGNM, MAIN /POINTER TO PROG NAME +ARGLST, 0 /POINTER TO ARG LIST +FUNCTN, 0 /0=MAIN, 1=FUNCTION, -2=SUBROUTINE +SETBIT, 0 /TEMPS FOR DECLARATION SCANNER +BADBIT, 0 +DOINDX, 0 /POINTER TO DO INDEX FOR DO LOOPS +TLTEMP, 0 /TEMP FOR TYPE ROUTINE +OWTEMP, 0 /TEMP FOR OUTWRD +CNT72, -102 /72 COLUMN COUNTER +DPUSED, 0 /=1 IF DOUBLE HARDWARE USED +VERS, VERSON /VERSION NUMBER +M211, -211 +P211, 211 +P240, 240 +IXLNP5, LINE+5 /** +IXLINE, LINE +IXLINM, LINE-1 +STMJMP, 0 /FOR DEFINE FILE + / OPCODES AND EQUS + MAXHOL=100 /MAXIMUM HOLLERITH LITERAL + COMREG=4600 /INTER-PASS COMMUNICATION REGION + STACKS=4700 /STACK AREA + NAME1=6200 /NAME AND HOLLERITH BUFFER (WAS 6400)** + LINE=6300 /LINE BUFFER (WAS 6500)** + INBUF=6600 /INPUT BUFFER (FIELD 1) + OUBUF=7200 /OUTPUT BUFFER (DITTO) + INDEVH=7200 /INPUT DEVICE HANDLER (WAS 7400)** + PAUSOP=22 + DPUSH=PAUSOP+1 + BINRD1=DPUSH+1 /OPCODE DEFINITIONS + FMTRD1=BINRD1+1 + RCLOSE=FMTRD1+1 + DARD1=RCLOSE+1 + BINWR1=DARD1+1 + FMTWR1=BINWR1+1 + WCLOSE=FMTWR1+1 + DAWR1=WCLOSE+1 + DEFFIL=DAWR1+1 + ASFDEF=DEFFIL+1 + ARGSOP=ASFDEF+1 + EOLCOD=ARGSOP+1 + ERRCOD=EOLCOD+1 + RETOPR=ERRCOD+1 + REWOPR=RETOPR+1 + STOROP=REWOPR+1 + ENDOPR=STOROP+1 + DEFLBL=ENDOPR+1 + DOFINI=DEFLBL+1 + ARTHIF=DOFINI+1 + LIFBGN=ARTHIF+1 + DOBEGN=LIFBGN+1 + ENDFOP=DOBEGN+1 + STOPOP=ENDFOP+1 + ASNOPR=STOPOP+1 + BAKOPR=ASNOPR+1 + FMTOPR=BAKOPR+1 + GO2OPR=FMTOPR+1 + CGO2OP=GO2OPR+1 + AGO2OP=CGO2OP+1 + IOLMNT=AGO2OP+1 + DATELM=IOLMNT+1 + DREPTC=DATELM+1 + DATAST=DREPTC+1 + ENDELM=DATAST+1 + PRGSTK=ENDELM+1 + DOSTOR=PRGSTK+1 +/ ASSEMBLE STATEMENT + PAGE +RDLOOP, CIF 10 /FOR OS/8 2 PG HANDLERS** + JMS I [ICHAR /GET CHAR FROM INPUT FILE + JMP ENDLIN /END LINE OR CR + TAD M211 /CHECK FOR TAB** + SNA + TAD (240-211 /CONVERT TO BLANK + TAD P211 /** + DCA I CHRPTR /SAVE CHAR + ISZ CNT72 /PAST COLUMN 72 ? + SKP + JMP SKPLIN /SKIP 73 TO 80 + TAD CHRPTR + CIA CLL + TAD (LINE+670 + SZL CLA /TEST FOR TOO MANY CONTINUATIONS + JMP RDLOOP + JMS I [ERMSG /LINE TOO LONG + 1424 +SKPCOM, TAD X16 /RESTORE CHRPTR + DCA CHRPTR +SKPLIN, CIF 10 /** + JMS I [ICHAR /SKIP REST OF LINE + JMP ENDLIN + CLA + JMP SKPLIN +ENDLIN, TAD CHRPTR /SAVE CHAR POSITION + DCA X16 + TAD CHRPTR + DCA X10 /SAVE POSITION FOR COMMENT CHECK + TAD (-102 /SET COLUMN COUNT + DCA CNT72 + TAD M6 + DCA NCHARS +GET6, CIF 10 /** + JMS I [ICHAR /GET FIRST 6 CHARS + JMP SHORTL /IGNORE SHORT LINES + TAD M211 /IS CHAR A TAB ? ** + SZA CLA + JMP NOTAB /NO + TAD P240 /TREAT FIRST TAB AS SIX BLANKS + DCA I CHRPTR + ISZ NCHARS + JMP .-3 + TAD P240 /FAKE CONTINUATION CHECK + DCA CHAR + JMP CCHECK /GO TO COMMENT CHECK +SHORTL, TAD X16 /RESET CHAR POINTER + DCA CHRPTR /TO IGNORE SHORT LINES + JMP ENDLIN +NOTAB, TAD CHAR + DCA I CHRPTR + ISZ NCHARS + JMP GET6 /LOOP +CCHECK, TAD I X10 /IS IT A COMMENT ? + TAD (-303 + SNA CLA + JMP SKPCOM /COMMENT, SKIP REST +NOCMNT, TAD CHAR /WAS SIXTH CHAR A BLANK ? + TAD MMM240 + SNA CLA + JMP GOTLIN /YES, NO MORE CONTINUATIONS +CCARD, TAD X16 /IGNORE THESE SIX CHARACTERS + DCA CHRPTR + JMP RDLOOP /CONTINUE WITH THIS LINE +GOTLIN, TAD CHRPTR /COMPUTE -NCHARS-1 + CIA + TAD (LINE+4 + DCA NCHARS + TAD [LINE-1 /RESET CHAR POINTER + DCA CHRPTR + JMS I [CKCTLC /CHECK FOR CONTROL C +LINE1, DCA THSNUM /ZERO CURRENT STMT NUMBER + CLL CML RAR /SET LABEL DEFINE BIT + JMS I [STMNUM /GO LOOK FOR LABEL + JMP COMPIL /NONE THERE + TAD SNUM /SAVE STATEMENT NUMBER + DCA THSNUM + TAD (DEFLBL /OUTPUT DEFINITION FOR THIS LABEL + JMS I [OUTWRD + TAD SNUM + JMS I [OUTWRD /FOLLOWED BY THE LABEL ADDRESS +COMPIL, JMS I [SAVECP + ISZ LINENO /2.01/ PUT LINE NUMBER + TAD LINENO /2.01/ INTO MQ + 7421 /2.01/ + CLA IAC + DCA NOCODE /SET NOCODE SWITCH + JMS I [ERMSG /SET UP DEFAULT ERROR MESSAGE + 1513 + JMS I [LEXPR /IS IT ARITHMETIC ? + JMP NOTAR /NO + JMS I [GETC /LOOK FOR = + JMP NOTAR /NOT ARITHMETIC + TAD MMM275 /= + SNA CLA + JMS I [EXPR /SCAN LEFT PART + JMP NOTAR + JMS I [ERMSG /SET MESSAGE TO ILLEGAL OPERATOR + 1720 + ISZ NCHARS /SHOULD BE NOTHING LEFT + JMP NOTAR /IF THERE IS, ITS NOT ARITHMETIC +ITSAR, JMS I [RESTCP /RESTORE TO START OF LINE + DCA NOCODE /ALLON CODE + JMS I [LEXPR /GET LEFT SIDE +M6, -6 /V3C MUST BE HERE + JMS I [GETC /SKIP = +MMM240, -240 /SHOULD NEVER GET HERE + CLA + JMS I [EXPR /GET RIGHT SIDE +MMM275, -275 /SHOULD NEVER GET HERE + TAD (STOROP /OUTPUT STORE + JMS I [OUTWRD + JMP I [NEXTST /DO NEXT LINE +NOTAR, JMS I [RESTCP /RESTART LINE + DCA NOCODE + JMS I [SAVECP /RESAVE CHAR POSITION + TAD (CMDLST-1 + DCA X10 + JMP I (CMDLUP /GO SEARCH FOR KEYWORD + / KEYWORD SEARCH + PAGE +CMDLUP, CDF 10 /TABLE IN FIELD ONE + TAD I X10 /GET NEXT 2 CHARS OF KEYWORD + SZA + JMP CMDLP2 /NOT DONE YET + CLL CMA RAL /REMOVE CHAR POS FROM STACK + TAD STACK + DCA STACK + TAD I X10 /GET ROUTINE ADDRESS + CDF + DCA STMJMP + JMP I STMJMP /JUMP TO THE ROUTINE +CMDLP2, DCA TEMP /SAVE THE TWO CHARS + CDF + JMS I [GET2C /GET TWO CHARS FROM THE INPUT + JMP .+4 /NOT ENOUGH CHARS, CAN'T BE THIS ONE + TAD TEMP /COMPARE + SNA CLA + JMP CMDLUP /MATCHES, KEEP GOING + JMS I [RESTCP /RESTORE CHAR POS + ISZ STACK + ISZ STACK /AND SAVE IT AGAIN + CDF 10 + TAD I X10 /FIND END OF THIS COMMAND + SZA CLA + JMP .-2 + ISZ X10 /SKIP ROUTINE ADDRESS + TAD I X10 /IS THE LIST EXHAUSTED ? + SZA + JMP CMDLP2 /NO, GO AGAIN +BADCMD, JMS I [ERMSG /TREAT AS BAD ARITHMETIC STMT +ERCODE, 0 + / END OF STMT PROC +NEXTLN, +NEXTST, +DOENDR, TAD STKLVL /RESET STACK POINTER + DCA STACK + JMS I [POP /LOOK FOR DO END + CIA + TAD THSNUM /DOES THIS LINE END A DO LOOP ? + SZA CLA + JMP NODOND /NO, REPLACE STACK AND COMPILE STMT + TAD (DOFINI + JMS I [OUTWRD /OUTPUT DO END COMMAND + JMS I [POP /GET INDEX VARIABLE + JMS I [OUTWRD + TAD STACK /RESET STACK BASE LEVEL + DCA STKLVL + TAD DOEND /WAS THIS A LEGAL ENDING STMT ? + SZA CLA + JMS I [ERMSG + 0504 /DO END ERROR + DCA DOEND /KILL SWITCH + JMP DOENDR +NODOND, ISZ STACK /REPLACE STACK ENTRY + DCA DOEND /KILL SWITCH + TAD (EOLCOD /OUTPUT EOL CODE + JMS I [OUTWRD + DCA ERCODE /RESET ERROR CODE + DCA IFSWIT /KILL IF SWITCH + TAD (-6 /MOVE FIRST 6 CHARS + DCA NCHARS + TAD [LINE-1 /INTO START OF BUFFER + DCA CHRPTR + TAD I X16 + DCA I CHRPTR + ISZ NCHARS + JMP .-3 + JMP I (RDLOOP + / GOTO'S +GOTO, ISZ DOEND /DO END ILLEGAL + JMS I [STMNUM /IS IT A SIMPLE GOTO ? + JMP CMPGO2 /NO, SEE IF ITS A COMPUTED ONE + TAD (GO2OPR /OUTPUT GOTO OPERATOR + JMS I [OUTWRD + TAD SNUM /FOLLOWED BY STMT NUMBER + JMS I [OUTWRD + JMP I [NEXTST +CMPGO2, JMS I [GETC /LOOK FOR ( + JMP BADGO2 /BAD GOTO + TAD (-250 + SZA CLA + JMP ASNGO2 /NOT ( , MAYBE ITS AN ASSIGNED GOTO + TAD STACK /SAVE STACK POSITION + DCA X12 + DCA TEMP /ZERO BRANCH COUNTER +GO2LUP, JMS I [STMNUM /GET NEXT STMT NUMBER + JMP BADGO2 /MUST BE THERE + TAD SNUM + JMS I [PUSH /SAVE IT TEMPORARILY + ISZ TEMP /BUMP BRANCH COUNT + JMS I [COMARP /LOOK FOR COMMA OR RIGHT PAREN + JMP BADGO2 /NEITHER + JMP GO2LUP /COMMA, GO GET NEXT LABEL + JMS I [GETC /SKIP NEXT CHAR (ITS A COMMA) + JMP BADGO2 + CLA + TAD TEMP /SAVE COUNT + JMS I [PUSH /ON STACK + JMS I [EXPR /COMPILE INDEX EXPR + JMP I [NEXTST + TAD (CGO2OP /OUTPUT COMPUTED GOTO OPERATOR + JMS I [OUTWRD + JMS I [POP /GET COUNT + CIA + DCA TEMP /SAVE COMPLEMENT + TAD TEMP + CIA + JMS I [OUTWRD /OUTPUT COUNT + TAD X12 /RESTORE STACK POINTER + DCA STACK + TAD I X12 /MOVE STMT NUMBERS TO OUTPUT + JMS I [OUTWRD + ISZ TEMP + JMP .-3 + JMP I [NEXTST +ASNGO2, JMS I [BACK1 /PUT BACK NON ( + JMS I [LEXPR /GET ASSIGN VAR + JMP BADGO2 + TAD (AGO2OP /OUTPUT GOTO OPERATOR + JMS I [OUTWRD + JMP I [NEXTST +BADGO2, JMS I [ERMSG + 0724 + JMP I [NEXTST + / I/O STATEMENTS + PAGE +RDWR, 0 /SUBR FOR IO STATEMENTS + JMS I [CHECKC /LOOK FOR ( +M250, -250 + JMP BADRD + JMS I [EXPR /COMPILE UNIT + JMP I [BADCMD + JMS I [COMARP + JMP DAQUOT /LOOK FOR ' (DIRECT ACCESS I/O) + JMP RDFMT /, + TAD (BINRD1 /FORMATLESS READ/WRITE +IOSTRT, TAD I RDWR /ADD ADJUSTOR + JMS I [OUTWRD /OUTPUT BINARY READ +IOLIST, JMS I [PUSH /MARK STACK + JMS I [GETC /IS IT AN IMPLIED DO ? + JMP ENDIOL /NO, END OF LIST + TAD M250 + SZA CLA + JMP TRYIOE /NO, LOOK FOR IO ELEMENT + JMS I [SAVECP /SAVE CHAR POS AT START OF IDO + DCA IDOPAR /ZERO PAREN COUNTER +FINDND, JMS I [GETNAM /GET A NAME IF THERE IS ONE +XPURGE, PRGSTK /DON'T WORRY ITS A NOP + JMS I [GETC /GET A CHAR + JMP ENDIOL + TAD M251 /IS IT A ) ? + SNA + JMP RPIOL /YES + IAC /IS IT ( ? + SNA + JMP LPIOL /YES + TAD (250-275 /IS IT = ? + SZA CLA + JMP FINDND /NONE OF THESE + TAD IDOPAR /IS PAREN COUNT 0 ? + SZA CLA + JMP FINDND /NO, ITS FROM AN INNER LOOP + JMS I [LOOKUP /THIS ELEMENT IS THE DO INDEX + DCA DOINDX + JMS I (DOSTUF /COMPILE THE LOOP + JMP BADIOL /ERROR IN DO PARMS + JMS I [CHECKC /MUST HAVE ) + -251 + JMP BADIOL + TAD CHRPTR /SAVE CHAR POSITION + DCA TEMP + TAD NCHARS + DCA TEMP2 + JMS I [RESTCP /RESTORE TO START OF IMPLIED LOOP + TAD TEMP2 /NOW SAVE POS AFTER LOOP + JMS I [PUSH + TAD TEMP + JMS I [PUSH + TAD DOINDX /AND DO INDEX + JMP IOLIST +LPIOL, ISZ IDOPAR /( INCREASES COUNT + JMP FINDND +RPIOL, CMA /) DECREASES COUNT + TAD IDOPAR + SMA + JMP FINDND-1 + CLA +BADIOL, +BADRD, JMS I [ERMSG /BAD IO STMT + 2227 + JMP I [NEXTST +TRYIOE, JMS I [BACK1 /PUT BACK NON ( + JMS I [LEXPR /GET IOLIST ELEMENT + JMP BADRD /NOT THERE, ERROR + JMS I [GETC /LOOK FOR A COMMA + JMP .+4 /EOL + TAD (-254 + SZA + JMP NOTIOL /NOT AN ELEMENT + TAD (IOLMNT /OUTPUT OPCODE + JMS I [OUTWRD + JMP IOLIST+1 +NOTIOL, TAD (254-275 /IS IT AN = (END OF IDO) + SZA CLA + JMP BADIOL /NO, BAD + JMS I [POP /GET STUFF FROM THE STACK + SNA + JMP BADIOL /ZERO IS BAD + DCA DOINDX /THIS IS THE INDEX + JMS I [RESTCP /GET THE CHAR POSITION + TAD XPURGE /OUTPUT PURGE OPERATOR + JMS I [OUTWRD /BECAUSE AN EXTRA IS ON THE STK + TAD (DOFINI /END LOOP + JMS I [OUTWRD + TAD DOINDX + JMS I [OUTWRD + JMS I [GETC /END OF LIST ? + JMP ENDIOL + TAD (-254 + SZA CLA + JMP BADIOL /MUST BE A COMMA + JMP IOLIST+1 +IDOPAR, 0 +ENDIOL, JMS I [POP /IS THE MARK THERE ? + SZA CLA + JMP BADRD /NO, ERROR + TAD I RDWR + TAD (RCLOSE /END OF IO OPERATION + JMS I [OUTWRD + JMP I [NEXTST +RDFMT, JMS I [STMNUM /LOOK FOR FMT LINE NUMBER + JMP RTFMT + JMS I [OUTWRD /OUTPUT PUSH COMMAND + TAD SNUM /OUTPUT STMT NUMBER OF FORMAT + JMS I [OUTWRD +RDLIST, TAD (FMTRD1 /START OF FORMATTED READ + TAD I RDWR /ADD ADJUSTOR + JMS I [OUTWRD + JMS I [CHECKC /LOOK FOR ) +M251, -251 + JMP BADRD + JMP IOLIST /GO GET IO LIST +RTFMT, JMS I [LEXPR /GET R.T. FORMAT + JMP BADRD + JMP RDLIST /GET LIST + /DIRECT ACCESS I/O + PAGE +DAQUOT, JMS I [BACK1 + JMS I [CHECKC /LOOK FOR ' + -247 + JMP BADRD /SYNTAX IS NO GOOD + JMS I [EXPR /GET RECORD NUMBER EXPR + JMP BADRD + JMS I [CHECKC /LOOK FOR ) + -251 + JMP BADRD + TAD (DARD1 /DIRECT ACCESS OPEN + JMP IOSTRT +FIND, JMP I [NEXTST /COOL ISN'T IT ? +DFINFL, JMS I [EXPR /COMPILE UNIT + JMP BADDEF /BAD DEFINE STMT + DCA STMJMP /PERMIT VARIABLE FOR LOG UNIT + JMS I [CHECKC /( + -250 + JMP BADDEF + JMS I [EXPR /NUMBER OF RECORDS + JMP BADDEF + JMS I [CHECKC /, + -254 + JMP BADDEF + JMS I [EXPR /RECORD SIZE + JMP BADDEF + JMS I [CHECKC /, + -254 + JMP BADDEF + JMS I [CHECKC /U + -325 + JMP BADDEF + JMS I [CHECKC /, +MCOMA, -254 + JMP BADDEF + JMS I [GETNAM /GET INDEX VARIABLE + JMP BADDEF + JMS I [OUTWRD + JMS I [LOOKUP + JMS I [OUTWRD /OUTPUT INDEX VAR + TAD (DEFFIL /OUTPUT DEFINE OPERATOR + JMS I [OUTWRD + JMS I [CHECKC /) + -251 + JMP BADDEF + JMS I [GETC /ANOTHER DEFINE ? + JMP I [NEXTST + TAD MCOMA /, ? + SNA CLA + JMP DFINFL /YES, ANOTHER FILE +BADDEF, JMS I [ERMSG /BAD DEFINE FILE STMT + 0406 + JMP I [NEXTST +RESTCP, 0 /RESTORE CHAR POSITION FROM STACK + JMS I [POP + DCA CHRPTR + JMS I [POP + DCA NCHARS + JMP I RESTCP +INTEGE, JMS I [CHECKC /INTEGER STMT + -322 + JMP I [BADCMD + JMS I [TYPLST + 0101 + 0100 + NOP + JMP I [NEXTST +PAUZE, JMS I [CHECKC /LOOK FOR E + -305 + JMP I [BADCMD + JMS I [GETC /ANY EXPR ? + JMP NOARGP /MAKE IT PAUSE 1 + JMS I [BACK1 /PUT IT BACK + JMS I [EXPR /GET PAUSE NUMBER +XPAUZ, PAUSOP +OPAUZ, TAD XPAUZ /OUTPUT PAUSE OPERATOR + JMS I [OUTWRD + JMP I [NEXTST +NOARGP, JMS I [OUTWRD /PUSH 1.0 + TAD [ONE + JMS I [OUTWRD + JMP OPAUZ /GO PUT OPERATOR +READ, JMS I (RDWR /COMPILE READ STMT + 0 +WRITE, JMS I [CHECKC /LOOK FOR E + -305 + JMP I [BADCMD + JMS I (RDWR /COMPILE WRITE + BINWR1-BINRD1 +CKCTLC, 6401 /CHECK FOR CONTROL C + TAD (7600 + KRS + TAD (-7603 /^C + SNA CLA + KSF + JMP I CKCTLC + JMP I (7600 + +XOCTAL, DCA WORD1 /** + DCA WORD2 + DCA WORD3 /STATEMENT NUM LEFT THERE** + DCA WORD5 + DCA WORD6 +XCTAL1, DCA WORD4 + JMS I [DIGIT /GET NEXT DIGIT + JMP ENDOXT /NO DIGITS LEFT + AND [7 /THROW AWAY SOME BITS + DCA TEMP + JMS I (AL1 /MOVE WORD LEFT THREE + JMS I (AL1 + JMS I (AL1 + TAD WORD4 /ADD DIGIT TO WORD4 + TAD TEMP + JMP XCTAL1 /LOOP +ENDOXT, TAD WORD2 /PUT WORDS INTO THE LEFT PLACE + DCA WORD1 + TAD WORD3 + DCA WORD2 + TAD WORD4 + DCA WORD3 + JMP DATAFP /GO STUFF IT AWAY + / DIMENSION, COMMON, REAL + PAGE +DIMENS, JMS I [IFCHEK + JMS I [CHECKC /CHECK FOR "N" + -316 + JMP I [BADCMD /NO GOOD + JMS I [TYPLST /PROCESS LIST + 0000 /DIMENSION IS THE SIMPLEST CASE + 0000 + NOP /ERROR RETURN + JMP I [NEXTST +REAL, JMS I [IFCHEK /CHECK FOR INSIDE IF + JMS I [TYPLST /PROCESS LIST + 0102 /TYPE-REAL + 0100 + NOP + JMP I [NEXTST +COMPLE, JMS I [CHECKC /CHECK FOR "X" + -330 + JMP I [BADCMD + JMS I [IFCHEK + JMS I [TYPLST /PROCESS COMPLEX LIST + 0103 + 0100 + NOP + CLA IAC /SET DP SWITCH + DCA DPUSED + JMP I [NEXTST +COMMON, JMS I [IFCHEK /BAD INSIDE LOGICAL IF + JMS I [GETC /CHECK FOR SLASH + JMP I [BADCMD + TAD M257 + SZA CLA + JMP BLANKC /MUST BE BLANK COMMON + JMS I [GETNAM /GET NAME OF COMMON + JMP DBLSLS /MIGHT BE // + JMS I [CHECKC /LOOK FOR / +M257, -257 + JMP BADCOM + JMS I [LOOKUP /LOOKUP COMMON NAME + IAC + DCA COMNAM /SAVE ADDR OF TYPE WORD + CDF 10 + TAD I COMNAM /LOOK AT TYPE + SZA + TAD (-111 /MUST BE COMMON OR UNDEF. + SZA CLA + JMP BADCOM + TAD (111 /SET CORRECT BITS + DCA I COMNAM + CDF +DOCOMN, JMS I [TYPLST /HANDLE LIST + 4000 + 5460 + JMP I [NEXTST + TAD X12 + DCA STACK /RESET STACK + CDF 10 + ISZ COMNAM /POINTER TO COMMON INFO + DCA I NEXT /ZERO NEXT PTR WORD + TAD I COMNAM /LOOK FOR END OF LIST + SNA + JMP EOCL /THIS IS IT + DCA COMNAM /PROCEED DOWN LIST + JMP .-4 +EOCL, TAD NEXT /HOOK IN NEXT PART + DCA I COMNAM + TAD NUMELM + DCA I NEXT /NUMBER IN THIS PART + TAD NUMELM + CIA + DCA NUMELM + CDF + TAD I X12 /MOVE VARIABLE PTRS + CDF 10 + DCA I NEXT + ISZ NUMELM + JMP .-5 + CDF + JMS I [GETC /ANOTHER BLOCK ? + JMP I [NEXTST /NO + JMP COMMON+3 /MAYBE +DBLSLS, JMS I [CHECKC /LOOK FOR SECOND SLASH + -257 + JMP BADCOM + SKP +BLANKC, JMS I [BACK1 /PUT BACK NON SLASH + TAD (BLNKCN /USE BLANK COMMON + DCA COMNAM + JMP DOCOMN +BADCOM, JMS I [ERMSG /ERROR IN COMMON STMT + 0317 + JMP I [NEXTST +COMNAM, 0 + / EXTERNAL, FORMAT, BACKSPACE +EXTERN, JMS I [TYPLST /PROCESS LIST + 1000 + 6660 + NOP + JMP I [NEXTST +FORMAT, TAD (FMTOPR /OUTPUT FORMAT OPERATOR + JMS I [OUTWRD + TAD NCHARS /GET NUMBER OF WORDS + CIA + CLL RAR /NWORDS=(NCHARS+1)/2 +FMTLUP, JMS I [OUTWRD /OUTPUT IT + JMS I [GETCWB /GET THE CHARS + JMP I [NEXTST /NO MORE + AND [77 + CLL RTL /SHIFT LEFT 6 + RTL + RTL + DCA TEMP + JMS I [GETCWB /GET OTHER HALF + NOP /IGNORE END OF LINE + AND [77 + TAD TEMP /PUT THEM TOGETHER + JMP FMTLUP /LOOP + /NOTE : THE ENTIRE FORMAT INCLUDING PARENTHESIS () + / IS PASSED TO THE CODE +BACKSP, JMS I [CHECKC /CHECK FOR "E" + -305 + JMP I [BADCMD + JMS I [EXPR /COMPILE UNIT EXPR + JMP I [BADCMD + TAD (BAKOPR /OUTPUT BACKSPACE OPERATOR + JMS I [OUTWRD + JMP I [NEXTST + / OUTPUT ROUTINE + PAGE +OUPTR, OUBUF +OCOUNT, -401 +OUTWRD, 0 /OUTPUT ROUTINE + DCA OWTEMP /SAVE WORD + TAD NOCODE + SZA CLA + JMP I OUTWRD /COOL IT IF NOCODE + ISZ OCOUNT /TEST FOR BUFFER FULL + JMP NOWRIT /STILL SOME ROOM + JMS OUDUMP /DUMP THE BUFFER + TAD OUBLOK-1 /RESET BUFFER PARAMETERS + DCA OUPTR + TAD (-400 + DCA OCOUNT +NOWRIT, TAD OWTEMP /PUT WORD + CDF 10 + DCA I OUPTR /INTO BUFFER + CDF + ISZ OUPTR /MOVE POINTER + JMP I OUTWRD +OULEN, 0 /NUMBER OF BLOCKS LEFT IN HOLE +OUDUMP, 0 /DUMP OUT BUFFER + TAD OULEN /ANY ROOM LEFT ? + SNA + JMP OUERR + IAC + DCA OULEN + JMS I (7607 /CALL SYSTEM HANDLER + 4210 + OUBUF +OUBLOK, 0 + JMP OUERR + ISZ OUBLOK /INCREMENT BLOCK NUMBER + ISZ FILSIZ /ALSO SIZE OF FILE + JMP I OUDUMP +OUERR, JMS I [MESSAG /ERROR IN WRITING OR OPENING FILE + 317 + 306 + / END PASS ONE +XEND, JMS I [CHECKC /LOOK FOR "D" + -304 + JMP I [BADCMD + JMS I [GETC /END MUST BE ALL + JMP ENDX +L7700, SMA CLA /NEVER SKIPS + JMP I [BADCMD +ENDX, CDF 0 + TAD (ENDOPR /OUTPUT END OF FILE + JMS I [OUTWRD + JMS OUDUMP /DUMP BUFFER + CIF 10 + JMS I L7700 /LOCK MONITOR IN + 10 + CIF 10 + CLA IAC + JMS I L200 /CLOSE TEMP FILE + 4 + TMPFIL +FILSIZ, 0 + JMP OUERR + CIF 10 + CLA IAC + JMS I L200 /OPEN PASS 2 OUTPUT FILE +L3, 3 +OBLK, TMPFIL+4 /STARTING BLOCK + 0 /SIZE + JMP OUERR /ERROR + TAD (COMREG-1 /SAVE IMPORTANT STUFF + DCA X10 + TAD NEXT /ADDR OF FREE SPACE + DCA I X10 + TAD STKLVL /STACK LEVEL + DCA I X10 + TAD OUFILE /START OF PASS1 OUTPUT FILE + DCA I X10 + TAD FILSIZ /ALSO THE SIZE + DCA I X10 + TAD PASS2O /START OF PASS2 OVERLAY + DCA I X10 + TAD OBLK /START OF PASS2 OUTPUT FILE + DCA I X10 + TAD OBLK+1 /AND MAX SIZE + DCA I X10 + TAD PROGNM /POINTER TO PROG NAME + DCA I X10 + TAD ARGLST /AND ARG LIST + DCA I X10 + TAD FUNCTN /AND PROG SWITCH + DCA I X10 + TAD DPUSED /STORE THE DP SWITCH + DCA I X10 + TAD VERS /AND THE VERSION NUMBER + DCA I X10 + CIF 10 + JMS I L200 /CHAIN TO PASS TWO + 6 +PASS2B, 0 /FILLED BY ONCE ONLY CODE FOR PASS 1 +RETURN, TAD (RETOPR /OUTPUT RETURN CODE + JMS I [OUTWRD + ISZ DOEND /DO END ILLEGAL HERE + JMP I [NEXTST +COMARP, 0 /LOOK FOR COMMA OR RIGHT PAREN + JMS I [GETC + JMP I COMARP + TAD [-254 /COMMA ? + SNA + JMP .+5 + TAD L3 /RIGHT PAREN ? + SZA CLA + JMP I COMARP + ISZ COMARP + ISZ COMARP /COMMA INCR ONCE + JMP I COMARP +LOGICA, JMS I [CHECKC /LOOK FOR L + -314 + JMP I [BADCMD /NO GOOD + JMS I [TYPLST /PROCESS LIST + 0105 + 0100 +L200, 0200 /NOP + JMP I [NEXTST + / EQUIVALENCE (UGH!) + PAGE +EQUIV, JMS I [IFCHEK /BAD WITH IF + JMS I [CHECKC /LOOK FOR "E" + -305 + JMP I [BADCMD +EQVLUP, JMS I [CHECKC /LOOK FOR ( + -250 + JMP BADEQU + TAD STACK /SAVE STACK POS + DCA X17 + DCA NSLAVE /NUMBER OF SLAVES = 0 + JMS I [GETSS /GET THE MASTER + JMP BADEQU +SVMSTR, CDF 10 /1.03/ CHECK FOR ALREADY EQUIVALENCED + TAD I TEMP2 /1.03/ + CDF /1.03/ + AND (200 /1.03/ (AS A SLAVE) + SZA CLA /1.03/ + JMP DOFUNY /3.01/BACK UP TO ITS MASTER + TAD TEMP2 /SAVE THE MASTER TYPE ADDRESS + DCA MASTER + DCA SFUDGE /3.01/CLEAR OFFSET FUDGE + TAD DIMNUM /SAVE THE MASTER SUBSCRIPT + DCA MNUM +GETSLV, JMS I [COMARP /LOOK FOR , OR ) + JMP BADEQU + JMP DOSLAV /, + TAD NSLAVE /COMPLEMENT THE NUMBER OF SLAVES + SNA + JMP ENDGRP /NO SLAVES + CIA + DCA NSLAVE + TAD X17 /RESTACK THE STORE + DCA STACK +EQLOOP, TAD I X17 /GET NEXT SUBSCRIPT NUMBER + DCA TEMP + TAD I X17 /AND NEXT TYPE WORD ADDRESS + DCA TEMP2 + CDF 10 + TAD I TEMP2 /LOOK AT TYPE WORD + TAD (200 /SET EQUIVALENCE BIT + DCA I TEMP2 + ISZ TEMP2 /MOVE TO EQUIVALENCE/DIMENSION PTR + TAD I TEMP2 /PROPAGATE DIMENSION POINTER + DCA I NEXT /TO EQUIVALENCE INFO BLOCK + TAD NEXT /NOW STORE EQ INFO BLK ADDRESS + DCA I TEMP2 /INTO EQ-DIM POINTER WORD + CLA CMA + TAD MASTER /STORE S.T. ADDR OF MASTER + DCA I NEXT /INTO THE EQUIVALENCE BLOCK + TAD MNUM /OUTPUT NUMBERS + DCA I NEXT + TAD TEMP + DCA I NEXT + CDF + ISZ NSLAVE /ANY MORE SLAVES ? + JMP EQLOOP /YES, EQUIVALENCE NOT YET ATTAINED +ENDGRP, JMS I [GETC /FINI, ALL VARIABLES ARE CREATED + JMP I [NEXTST /EQUIVALENCED + TAD (-254 /IS NEXT CHAR A COMMA ? + SNA CLA + JMP EQVLUP /IF YES, DO NEXT GROUP +BADEQU, JMS I [ERMSG /SYNTAX ERROR IN EQUIVALENCE + 2123 + JMP I [NEXTST +EQUCOM, JMS I [ERMSG /MULTIPLE LEVELS OF EQUIVALENCE OR + 2114 /MORE THAN ONE COMMON VARIABLE + JMP I [NEXTST +DOSLAV, ISZ NSLAVE /ANOTHER SLAVE VARIABLE + JMS I [GETSS /GET THE GOODS + JMP BADEQU + CDF 10 + TAD I TEMP2 /LOOK AT THE TYPE + SMA CLA + JMP SVSLAV /IT ISN'T IN COMMON + TAD I MASTER /LOOK AT THE MASTERS TYPE + SPA CLA + JMP EQUCOM /MASTER IS IN COMMON TOO .. BAD + CDF + TAD MNUM /SAVE THE MAGIC NUMBER + JMS I [PUSH + TAD MASTER + JMS I [PUSH /AND THE S.T. ADDRESS + JMP SVMSTR /NOW GO MAKE THE NEW ONE MASTER +SVSLAV, TAD I TEMP2 /1.03/ PREVIOUSLY EQUIVALENCED ? + AND (200 /1.03/ + SZA CLA /1.03/ + JMP EQUCOM /1.03/ YES, ERROR + TAD DIMNUM /SAVE THE NEW SLAVE + TAD SFUDGE /3.01/ADD OFFSET FUDGE + CDF + JMS I [PUSH + TAD TEMP2 + JMS I [PUSH + JMP GETSLV /AND GO GET THE NEXT SLAVE + +SFUDGE, 0 + /ROUTINE TO HANDLE TRIVIAL CASES OF EQUIVALENCE CHAINING +/THIS WHOLE PAGE IS 3.01 + +DOFUNY, CLA IAC + TAD TEMP2 + DCA MASTER /GET POINTER TO EQUIVALENCE BLOCK + CDF 10 + TAD I MASTER + DCA X12 + CLA IAC + TAD I X12 /GET ADDRESS OF "REAL" MASTER'S + DCA MASTER /TYPE WORD + TAD I X12 + TAD DIMNUM + DCA MNUM /OFFSETS ARE ADDITIVE + TAD I X12 + DCA SFUDGE /SAVE OTHER HALF OF OFFSET TO ADD + CDF /TO SLAVES + JMP GETSLV / (PRAY) + PAGE + / EQUIVALENCE (UGH!) +O1420, 1420 /1.03/ MUST BE FIRST ON PAGE +GETSS, 0 /GET THE LINEARIZED SUBSCRIPT + DCA DIMNUM + JMS I [GETNAM /GET THE VARIABLE + JMP I GETSS + JMS I [LOOKUP + IAC /ADDRESS OF TYPE WORD + DCA TEMP2 + CDF 10 + TAD I TEMP2 + CDF +O200, AND O1420 /1.03/ EXT, STMTFUN, SUBARG ? + SZA CLA + JMP I GETSS + TAD STACK + DCA X12 /SAVE STACK POSITION + DCA TEMP /ZERO NUMBER OF DIMENSIONS + TAD TEMP2 + IAC + DCA EQTEMP /ADDRESS OF EQ-DIM POINTER + JMS I [GETC + JMP I GETSS + TAD (-250 /LOOK FOR ( + SNA CLA + JMP DIMGET-1 /OK + JMS I [BACK1 + JMP RGETSS + DCA DIMNUM /DATA CALLS GETSS WITH AC = 7777 +DIMGET, JMS I (SMLNUM /GET A SUBSCRIPT + CLA CMA + TAD EXPON /SS-1 + JMS I [PUSH /SAVE SS + ISZ TEMP /BUMP COUNT OF SS + JMS I [COMARP /LOOK FOR , OR ) + JMP I GETSS + JMP DIMGET /, + CLA IAC /) + DCA DPRDCT /SET DIMENSION PRODUCT TO 1 + TAD X12 /RESTORE STACK POSITION + DCA STACK + TAD TEMP /COMPLEMENT NUMBER OF SS + CIA + DCA TEMP + CDF 10 + CLL CML RTR /2000 + AND I TEMP2 /HAS VARIABLE BEEN DIMENSIONED ? + SNA CLA + JMP I GETSS /NO, THATS BAD + TAD I EQTEMP /GET ADDRESS OF DIMENSION BLOCK + DCA EQTEMP + TAD I EQTEMP /IS NUMBER OF DIMENSIONS + TAD TEMP /EQUAL TO NUMBER OF SUBSCRIPTS ? + SZA CLA + JMP TRY1SS /1.03/ SEE IF ITS ONE SUBSCRIPT + CLA CLL IAC /+1 V3C + TAD I EQTEMP /+ NUMBER OF DIMENSIONS + TAD EQTEMP /+ ADDRESS OF COUNT WORD + DCA EQTEMP /GIVES ADDRESS OF NEXT TO LAST DIMENSION +LINEAR, CDF + TAD I X12 /GET NEXT SS - 1 + DCA MQ + TAD DPRDCT /MULTIPLY BY THE DIMENSION PRODUCT + JMS MUL12 /WHERE D.P. = 1,D1,D1D2,D1D2D3,... + TAD DIMNUM /ACCUMULATE THE SUM + DCA DIMNUM + CDF 10 + TAD I EQTEMP /ADDR OF LITERAL + IAC + DCA X11 /WORKING POINTER TO VALUE + TAD I X11 /GET DIMENSION INTO FAC + DCA WORD1 + TAD I X11 + DCA WORD2 + TAD I X11 + DCA WORD3 + CDF + JMS I [FIXNUM /GO FIX IT + DCA MQ + TAD DPRDCT /OF THE D.P. SERIES (ABOVE) + JMS MUL12 + DCA DPRDCT + CLA IAC /V3C BUMP POSITION POINTER + TAD EQTEMP + DCA EQTEMP + ISZ TEMP /ANY MORE SS ? + JMP LINEAR /YES +RGETSS, ISZ GETSS + JMP I GETSS +TRY1SS, CLA IAC /1.03/ + TAD TEMP /1.03/ ONLY ONE SS ? + SZA CLA /1.03/ + JMP I GETSS /1.03/ MORE, THATS NO GOOD + CDF /1.03/ + TAD I X12 /1.03/ GET THE SUBSCRIPT + DCA DIMNUM /1.03/ AND RETURN IT + JMP RGETSS /1.03/ +MUL12, 0 /12 BIT UNSIGNED MULTIPLY + DCA OP2 /SAVE OPERAND + TAD (-15 /SET SHIFT COUNT + DCA SC + JMP STMUL +M12LUP, TAD AC + SNL + JMP .+3 + CLL + TAD OP2 + RAR +STMUL, DCA AC + TAD MQ + RAR + DCA MQ + ISZ SC + JMP M12LUP + TAD MQ /RETURN VALUE + JMP I MUL12 + AC=OP3 + SC=OP4 + / IF STATEMENTS + PAGE +IF, JMS I [EXPR /COMPILE CONDITION EXPRESSION + JMP I [BADCMD + JMS I [STMNUM /IS IT ARITHMETIC IF ? + JMP LOGIF + TAD (ARTHIF /START IF COMMAND + JMS I [OUTWRD + CLL CMA RTL + DCA TEMP + ISZ DOEND /DO END ILLEGAL HERE + JMP IFLABL /GET IF LABELS +IFLOOP, JMS I [CHECKC /LOOK FOR , + -254 + JMP I [NEXTST + JMS I [STMNUM /GET NEXT STMT NUMBER + JMP BADIF +IFLABL, TAD SNUM /OUTPUT LABEL + JMS I [OUTWRD + ISZ TEMP + JMP IFLOOP + JMP I [NEXTST +LOGIF, JMS IFCHEK /IF()IF()... NOT LEGAL + ISZ IFSWIT /CLEAR IF SWITCH + TAD (LIFBGN /START LOGICAL IF + JMS I [OUTWRD + JMP I (COMPIL /COMPILE THE STATEMENT +DOSWT, +IFCHEK, 0 /CHECK IF SWITCH + TAD IFSWIT + SNA CLA + JMP I IFCHEK +BADIF, JMS I [ERMSG + 1111 + JMP I [NEXTST + / CALL STMT +CALL, JMS I [SAVECP /SAVE CHAR POS + JMS I [GETNAM /GET SUBROUTINE NAME + JMP BADCAL /NO NAME HERE IS BAD + JMS I [LOOKUP /GET ADDRESS OF TYPE WORD + IAC + DCA TEMP + CDF 10 + TAD I TEMP /LOOK AT TYPE + AND (6640 /ANYTHING BUT EXT OR ARG ? + SZA CLA + JMP BADCAL /YES, BAD + TAD I TEMP /SET EXT BIT + AND (137 /LEAVE TYPE AND ARG BITS + TAD (1000 + DCA I TEMP + CDF + JMS I [RESTCP /RESTORE CHAR POS + CLA IAC /SIGNAL THAT THIS IS A CALL + JMS I [LEXPR /COMPILE IT +XSTORE, DOSTOR /DON'T WORRY VIRGINIA, ITS A NOP + TAD OWTEMP /WHAT WAS THE LAST THING OUT ? + CLL + TAD (-63 /IF LESS THAN 63 + SNL CLA + JMP I [NEXTST /IT WAS AN ARG COUNT + TAD [ARGSOP /OTHERWISE IT WAS AN ARG LESS CALL + JMS I [OUTWRD /SO TELL PASS 2 ABOUT IT + JMS I [OUTWRD + JMP I [NEXTST +BADCAL, JMS I [ERMSG + 2316 + JMP I [NEXTST + / DO DAH, DO DAH +DO, JMS I [IFCHEK /IF(...)DO IS ILLEGAL + JMS I [STMNUM /LOOK FOR ENDING STMT NUMBER + JMP I [BADCMD + JMS I [GETNAM /LOOKUP INDEX VARIABLE + JMP I [BADCMD + JMS I [LOOKUP + DCA DOINDX + JMS I [CHECKC /LOOK FOR = + -275 + JMP I [BADCMD + ISZ DOEND /CAN'T END DO LOOP ON A DO + JMS DOSTUF /GET DO PARAMETERS + JMP BADDO + TAD DOINDX /PUSH DO INDEX + JMS I [PUSH + TAD SNUM /PUSH ENDING STMT NUMBER + JMS I [PUSH + TAD STACK + DCA STKLVL /SAVE NEW STACK BASE + JMP I [NEXTST + +DOSTUF, 0 /SUBR FOR DO LOOP STUFF + JMS I [OUTWRD /OUTPUT DO INDEX + TAD DOINDX + JMS I [OUTWRD + JMS I [EXPR /GET EXPR FOR INITIAL VALUE + JMP I DOSTUF + TAD XSTORE /YES + JMS I [OUTWRD + JMS I [CHECKC /LOOK FOR COMMA +N254, -254 + JMP I DOSTUF + JMS I [EXPR /GET EXPR FOR FINAL VALUE + JMP I DOSTUF + JMS I [GETC /LOOK FOR A COMMA + JMP STEP1 /USE STEP OF 1 + TAD N254 + SZA CLA + JMP STEP1-1 + JMS I [EXPR /GET EXPR FOR STEP + JMP I DOSTUF +DORET, ISZ DOSTUF + TAD (DOBEGN /DO BEGIN OPERATOR + JMS I [OUTWRD + JMP I DOSTUF + JMS I [BACK1 /PUT BACK NON , (OFFICER BELOW LT.) +STEP1, JMS I [OUTWRD /OUTPUT A PUSH 1.0 + TAD (ONE + JMS I [OUTWRD + JMP DORET /FINISH DO STUFF +BADDO, JMS I [ERMSG /BAD DO COMMAND + 0417 + JMP I [NEXTST +BDERR, JMS I [ERMSG /ILLEGAL IN BLOCK DATA + 0223 + JMP I [NEXTST + / TYPE STATEMENT SUBROUTINE + PAGE +TYPLST, 0 /HANDLE LIST FOR TYPE DELL + TAD STACK + DCA X12 /SAVE STACK POINTER + DCA NUMELM + TAD I TYPLST /GET SET BITS + DCA SETBIT + ISZ TYPLST + TAD I TYPLST /AND ILLEGAL BITS + DCA BADBIT + ISZ TYPLST +LSTLUP, JMS I [GETNAM /GET VARIABLE + JMP BADLST + JMS I [LOOKUP /S.T. SEARCH + DCA TLTEMP /SAVE VAR ADDRESS + TAD TLTEMP /PUT IT ON THE STACK + ISZ TLTEMP /NOW POINT TO TYPE WORD + JMS I [PUSH /INCREMENT NUMBER + ISZ NUMELM /INCREMENT NUMBER + CDF 10 + TAD I TLTEMP /COMPARE TYPES + AND BADBIT /CHECK FOR ILLEGAL BITS + SZA CLA + JMP TYPAGN /ATTEMPT TO RE-TYPE + TAD SETBIT /GET SET BITS + CMA /GENERATE MASK + AND I TLTEMP + TAD SETBIT /DO THE SET + DCA I TLTEMP /BUT NOT DIMENSION BIT + CDF +GETDIM, JMS I [GETC + JMP EOL + TAD (-250 /LOOK FOR ( + SZA + JMP NOTDIM /NOT DIMENSIONED + CLA IAC /INITIALIZE MAGIC NUMBER + DCA DSERES + CLA IAC + DCA DPRDCT /AND DIMENSION PRODUCT + TAD STACK + DCA X17 /SAVE STACK POINTER + DCA TEMP2 /DIMENSION COUNT=0 + JMP I (DIMLUP /GET DIMENSIONS +PUTDIM, TAD X17 + DCA STACK /RESTORE STACK + CDF 10 + TAD (3400 /DIM, EXT, SF ? + AND I TLTEMP + SZA CLA + JMP DIMAGN /ATTEMPT TP RE-DIMENSION + CLL CML RTR + TAD I TLTEMP /SET DIMENSION BIT + DCA I TLTEMP + ISZ TLTEMP + TAD TEMP2 /NUMBER OF DIMS. + DCA I NEXT + TAD I TLTEMP /GET EQUIVALENCE POINTER + SZA + DCA TLTEMP + TAD NEXT /STORE POINTER TO + DCA I TLTEMP /DIMENSION INFORMATION + TAD DPRDCT /SAVE DIM PRODUCT + DCA I NEXT + TAD DSERES /AND MAGIC NUMBER + DCA I NEXT + DCA I NEXT /ZERO MAGIC LITERAL POINTER + TAD TEMP2 + CIA + DCA TEMP2 /LEAVE LAST DIM + CDF +MOVDIM, TAD I X17 /1.03/ GET THE DIMENSION + CDF 10 /1.03/ + DCA I NEXT /1.03/ INTO THE DIMENSION INFO BLOCK + CDF /1.03/ + ISZ TEMP2 /1.03/ + JMP MOVDIM /1.03/ +NEXTEL, JMS I [GETC /LOOK FOR , + JMP TLRETN + TAD (-254 + SNA CLA + JMP LSTLUP /OK, GET NEXT MEMBER +ENDLST, JMS I [BACK1 + ISZ TYPLST + JMP I TYPLST +BADDIM, JMS I [ERMSG /DIMENSION ERROR + 0204 + JMP I TYPLST +BADLST, JMS I [ERMSG /ERROR IN LIST + 2404 + JMP I TYPLST +TYPAGN, JMS I [ERMSG + 2224 /RE-TYPE + JMP GETDIM +DIMAGN, JMS I [ERMSG /ATTEMPT TO RE DIMENSION + 2204 + JMP NEXTEL +NOTDIM, TAD (250-254 /IS IT A COMMA? + SZA CLA + JMP ENDLST + JMP LSTLUP /GET NEXT ELEMENT +EOL, +TLRETN, ISZ TYPLST + JMP I TYPLST /TAKE OK EXIT +ENDFIL, JMS I [CHECKC /LOOK FOR "E" + -305 + JMP I [BADCMD + JMS I [EXPR /COMPILE UNIT + JMP I [BADCMD + TAD (ENDFOP /OUTPUT ENDFILE OPERATOR + JMS I [OUTWRD + JMP I [NEXTST +DOUBLE, JMS I [CHECKC /LOOK FOR N + -316 + JMP I [BADCMD + + JMS I [IFCHEK /NOT ON AN IF + JMS I [TYPLST /PROCESS LIST + 0104 + 0100 + NOP + CLA IAC /SET THE DP SWITCH + DCA DPUSED + JMP I [NEXTST + / SYMBOL TABLE LOOKERUPPER + PAGE +LOOKUP, 0 /SYMBOL TABLE LOOKUP FOR VARIABLE ENTRY + TAD NOCODE /IS THIS IN NOCODE MODE ? + SZA CLA + JMP I LOOKUP /YES, DO NOTHING + TAD BUCKET + TAD (ALIST-1 /GET START OF CORRECT BUCKET + CDF 10 +LOOK, DCA OLDN3 /SAVE ADDR OF PREVIOUS ENTRY + TAD I OLDN3 /GET ADDR OF NEXT ENTRY + SNA + JMP HOOKIN /NO NEXT ENTRY, ATTACH NEW ENTRY + TAD (2 /SKIP OVER TYPE AND DIM POINTER + DCA X10 + TAD (NAME1 + DCA PNAME /SETUP POINTER TO NAME + CDF +CHKNAM, TAD I PNAME /GET WORD NAME + CIA CLL + CDF 10 + TAD I X10 /COMPARE WITH THIS ENTRY + SZA CLA + JMP NOTSAM /DIFFERENT + CDF + TAD I PNAME + AND [77 /WAS THIS THE END OF NAME? + ISZ PNAME + SZA CLA + JMP CHKNAM /NO, KEEP COMPARING + CDF 10 +RLOOKU, TAD I OLDN3 /GET ADDR OF START OF ENTRY + CDF /AND RETURN IT IN THE AC + JMP I LOOKUP /RETURN ADDR OF SYMBOL +NOTSAM, SZL + JMP HOOKIN /NEW SYMBOL .NOT. + JMP .+3 /.TRUE. + TAD (NOTOPR /FALSE=.NOT.TRUE + JMS I [PUSH + JMS I [OUTWRD + TAD (TRUE + JMS I [OUTWRD + JMP I (NOSS +CKNOT, TAD BUCKET + TAD (-16 + SZA CLA + JMP OPRAND /MIGHT BE LITERAL .XXXXXX + TAD (NOTOPR /PUSH .NOT. OPERATOR + JMS I [PUSH + JMP UNOPR +UMINUS, TAD (UMOPR /PUSH UNARY MINUS + JMS I [PUSH + JMP UNOPR +OPRAND, JMS I [BACK1 /PUT BACK NON UNARY OPERATOR + JMS I [GETNAM /LOOK FOR VARIABLE REFERENCE + JMP NOTVAR /NOPE. + JMS I [LOOKUP /SYMBOL TABLE SEARCH + JMP I [OPR8R /GO OUTPUT PUSH-VAR +NOTVAR, JMS I [NUMBER /LOOK FOR A LITERAL + JMP NOTNUM /NO KIND OF NUMBER + JMP HOLCHK /INTEGER + JMP DPLIT /DOUBLE PRECISION +FPLIT, JMS I [LUKUP2 /FLOATING, ENTER INTO TABLE + FPLIST + -3 + JMP I [OPR8RL /PUSH VARIABLE, NO SUBSCRIPTS +DPLIT, JMS I [LUKUP2 /DOUBLE-PREC., ENTER IN TABLE + DPLIST + -6 + JMP I [OPR8RL +HOLCHK, JMS I [GETC /IS THIS HOLLERITH? + JMP .+5 + TAD (-310 + SNA CLA + JMP I (HFIELD /YES + JMS I [BACK1 + JMS I [LUKUP2 /FIND THE ENTRY + INTLST + -3 + JMP I [OPR8RL +NOTNUM, JMS I [GETC /LOOK FOR COMPLEX LITERAL + JMP MISARG /MISSING OPERAND + TAD (-250 /OPEN PAREN? + SZA + JMP QUOTE /GO LOOK FOR A STRING + JMS I [SAVECP /SAVE CHAR POSITION + JMS I [NUMBER /GET REAL PART + JMP I (NCMPLX /NO NUMBER + SKP /INTEGER-OK + JMP I (NCMPLX /DOUBLE-NOT LEGAL FOR COMPLEX + JMS I [CHECKC /LOOK FOR , + -254 + JMP I (NCMPLX /NO, CAN'T BE COMPLEX LIT. + TAD WORD1 /SAVE REAL PART + DCA TEMP + TAD WORD2 + DCA TEMP2 + TAD WORD3 + DCA CHAR + JMS I [NUMBER /GET IMAGINARY PART + JMP BADCL /NOT THERE, BAD + SKP /I + JMP BADCL /D-BAD + JMS I [CHECKC /LOOK FOR ) + -251 + JMP BADCL /NO ) BAD + TAD WORD1 /PUT IMAGINARY PART + DCA WORD4 + TAD WORD2 /INTO SECOND AHLF + DCA WORD5 + TAD WORD3 /OF COMPLEX LITERAL + DCA WORD6 + TAD TEMP /NOW RESTORE REAL PART + DCA WORD1 + TAD TEMP2 + DCA WORD2 + TAD CHAR + DCA WORD3 + CLL CMA RAL /REMOVE CHAR POS FROM STACK + TAD STACK /SINCE OTHERWISE IT GOES OUT + DCA STACK /AS CODE + JMS I [LUKUP2 /WHICH WE WILL NOW SEARCH + CMPLST /USE COMPLEX LIST + -6 + JMP I [OPR8RL +BADCL, JMS I [ERMSG /BAD COMPLEX LITERAL + 0314 + JMP I [BADEXP +MISARG, JMS I [ERMSG /MISSING OPERAND + 1517 + JMP I [BADEXP + / EXPRESSION ANALYZER + PAGE +HQUOTE, 0 /SUBR FOR QUOTE STRINGS + JMS I [GETCWB /GET CHAR + JMP BADH + TAD [-247 /IS IT ' + SZA + JMP NOTQ2 /NO + JMS I [GETCWB + JMP LUHOL + TAD [-247 /LOOK FOR '' + SNA CLA + JMP NOTQ2 /REPLACE '' BY ' + JMS I [BACK1 /ITS END OF STRING + JMP LUHOL +NOTQ2, TAD [247 /RESTORE CHAR + AND [77 + JMP I HQUOTE +HFIELD, JMS I [FIXNUM /INTEGERIZE NUMBER + SNA + JMP BADH /ZERO IS BAD + CMA CLL + DCA TEMP + TAD (HCOUNT /SET SUBR POINTER +DOHOL, DCA HCHAR + TAD (-MAXHOL /SET COUNTER FOR MAX + DCA HOLCTR + TAD (NAME1 /SET UP NAME POINTER + DCA TEMP2 +PAKHOL, DCA I TEMP2 /PACK HOLLERITH STRING + JMS I HCHAR + CLL RTL + RTL + RTL + DCA I TEMP2 + JMS I HCHAR + TAD I TEMP2 + DCA I TEMP2 + ISZ TEMP2 + ISZ HOLCTR /CHECK FOR TOO MANY + JMP PAKHOL +BADH, JMS I [ERMSG /BAD OR TOO BIG HOLLERITH FIELD + 1017 + JMP I [BADEXP +LUHOL, TAD (33 /LOOK UP THIS LITERAL + DCA BUCKET + JMS I [LOOKUP + JMP I [OPR8RL +HCOUNT, 0 + ISZ TEMP /CHECK COUNT + SKP + JMP LUHOL /EXPIRED + JMS I [GETCWB /GET CHAR + JMP BADH + AND [77 /6-BIT IZE IT + JMP I HCOUNT +HOLCTR, 0 /COUNTER FOR HOLLERITH FIELDS +NCMPLX, JMS I [RESTCP /NOT COMPLEX LITERAL + JMS I [EXPR /MUST BE SUB EXPRESSION + JMP BADEXP + JMS I [GETC /LOOK FOR ) + JMP PARMM + TAD (-251 + SNA CLA + JMP I (NOSS /NO SUBSCRIPT LEGAL AFTER SUB EXPR +PARMM, JMS I [ERMSG /MISSING ) + 1515 +BADEXP, JMS I [POP /BAD EXPRESSION, + SZA CLA + JMP BADEXP /LOOK FOR STACK MARKER + JMS I [POP + DCA TEMP /RETURN ADDR. + JMP I TEMP + JMS I [BACK1 /PUT BACK TEMINAL CHAR +ENDEXP, JMS I [POP /GET NEXT THING FROM STACK + SNA + JMP EXPDUN /IF ZERO, FINISH + IAC /GET ADDR OF OPERATION NUMBER + DCA TEMP + TAD I TEMP /GET OPERATOR VALUE + JMS I [OUTWRD /OUTPUT OPERATOR XXXXXX + JMP ENDEXP /LOOP +EXPDUN, JMS I [POP /GET RETURN ADDR + IAC + DCA TEMP + JMP I TEMP +LETTER, 0 /GET A LETTER + JMS I [GETC + JMP I LETTER + TAD (-301 + SPA + JMP NLETR + TAD (301-333 + SMA + JMP NLETR + TAD (33 + ISZ LETTER + JMP I LETTER +NLETR, JMS I [BACK1 + JMP I LETTER +QUOTE, TAD (250-247 /IS IT ' + SZA + JMP MISARG /NO, OPERAND IS MISSING + TAD (HQUOTE /SET SUBR POINTER + JMP DOHOL +CHECKC, 0 /CHECK FOR A SINGLE CHAR + TAD I CHECKC /GET THE CHAR + DCA CCTEMP + ISZ CHECKC /SKIP PAST THE CHAR + JMS I [GETC /GET CHAR FROM INPUT + JMP I CHECKC /DIDN'T MAKE IT + TAD CCTEMP /IS THIS IT ? + SNA CLA + ISZ CHECKC /YES + JMP I CHECKC +CCTEMP, 0 + / EXPRESSION ANALYZER + PAGE +BADFSS, JMS I [ERMSG + 2323 + JMP I [BADEXP +OPR8R, DCA TEMP + JMS I [OUTWRD /PUSH + TAD TEMP + JMS I [OUTWRD /OUTPUT OPERAND PTR + JMS I [GETC + JMP I [ENDEXP + TAD (-250 /IS IT S.S. OR FUNCTION + SZA + JMP NOTFSS + TAD STMJMP + TAD (-DFINFL + SNA CLA /FOR D.F.,PERMIT VARPARENS + JMP NOTFSS + ISZ TEMP /LOOK AT TYPE + CDF 10 + TAD (3420 /DIM, EXT, SF, OR ARG ? + AND I TEMP + SZA CLA + JMP NOTFUN /NOT A FUNCTION REFERENCE + TAD I TEMP + TAD (1000 /SET EXT BIT + DCA I TEMP +NOTFUN, CDF + SKP + JMS I [POP /PUT COUNT INTO AC +SSFUN, IAC /INCREMENT ARG COUNT + JMS I [PUSH /SAVE IT ON THE STACK + JMS I [EXPR /GET ARG (OR S.S.) + JMP I [BADEXP + JMS I [COMARP /LOOK FOR , OR ) + JMP BADFSS /NEITHER + JMP SSFUN-1 /, GET NEXT ARG (SUBSCRIPT?) + TAD (ARGSOP /YES, OUTPUT ARGLIST OPER + JMS I [OUTWRD + JMS I [POP /AND THE COUNT + JMS I [OUTWRD +NOSS, JMS I [GETC /GET NEXT CHAR + JMP I [ENDEXP + TAD (-253 /PREPARE IT + JMP NOTFSS+1 +OPR8RL, DCA TEMP /SAVE ADDR OF LITERAL + JMS I [OUTWRD + TAD TEMP + JMS I [OUTWRD + JMP NOSS + / TYPLST PART TWO +DIMLUP, JMS I [NUMBER /GET DIMENSION + JMP VARDIM /MAYBE ITS VAR DIM ? + JMP .+3 /OK, INTEGER + JMP BADDIM + JMP BADDIM /DP AND FP ARE BAD + JMS I [FIXNUM /FIX IT FOR SOME STUFF + DCA MQ + TAD DPRDCT /GET NEW DIMENSION PRODUCT + JMS I [MUL12 + DCA DPRDCT + ISZ TEMP2 /INCREMENT DIM COUNT + TAD WORD2 /IF WORD2 OR AC NON ZERO + TAD AC /DIM IS TOO BIG + SZA CLA /1.03/ + JMP BADDIM /1.03/ + JMS I (ANORM /1.03/ RENORMALIZE THE NUMBER + JMS I [LUKUP2 /1.03/ ENTER IT INTO LITERAL LIST + INTLST /1.03/ + -3 /1.03/ +PSHDIM, JMS I [PUSH /1.03/ AND SAVE ON THE STACK + JMS I [COMARP /LOOK FOR , OR ) + JMP BADDIM + SKP /COMMA MEANS ANOTHER DIM FOLLOWS + JMP PUTDIM /) MEANS END OF DIMS + TAD DSERES /FORM NEXT VALUE OF MAGIC NUMBER + TAD DPRDCT + DCA DSERES + JMP DIMLUP /NOW LOOP FOR NEXT DIM +VDTEMP, 0 +VARDIM, CDF 10 /IS ARRAY AN ARG ? + TAD I TLTEMP + CDF + AND (20 + SNA CLA + JMP BADDIM /NO, BAD DIMENSION + JMS I [GETNAM /OK, GET DIMENSION + JMP BADDIM + JMS I [LOOKUP + IAC + DCA VDTEMP /ADDR OF TYPE WORD + CDF 10 /IS THA VARIABLE AN ARG ? + TAD I VDTEMP + AND (20 + CDF + SNA CLA + JMP BADDIM /NO, THATS BAD + DCA DPRDCT /3.02 ZERO DIM PRODUCT + ISZ TEMP2 /INCREMENT DIM COUNT + CMA /1.03/ + TAD VDTEMP /1.03/ SAVE DIMENSION VARIABLE + JMP PSHDIM /3.02 SAVE DIM ON STACK +MESSAG, 0 /PRINT PASS1 IMMEDIATE ERROR + TAD I MESSAG /GET CHAR ONE + ISZ MESSAG + JMS I (TTYOUT + TAD I MESSAG /GET CHAR TWO + JMS I (TTYOUT + TAD (215 /CR + JMS I (TTYOUT + TAD (212 /LF + JMS I (TTYOUT + JMP I (7605 /EXIT TO MONITOR + / EXPRESSION ANALYZER REVISITED + PAGE +NOTFSS, TAD (250-253 /IS IT + + SZA + JMP .+3 + TAD (ADDOPR /YES + JMP GOTOPR + TAD (253-255 /IS IT - + SZA + JMP .+3 + TAD (SUBOPR /YES + JMP GOTOPR + TAD (255-252 /IS IT * + SZA + JMP NOTMUL /NO + JMS I [GETC + JMP NOTEXP + TAD (-252 /IS IT ** + SZA CLA + JMP .+3 + TAD (EXPOPR /YES + JMP GOTOPR + JMS I [BACK1 +NOTEXP, TAD (MULOPR /IT WAS * + JMP GOTOPR +NOTMUL, TAD (252-257 /IS IT / + SZA + JMP .+3 + TAD (DIVOPR /YES + JMP GOTOPR + IAC /IS IT . + SZA CLA + JMP I (ENDEXP-1 /NO, END OF EXPR + JMS CKEOPR /LOOK FOR EXTENDED OPERATOR + JMP BADOPR /NONE THERE + JMS I [CHECKC /CHECK FOR CLOSING . + -256 + JMP BADOPR /NOT THERE + CDF 10 /3.01/ + TAD I X10 /GET OPERATOR POINTER + CDF + JMP GOTOPR +CKEOPR, 0 /CHECK FOR EXTENDED OPERATOR + JMS I [GETNAM /GET NAME + JMP I CKEOPR /NONE + TAD (OPRLST-1 /PTR TO LIST + DCA X10 +OPRLUP, CDF 10 /3.01/ + TAD I X10 /COMPARE FIRST CHAR + CDF 0 + SNA + JMP I CKEOPR /END OF LIST + TAD BUCKET + SZA CLA + JMP NOTHIS /NOT THIS ONE + CDF 10 /3.01/ + TAD I X10 + CDF + TAD I (NAME1 /COMPARE 2ND AND 3RD + SZA CLA + JMP NOTHIS+1 /NOT THIS ONE + ISZ CKEOPR /BUMP RETURN + JMP I CKEOPR +NOTHIS, ISZ X10 /BUMP LIST PTR + ISZ X10 /AGAIN + JMP OPRLUP /KEEP GOING +BADOPR, JMS I [ERMSG /NOT LEGAL EXT. OPER. + 1720 + JMP I [BADEXP +GOTOPR, DCA NEWOP /SAVE NEWEST OPER. + JMS I [POP /GET STACK TOP + SNA + JMP PUSH2 /EMPTY + DCA OLDOP + TAD I OLDOP /COMPARE PREC. + CIA + TAD I NEWOP /NEW-OLD + SPA SNA CLA + JMP OUTOLD /OLD>NEW + TAD OLDOP +PUSH2, JMS I [PUSH /OLD < NEW + TAD NEWOP /GO PUSH BOTH + JMS I [PUSH + JMP I (UNOPR /GO LOOK FOR NEXT OPERAND +OUTOLD, ISZ OLDOP /OUTPUT OPERATOR + TAD I OLDOP + JMS I [OUTWRD + JMP GOTOPR+1 /TRY NEXT STACK ELEMENT + NEWOP=WORD1 + OLDOP=WORD2 + / UTILITIES +GETCWB, 0 /GET A CHARACTER (PRESERVE BLANKS) + ISZ NCHARS + JMP .+4 + CLA CMA + DCA NCHARS /RESET NCHARS + JMP I GETCWB + ISZ GETCWB + TAD I CHRPTR /GET THE CHAR + JMP I GETCWB +SAVECP, 0 /SAVE CHAR POSITION + TAD NCHARS + JMS I [PUSH + TAD CHRPTR + JMS I [PUSH + JMP I SAVECP +FIXNUM, 0 /FIX FAC (I'M MOVING IT AGAIN) + TAD WORD1 /IS IT FIXED ? + TAD (-27 + SNA + JMP RETFN /YES, EXPONENT IS 23 + SMA CLA + JMP I FIXNUM /BAD IF EXP IS >23 + JMS I (AR1 /RIGHT SHIFT ONE + JMP FIXNUM+1 /TEST AGAIN +RETFN, TAD WORD3 /RETURN LOWEST 12 BITS + JMP I FIXNUM + / UTILITIES + PAGE +GETC, 0 /GET A CHARACTER (IGNORING BLANKS) + ISZ NCHARS + JMP .+4 + CLA CMA + DCA NCHARS + JMP I GETC + TAD I CHRPTR + TAD (-240 /IS IT A BLANK + SNA + JMP GETC+1 /YES IGNORE IT + TAD (240 /FIX CHAR + ISZ GETC + JMP I GETC +ERMSG, 0 /ERROR MESSAGE HANDLER + CDF + TAD NOCODE /IS CODE GENERATION ON ? + SZA CLA + JMP NOTOUT /NO + TAD (ERRCOD /ERROR CODE TO OUTPUT FILE + JMS I [OUTWRD + TAD I ERMSG + ISZ ERMSG + JMS I [OUTWRD + JMP I ERMSG /RETURN +NOTOUT, TAD I ERMSG /SAVE THE ERROR CODE + ISZ ERMSG + DCA ERCODE + JMP I ERMSG +POP, 0 /PUT TOP OF STACK INTO AC + TAD STACK + DCA ERMSG + CLA CMA + TAD STACK + DCA STACK /DECREMENT STACK POINTER + TAD I ERMSG + JMP I POP +TRUFAL, 0 /CHECK FOR LOGICAL LITERALS + JMS I [GETNAM + JMP I TRUFAL + JMS I [CHECKC /LOOK FOR TERMINAL . + -256 + JMP I TRUFAL + TAD BUCKET /LOOK AT FIRST CHAR + TAD (-24 + SNA + JMP .+5 /ITS "T" + TAD (24-6 + SZA CLA + JMP I TRUFAL /ITS NEITHER + ISZ TRUFAL /ITS "F" + ISZ TRUFAL + JMP I TRUFAL + / LEFT HALF EXPRESSION ANALYZER +LEXPR, 0 /GET LEFT HAND EXPRESSION + DCA LETEMP /SAVE CALL SWITCH + JMS I [GETNAM /LOOK FOR VAR NAME + JMP MSNGOP /MUST BE THERE + JMS I [OUTWRD /OUTPUT A ZERO (PUSH) + JMS I [LOOKUP /SEEK OUT ENTRY FOR THIS VAR + DCA TEMP + TAD TEMP + JMS I [OUTWRD + JMS I [GETC /LOOK FOR DIMENSIONS + JMP LEXPOK /NO ( + TAD (-250 + SZA CLA + JMP LEXPOK-1 /NO ( + ISZ TEMP /LOOK AT TYPE + CDF 10 + CLL CML RTR /DIMENSIONED ? + AND I TEMP + TAD LETEMP /OR A CALL ? + TAD NOCODE /OR CODE OFF ? + SZA CLA + JMP NOTSF /YES, NOT AN ARITHMETIC S.F. + TAD I TEMP + AND (1420 /EXT, SF, OR ARG ? + SNA CLA /V3C + TAD [-M6 /SEE IF CALLED FROM SPECIAL PLACE + TAD LEXPR /V3C COMPARE WITH ENTRY PT + SZA CLA + JMP ASFERR /THIS IS BAD IF SO + TAD I TEMP + TAD (400 + DCA I TEMP /SET A.S.F. BIT + CDF + TAD (ASFDEF /DEFINE ASF + JMS I [OUTWRD +NOTSF, CDF + SKP + JMS I [POP /ARG COUNT TO AC +SSLOOP, IAC /INCREMENT SS COUNT + JMS I [PUSH /SAVE ON THE STACK + JMS I [EXPR /COMPILE SUBSCRIPT + JMP FSSBAD+2 /ERROR WITHIN SS + JMS I [COMARP /LOOK FOR , OR ) + JMP FSSBAD /NEITHER (THERE WAS A BUG HERE) + JMP SSLOOP-1 /, GET NEXT ARG/SS + TAD (ARGSOP /OUTPUT SS OPERATOR + JMS I [OUTWRD + JMS I [POP /THEN COUNT + JMS I [OUTWRD + SKP + JMS I [BACK1 /PUT BACK A CHARACTER +LEXPOK, ISZ LEXPR + JMP I LEXPR /RETURN +MSNGOP, JMS I [ERMSG /MISSING OPERAND + 1517 + JMP I LEXPR +FSSBAD, JMS I [ERMSG /MISSING COMMA OR CLOSE PARENTHESIS + 2323 + JMS I [POP /GET ARG COUNT OFF STACK + CLA + JMP I LEXPR +ASFERR, JMS I [ERMSG /BAD ARITHMETIC STMT FUNCTION + 2306 + JMP NOTSF /DO THE REST OF THE ASF DEF +LETEMP, 0 + /UTILITIES + PAGE +G2CTMP, +PUSH, 0 /PUT AC ONTO STACK + DCA I STACK /STORE + TAD (STACKS+100 /CHECK FOR STACK OVERFLOW + CIA CLL + TAD STACK + SNL CLA + JMP I PUSH /OK, RETURN + DCA NOCODE /SET CODE GENERATION ON + JMS I [ERMSG + 2004 + JMP I [NEXTST +GET2C, 0 /GET 2 SIX BIT CHARS INTO ONE WPRD + JMS I [GETC /GET FIRST CHAR + JMP I GET2C + AND [77 + CLL RTL + RTL + RTL + DCA G2CTMP + JMS I [GETC /GET SECOND CHAR + JMP I GET2C + ISZ GET2C /FIX RETURN ADDR + AND [77 + TAD G2CTMP + JMP I GET2C +STMNUM, 0 /PICK UP STATEMENT NUMBER + DCA WORD4 /SAVE DEFINED BIT (IF ANY) + DCA WORD2 /ZERO SOME STUFF + DCA WORD3 + JMS DIGIT /GET A DIGIT + JMP I STMNUM /NONE THERE, NO STMT NUMBER + TAD (-60 /IS IT A LEADING 0 ? + SNA + JMP .-4 /YES, IGNORE IT + TAD (60 + CLL RTL + RTL + RTL + DCA WORD1 + JMS DIGIT /GET SECOND DIGIT + JMP ENDNUM /END OF NUMBER + TAD WORD1 + DCA WORD1 /COMBINE FIRST AND SECOND + JMS DIGIT + JMP ENDNUM + CLL RTL + RTL + RTL + DCA WORD2 + JMS DIGIT + JMP ENDNUM /COMBINE THIRD AND FOURTH + TAD WORD2 + DCA WORD2 + JMS DIGIT /GET FIFTH DIGIT + JMP ENDNUM + CLL RTL + RTL + RTL + DCA WORD3 +ENDNUM, JMS I [LUKUP2 /LOOK UP IN S.T. + SNLIST /STMT NUMBER LIST + -3 + ISZ STMNUM + DCA SNUM /SAVE S.T. ADDRESS OF LABEL + CDF 10 /SET TYPE WORD + TAD SNUM /GET ADDR OF TYPE + IAC + DCA SNTEMP + TAD I SNTEMP /GET TYPE WORD + CLL + TAD WORD4 /PUT IN THE DEFINITION BIT + SNL + DCA I SNTEMP /RESTORE IT IF NOT MULTIPLE DEFN + CDF + SNL CLA + JMP I STMNUM + JMS I [ERMSG + 1514 + JMP I STMNUM +SNTEMP, +DIGIT, 0 /GET A DIGIT + JMS I [GETC /GET A CHAR + JMP I DIGIT + TAD (-272 /IS IT > 271 (9) + SMA + JMP NODIGT /YES, ITS GREATER + TAD (272-260 /IS IT < 260 (0) + SPA + JMP NODIGT /YES, ITS LESS + TAD (60 + ISZ DIGIT + JMP I DIGIT /TAKE SUCCESSFUL RETURN +NODIGT, JMS I [BACK1 /RESTORE NON DIGIT + JMP I DIGIT +ASSIGN, JMS I [STMNUM /GET STMT NUMBER + JMP BADASN + JMS I [GET2C /LOOK FOR "TO" + JMP BADASN + TAD (-2417 + SNA CLA + JMS I [LEXPR /GET ASSIGN VARIABLE + JMP BADASN + TAD (ASNOPR /OUTPUT ASSIGN OPERATOR + JMS I [OUTWRD + TAD SNUM /NOW STMT NUMBER + JMS I [OUTWRD + JMP I [NEXTST +BADASN, JMS I [ERMSG + 0123 + JMP I [NEXTST +TTYOUT, 0 /TTY OUTPUT ROUTINE + TLS + TSF + JMP .-1 + CLA + JMP I TTYOUT + / PRECEDENCE TABLE + PAGE +ADDOPR, 100 + 1 +SUBOPR, 100 + 2 +MULOPR, 200 + 3 +DIVOPR, 200 + 4 +EXPOPR, 500 + 5 +NOTOPR, 30 + 6 +UMOPR, 400 + 7 +EQOPR, 40 + 16 +NEOPR, 40 + 17 +GEOPR, 40 + 10 +GTOPR, 40 + 11 +LEOPR, 40 + 12 +LTOPR, 40 + 13 +ANDOPR, 20 + 14 +OROPR, 10 + 15 +XOROPR, 7 + 20 +EQVOPR, 7 + 21 + / UTILITY ROUTINES +BACK1, 0 /BACK UP ONE CHAR + CLA CMA + TAD NCHARS + DCA NCHARS + CLA CMA + TAD CHRPTR + DCA CHRPTR + JMP I BACK1 +OADD, 0 /ADD OPERAND TO FAC + CLL + TAD OPO + TAD ACO + DCA ACO + RAL + TAD OP6 + TAD WORD6 + DCA WORD6 + RAL + TAD OP5 + TAD WORD5 + DCA WORD5 + RAL + TAD OP4 + TAD WORD4 + DCA WORD4 + RAL + TAD OP3 + TAD WORD3 + DCA WORD3 + RAL + TAD OP2 + TAD WORD2 + DCA WORD2 + JMP I OADD + / FLOATING POINT DIVIDE ROUTINE + PAGE +FPDIV, 0 + JMS I DAR1 /UNNORMALIZE AC BY ONE + TAD OP1 /COMPUTE FINAL EXPONENT + CIA + TAD WORD1 + DCA OP1 /AND SAVE IT + TAD DM74 /SET ITERATION COUNTER + DCA DITCNT + TAD WORD2 + RAL /INITIALIZE LINK +FPDVLP, CLA RAR /COMPARE SIGNS + TAD OP2 + SPA CLA + JMP .+3 + TAD OPMAC /NEGATE OPERAND + JMS I DFNEG + JMS I DOADD /ADD OPERAND AND FAC + TAD D6 /RIGHT SHIFT QUOTIENT + RAL /PRESERVING ADD OVERFLOW BIT + DCA D6 + TAD D5 + RAL + DCA D5 + TAD D4 + RAL + DCA D4 + TAD D3 + RAL + DCA D3 + TAD D2 + RAL + DCA D2 + JMS I DAL1 /LEFT SHIFT FAC ONE + ISZ DITCNT /TEST ITERATION COUNT + JMP FPDVLP + TAD OP1 /PUT QUOTIENT INTO FAC + DCA WORD1 + TAD D2 + DCA WORD2 + TAD D3 + DCA WORD3 + TAD D4 + DCA WORD4 + TAD D5 + DCA WORD5 + TAD D6 + DCA WORD6 + DCA ACO + JMS I DNORM /NORMALIZE + JMP I FPDIV +D2, 0 +D3, 0 +D4, 0 +D5, 0 +D6, 0 +DITCNT, 0 +DAR1, AR1 +DAL1, AL1 +DM74, -74 +OPMAC, OPO-ACO +DFNEG, NEGFAC +DOADD, OADD +DNORM, ANORM + *STACKS-1 + -1 /TO PREVENT SPURIOUS DO ENDS + / NUMERIC CONVERSION ROUTINE + PAGE +NUMBER, 0 /GENERAL NUMBER CONVERSION ROUTINE + DCA ESWIT /ZERO E/D SWITCH + DCA DECPT /ZERO DECIMAL POINT SWITCH + DCA WORD1 /ZERO FAC + DCA WORD2 + DCA WORD3 + DCA WORD4 + DCA WORD5 + DCA WORD6 + DCA ACO + DCA SIGN /CLEAR SIGN SWITCH + JMS I [GETC /GET A CHAR + JMP I NUMBER /NO CHAR IS NO NUMBER + JMS CHKSGN /CHECK FOR SIGN +SIGN, 0 /THIS SWITCH GETS SET + DCA NDIGIT /ZERO DIGIT COUNT +CONVLP, JMS I [DIGIT /GET A DIGIT + JMP TRYDEC /IS THERE A DECIMAL POINT ? + AND [17 + DCA NXTDGT /SAVE THE DIGIT + ISZ NDIGIT /INCR NUMBER OF DIGITS + TAD WORD2 /PREPARE TO MULT BY 10 + DCA OP2 + TAD WORD3 + DCA OP3 + TAD WORD4 + DCA OP4 + TAD WORD5 + DCA OP5 + TAD WORD6 + DCA OP6 + TAD ACO + DCA OPO + JMS I (AL1 /DOUBLE FAC + JMS I (AL1 /DOUBLE AGAIN + JMS I (OADD /TIMES FIVE + JMS I (AL1 /ONE MORE DOUBLING IS TIMES 10 + DCA OP2 + DCA OP3 /PUT NEWEST DIGIT INTO OPERAND + DCA OP4 + DCA OP5 + DCA OP6 + TAD NXTDGT + DCA OPO + JMS I (OADD /ADD IN NEWEST DIGIT + JMP CONVLP +TRYDEC, TAD DECPT /DECIMAL ALREADY ? + SZA CLA + JMP TRYE2 /YES, LOOK FOR EXPONENT + JMS I [GETC /LOOK FOR . + JMP DIGTST /SEE IF THERE WAS ANYTHING + TAD (-256 + SZA + JMP TRYE1 /TRY FOR E + JMS I [SAVECP /SAVE CHAR POS + JMS I (CKEOPR /CHECK FOR SPECIAL CASE OF LIT.RE. + JMP NOLDRE /NOT LIT.RE. + JMS I [RESTCP + JMS I [BACK1 /PUT BACK . IT BELONGS TO RELATIONAL +DIGTST, TAD NDIGIT /ANY DIGITS ? + SNA CLA + JMP I NUMBER /NO, NO NUMBER + JMP INTEGR /TAKE INTEGER EXIT +NOLDRE, ISZ DECPT /SET DECIMAL POINT SW + JMS I [RESTCP /RESTORE CHAR POS + JMP CONVLP-1 /LOOP FOR OTHER DIGITS +TRYE1, JMS I [BACK1 /PUT BACK NON . + TAD NDIGIT /ANY DIGITS YET ? + SNA CLA + JMP I NUMBER /NO, NO NUMBER + JMS EORD /LOOK OR E OR D + JMP INTEGR +TRYE2, JMS EORD /LOOK FOR E OR D +FPNUM, ISZ NUMBER + ISZ NUMBER + DCA EXPON /ZERO EXPONENT + JMS I (DODEC /HANDLE DIGITS RIGHT OF . + JMP DOSIGN-1 /GO DO SIGN +INTEGR, TAD (107 /PUT IN EXPONNT + DCA WORD1 + JMS I (ANORM /NORMALIZE + ISZ NUMBER /BUMP RETURN +DOSIGN, TAD SIGN /CHECK THE SIGN + SZA CLA + JMS I (NEGFAC /NEGATE IF NEGATIVE + JMP I NUMBER /RETURN +CHKSGN, 0 /CHECK FOR SIGN + TAD (-255 /IS IT - ? + SNA + ISZ I CHKSGN /YES, SET SWITCH + SZA + TAD (255-253 /IS IT + ? + SZA CLA + JMS I [BACK1 /RETURN CHAR OTHERWISE + JMP I CHKSGN +EORD, 0 /LOOK FOR E OR D + JMS I [GETC /LOOK FOR E OR D + JMP I EORD + TAD (-304 + CLL RAR + SZA CLA /E OR D? + JMP NOEORD /NO + SZL + ISZ ESWIT /SET SWITCH IF E + SNL + ISZ DPUSED /SET D.P. SWITCH IF D + JMP I (GETEXP /OK, GET EXPONENT +NOEORD, JMS I [BACK1 /PUT IT BACK CAUSE ITS NOT OURS + JMP I EORD +NXTDGT, 0 +REWIND, JMS I [EXPR /COMPILE UNIT + JMP I [NEXTST + TAD (REWOPR /OUTPUT REWIND OPERATOR + JMS I [OUTWRD + JMP I [NEXTST + / NUMERIC CONVERSION ROUTINE + PAGE +SMLNUM, 0 /INPUT A NUMBER <= 4095 +EXPLUP, DCA EXPON /ZERO THE EXPONENT + JMS I [DIGIT /GET THE NEXT DIGIT + JMP I SMLNUM /NUMBER DONE + AND [17 + DCA OPO /SAVE THE DIGIT + TAD EXPON /MULT BY 10 + CLL RAL + CLL RAL + TAD EXPON + CLL RAL + TAD OPO /ADD IN DIGIT + JMP EXPLUP /STORE BACK INTO EXPONENT +GETEXP, DCA ESIGN /ZERO EXPONENT SIGN SWITCH + JMS I [GETC /GET A CHAR + JMP I (FPNUM+1 + JMS I (CHKSGN /IS IT A SIGN +FPRTNE, +ESIGN, 0 /THIS IS THE SWITCH TO SET + JMS SMLNUM /GO GET THE EXPONENT +FIXEXP, TAD ESIGN /CHECK EXPONENT SIGN + SNA CLA + JMP .+4 + TAD EXPON /COMPLEMENT EXPONENT + CIA + DCA EXPON + JMS DODEC /GO HANLE EXPONENT + CLL CML RTL /BUMP RETURN BY TWO (DP) OR 3 (FP) + TAD ESWIT /DEPENDING ON E/D SWITCH + TAD I [NUMBER + DCA I [NUMBER + JMP I (DOSIGN /CHECK THE SIGN +DODEC, 0 + TAD DO107 /NORMALIZE THE NUMBER + DCA WORD1 + JMS I (ANORM + TAD DECPT /WAS THERE A DECIMAL POINT ? + SZA CLA + TAD NDIGIT /HOW MANY DIGITS TO THE RIGHT ? + CIA + TAD EXPON /SUBTRACT THAT NUMBER FROM EXP + SMA + JMP POSEXP /EXPONENT IS POSITIVE + CIA + DCA EXPON /ONLY NEED ABS VALUE + TAD (FPDIV /DO DIVIDES + JMP .+3 +POSEXP, DCA EXPON + TAD (FPMUL /DO MULTIPLIES + DCA FPRTNE /MULTIPLY/DIVIDE ROUTINE + TAD (PETABL-1 /POWERS OF TEN TABLE + DCA X17 +EXPMUL, TAD EXPON /LOOK AT THE EXPONENT + SNA + JMP I DODEC /IF 0 ITS THRU + CLL RAR + DCA EXPON /PUT LOWEST BIT INTO LINK + SNL + JMP SKPEXP /THIS ONE DOESN'T COUNT + CDF 10 /3.01/ + TAD I X17 /MOVE FACTOR INTO OPERAND + DCA OP1 + TAD I X17 + DCA OP2 + TAD I X17 + DCA OP3 + TAD I X17 + DCA OP4 + TAD I X17 + DCA OP5 + TAD I X17 + DCA OP6 + DCA OPO + CDF + JMS I FPRTNE /MULTIPLY OR DIVIDE BY THIS FACTOR + JMP EXPMUL /CHECK NEXT BIT +SKPEXP, TAD X17 /SKIP OVER THIS FACTOR + TAD (6 + JMP EXPMUL-1 +AR1, 0 /SHIFT FAC RIGHT ONE + TAD WORD2 + CLL RAR + DCA WORD2 + TAD WORD3 + RAR + DCA WORD3 + TAD WORD4 + RAR + DCA WORD4 + TAD WORD5 + RAR + DCA WORD5 + TAD WORD6 + RAR + DCA WORD6 + TAD ACO + RAR + DCA ACO + ISZ WORD1 +DO107, 107 + JMP I AR1 + +AL1, 0 /SHIFT FAC LEFT ONE + TAD ACO + CLL RAL + DCA ACO + TAD WORD6 + RAL + DCA WORD6 + TAD WORD5 + RAL + DCA WORD5 + TAD WORD4 + RAL + DCA WORD4 + TAD WORD3 + RAL + DCA WORD3 + TAD WORD2 + RAL + DCA WORD2 + JMP I AL1 + / NUMERIC CONVERSION ROUTINE + PAGE +FPMUL, 0 /FLOATING MULTIPLY ROUTINE + TAD WORD1 /COMPUTE NEW EXPONENT + TAD OP1 + DCA OP1 + TAD WORD2 /SAVE AC MANTISSA + DCA TW2 + TAD WORD3 + DCA TW3 + TAD WORD4 + DCA TW4 + TAD WORD5 + DCA TW5 + TAD WORD6 + DCA TW6 + TAD (-74 /SET ITERATION COUNTER + DCA ITRCNT + DCA WORD2 /ZERO FAC MANTISSA + DCA WORD3 + DCA WORD4 + DCA WORD5 + DCA WORD6 + DCA ACO +MULLUP, JMS I (AR1 /SHIFT FAC RIGHT ONE + TAD TW2 /SHIFT MULTIPLIER RIGHT + CLL RAR + DCA TW2 + TAD TW3 + RAR + DCA TW3 + TAD TW4 + RAR + DCA TW4 + TAD TW5 + RAR + DCA TW5 + TAD TW6 + RAR + DCA TW6 + SZL + JMS I (OADD /ADD IF LINK IS ONE + ISZ ITRCNT /BUMP COUNT + JMP MULLUP /LOOP + TAD OP1 /PUT IN CORRECT EXPONENT + DCA WORD1 + JMS I (ANORM /NORMALIZE THE RESULT + JMP I FPMUL +TW2, 0 +TW3, 0 +TW4, 0 +TW5, 0 +TW6, 0 +ANORM, 0 /NORMALIZE FAC + TAD WORD2 /IS MANTISSA 0 ? + SNA + TAD WORD3 + SNA + TAD WORD4 + SNA + TAD WORD5 + SNA + TAD WORD6 + SNA + TAD ACO + SNA CLA + JMP ZEXP /YES, ZERO EXPONENT +NORMLP, CLA CLL CML RTR /IS HIGH ORDER MANTISSA = 6000 + TAD WORD2 + SZA + JMP NO6000 /NO, SKIP THIS STUFF + TAD WORD3 /YES, IS THE REST 0 ? + SNA + TAD WORD4 + SNA + TAD WORD5 + SNA + TAD WORD6 + SNA + TAD ACO + SZA CLA /SKIP IF 600000 ... 0000 +NO6000, SPA CLA + JMP I ANORM /NORM IS DONE WHEN BITS DIFFER + JMS I (AL1 /SHIFT LEFT ONE + CLA CMA /DECREMENT EXPONENT + TAD WORD1 + DCA WORD1 + JMP NORMLP /LOOP +ZEXP, DCA WORD1 + JMP I ANORM +NEGFAC, 0 /NEGATE FAC + TAD (ACO /GET POINTER TO OPERAND + DCA NFPTR + TAD (-6 /SIX WORD NEGATE + DCA NFCNT + CLL +NFLOOP, RAL + TAD I NFPTR /GET NEXT WORD + CLL CML CIA + DCA I NFPTR /RESTORE AFTER COMPLEMENTING + CML CLA CMA /LINK GETS COMPLEMENTED ONCE HERE + TAD NFPTR /AND ONCE AGAIN HERE + DCA NFPTR /RESTORE DECREMENTED POINTER + ISZ NFCNT + JMP NFLOOP + JMP I NEGFAC +NFPTR, 0 +NFCNT, 0 +ITRCNT, +DHLRTH, 0 /HOLLERITH IN DATA SUBR + ISZ TEMP + SKP + JMP I DHLRTH + ISZ DHLRTH + JMS I [GETCWB + JMP DHOLER + JMP I DHLRTH + / VARIABLE SCANNER + PAGE +GETNAM, 0 /GET VARIABLE NAME + JMS LETTER /FIRST CHAR MUST BE ALPHABETIC + JMP I GETNAM /NO VARIABLE + DCA BUCKET /FIRST ONE IS THE BUCKET + TAD (NAME1 + DCA NPTR /POINTER TO NAME BUFFER + CLL CMA RTL /SIX CHARS MAX (3 WORDS) + DCA NCNT +PAKLUP, JMS LETTER /GET A LETTER + SKP + JMP .+3 /WE GOT IT + JMS I [DIGIT /NO LETTER, IS IT A DIGIT ? + JMP NDONE /NO, NAMES OVER + CLL RTL + RTL + RTL /MOVE CHAR TO A HIGHER PLACE + DCA I NPTR /STORE IT + ISZ NCNT /BUMP COUNTER + JMP MORNAM /MORE TO COME + SKP +NDONE, DCA I NPTR /ZERO NEXT WORD + ISZ GETNAM /FIX RETURN ADDR + JMP I GETNAM +MORNAM, JMS LETTER /GET NEXT CHAR + SKP + JMP .+3 /ITS A LETTER + JMS I [DIGIT + JMP NDONE+1 /NO GOOD, NAMES OVER + TAD I NPTR + DCA I NPTR /COMBINE TWO CHARS + ISZ NPTR + JMP PAKLUP +NPTR, 0 + NCNT=OADD + / DATA STATEMENT +DATA, JMS I [IFCHEK /IF(..)DATA ???? + TAD (DATAST /START DATA STATEMENT + JMS I [OUTWRD +DATLUP, CLA CMA /SET DIMNUM = -1 IF NO SUBSCRIPTS + JMS I [GETSS /GET LIST ELEMENT + JMP DATAER + TAD (DPUSH /OUTPUT DPUSH OPERATOR + JMS I [OUTWRD + CMA + TAD TEMP2 /FOLLOWED BY POINTER + JMS I [OUTWRD + TAD DIMNUM /FOLLOWED BY NUMBER + JMS I [OUTWRD + CDF 10 + TAD I TEMP2 /LOOK AT TYE TYPE + AND (20 /IS IT AN ARG ? + CDF + SZA CLA + JMP DATAER /YES, THATS BAD + JMS I [GETC /, ? + JMP DATAER + TAD (-254 + SNA + JMP DATLUP /LOOK FOR MORE + TAD (254-257 // ? + SZA CLA + JMP DATAER + JMP DLOOP2 /GO LOOK FOR ELEMENT +DATA3, TAD (WORD1-1 + DCA X10 /POINTER TO THE GOODS + TAD I X10 /THEN STUFF + JMS I [OUTWRD + ISZ TEMP + JMP .-3 +NXTDE, TAD (ENDELM /OUTPUT END OF ELEMENT + JMS I [OUTWRD + JMS I [GETC /LOOK FOR COMMA + JMP DATAER + TAD (-254 + SNA + JMP DLOOP2 /YES, GET MORE DATA + TAD (254-257 /SLASH ? + SZA CLA + JMP DATAER /NO, ERROR + JMS I [GETC /ANOTHER DATA GROUP ? + JMP I [NEXTST /NO + TAD (-254 /COMMA ? + SNA CLA + JMP DATA+1 /START A NEW DATA STMT +DATAER, JMS I [ERMSG + 0401 /OK WHEN THIS IS AN AND + JMP I [NEXTST +DHOLER, JMS I [ERMSG + 0410 /HOLLERITH DATA ERROR + JMP I [NEXTST +DQUOTE, 0 /GET CHAR FOR QUOTED DATA + JMS I [GETCWB + JMP DHOLER + TAD [-247 + SZA + JMP DNOTQ2 + JMS I [GETCWB + JMP I DQUOTE + TAD [-247 + SNA CLA + JMP DNOTQ2 /REPLACE '' BY ' + JMS I [BACK1 + JMP I DQUOTE +DNOTQ2, TAD [247 /FIX CHAR + ISZ DQUOTE + JMP I DQUOTE +OUT3WD, 0 /2.02/ OUTPUT 3 WORDS + TAD [DATELM /2.02/ OUTPUT ELEMENT HEAD + JMS I [OUTWRD /2.02/ + TAD (3 /2.02/ AND SIZE + JMS I [OUTWRD /2.02/ + TAD WORD1 /2.02/ NOW THREE WORDS + JMS I [OUTWRD /2.02/ + TAD WORD2 /2.02/ + JMS I [OUTWRD /2.02/ + TAD WORD3 /2.02/ + JMS I [OUTWRD /2.02/ + JMP I OUT3WD /2.02/ + / DATA STATEMENT + PAGE +DLOOP2, JMS I [GETC + JMP DATAER + TAD (-250 /IS CHAR ( ? + SZA + JMP NOCMPD /NO, NOT COMPLEX DATA + JMS I [NUMBER /GET REAL PART + JMP DATAER + SKP + JMP DATAER /DP IS NG WITH COMPLEX + JMS OUT3WD /2.02/ OUTPUT 3 WORDS + JMS I [CHECKC /LOOK FOR COMMA + -254 + JMP DATAER /BAD IF NOT THERE + JMS I [NUMBER /GET IMAGINARY PART + JMP DATAER + SKP + JMP DATAER + JMS I [CHECKC /LOOK FOR ) + -251 + JMP DATAER /NOT THERE + JMP DATAFP /GO MOVE IMAGINARY PART +NOCMPD, IAC /IS IT QUOTED STRING ? + SZA + JMP NQUOTD /NO + TAD (DQUOTE /GET SUBR ADDRESS + JMP HOLDAT /GO HANDLE IT +NQUOTD, TAD (247-317 /IS IT AN O (OCTAL) + SNA + JMP I (XOCTAL /YES + TAD (317-256 /IS IT . + SNA CLA + JMS I (TRUFAL /CHECK FOR TRUE OR FALSE + JMP NOTF /NO TRUE-FALSE, TRY NUMBER + CLL CML RTR /2000 + DCA WORD2 + TAD WORD2 + SZA CLA + IAC + DCA WORD1 /TRUE=1.0 FALSE=0.0 + DCA WORD3 + JMP DATAFP /GO PUT IT +NOTF, JMS I [BACK1 /PUT BACK CHAR + JMS I [NUMBER /TRY FOR A NUMBER + JMP DATAER /ELEMENT MISSING + JMP TRYHOS /IF INTEGER, TRY FOR H OR * + TAD (-3 +DATAFP, TAD (-3 /FP DATA + DCA TEMP /SIZE OF ITEM + TAD [DATELM /DATA ELEMENT SIGNAL + JMS I [OUTWRD + TAD TEMP /THEN SIZE + CIA /ALWAYS POSITIVE + JMS I [OUTWRD + JMP DATA3 /GO OUTPUT THE DATA +TRYHOS, JMS I [GETC /LOOK FOR H + JMP DATAER + TAD (-310 + SZA + JMP TRYSTR /NOT H, MAYBE ITS * + JMS I [FIXNUM /INTEGERIZE IT + SNA + JMP DHOLER /HOLLERITH DATA ERROR + CMA + DCA TEMP /SAVE COUNT + TAD (DHLRTH /GET SUBR POINTER +HOLDAT, DCA HCHAR + CLL CMA RTL /2.02/ COUNT + DCA TEMP2 /2.02/ BY THREES + TAD (WORD1-1 /2.02/ + DCA X10 /2.02/ POINTER +HDLOOP, JMS I HCHAR /GET A CHAR + JMP EOHD /2.02/ + AND [77 /6 BITIZE IT + CLL RTL + RTL + RTL /UPPER-PART-OF-WORDIZE + DCA WORD3 /2.02/ STORAGIZE IT + JMS I HCHAR /GET ANOTHER + JMP LASTHD /LAST HALF WORD MUST GO OUT + AND [77 + TAD WORD3 /2.02/ COMBINIZE THE TWO HALVES + DCA I X10 /2.02/ STORE IT + ISZ TEMP2 /2.02/ THREE AT A TIME + JMP HDLOOP /2.02/ + JMS OUT3WD /2.02/ OUTPUT THREE + JMP HOLDAT+1 /2.02/ GO DO NEXT THREE WDS +EOHD, CLL CML RTL /2.02/ ANY CHARS IN THIS SET ? + TAD TEMP2 /2.02/ + SPA CLA /2.02/ + JMP NXTDE /2.02/ NO, DO NEXT ELEMENT + JMP .+4 /2.02/ YES, FILL IT OUT +LASTHD, TAD WORD3 /2.02/ FILL OUT LOWER CHAR + TAD (40 /2.02/ WITH A BLANK + DCA I X10 /2.02/ + TAD (4040 /2.02/ THEN FILL REST + DCA I X10 /2.02/ WITH BLANKS + TAD (4040 /2.02/ + DCA I X10 /2.02/ + JMP DATAFP /2.02/ GO OUTPUT IT +TRYSTR, TAD (310-252 /* + SNA CLA + JMP .+3 + JMS I [BACK1 /PUT BACK THAT CHAR + JMP DATAFP /ITS JUST AN INTEGER + TAD (DREPTC /REPETITION COUNT + JMS I [OUTWRD + JMS I [FIXNUM + JMS I [OUTWRD /OUTPUT COUNT + JMP DLOOP2 /LOOP + / INITIALIZE READ IN + *6400 +INITLN, TAD IX7772 /READ FIRST SIX CHARS + DCA TEMP + TAD IXLINM + DCA CHRPTR +INITLP, CIF 10 + JMS I [ICHAR /READ A CHAR + JMP INITLN + TAD IXM211 /TAB ? + SZA CLA + JMP NIXTAB /NO THIS ONE + TAD IX0240 + DCA I CHRPTR + ISZ TEMP + JMP .-3 + JMP CHKCOM /DO COMMENT CHECK +NIXTAB, TAD CHAR + DCA I CHRPTR /STORE THE CHAR + ISZ TEMP + JMP INITLP +CHKCOM, TAD I IXLINE /COMMENT ? + TAD IXM303 + SNA CLA + JMP IGNORE /IGNORE IT + TAD I IXLNP5 /CONTINUATION ? + TAD IXM240 + SZA CLA + JMP IGNORE + TAD IX7700 /FIX CALL + CDF 10 /SEE WHAT HAPPENS WHEN YOU MOVE A ROUTINE** + DCA I IXINCL + CDF /** + CIF 10 + JMS I IX200 /REMOVE MONITOR + 11 + CDF 10 /FIX FIELD ONE STUFF + TAD I MOV1 + DCA I MOV2 + ISZ MOV1 + ISZ MOV2 + ISZ MOVCNT + JMP .-5 + CDF + JMP I IXRDFS /LOOK FOR PROG HEADER +MOV1, 2020 +MOV2, 20 +MOVCNT, -160 +IGNORE, CIF 10 /** + JMS I [ICHAR /SKIP TILL CARRIAGE RETURN + JMP INITLN + CLA + JMP IGNORE +IXRDFS, RDFRST +IXINCL, INCALL +IXM240, -240 +IXM303, -303 +IX0240, 0240 +IX200, 200 +IX7600, 7600 +IX7772, 7772 +IXM211, -211 +IX7700, 7700 /V3C + / SEARCH FOR PROGRAM HEADER + PAGE +RDFRST, CIF 10 /** + JMS I [ICHAR /THIS IS A DUPLICATE OF THE CODE + JMP ENDLNF /AT LABEL 'RDLOOP' , ONLY THE + TAD (-211 + SNA + TAD (240-211 + TAD (211 + DCA I CHRPTR /NAMES HAVE BEEN CHANGED TO + ISZ CNT72 + SKP + JMP SKPFL2 + TAD CHRPTR /PROTECT THE ASSEMBLY + CIA CLL /(IT GETS THE FIRST LINE + TAD (LINE+270 /WHICH MAY BE SUBROUTINE OR +/FUNCTION. 1ST LINE SHORTER THAN REST BEC OF BUFFER OVERWRITES** + SZL CLA /OR SOMETHING ELSE, IN WHICH CASE + JMP RDFRST /ITS THE MAIN PROGRAM) + JMS I [ERMSG /LINE TOO LONG + 1424 + JMP SKPFL /SKIP REST +SKPFL2, CIF 10 /** + JMS I [ICHAR + JMP ENDLNF + CLA + JMP SKPFL2 +SKPCMF, TAD X16 /BY ORDER OF THE EMPEROR + DCA CHRPTR /MARIO DE NOBILI +ENDLNF, TAD CHRPTR + DCA X16 + TAD CHRPTR + DCA X10 + TAD (-102 + DCA CNT72 + TAD (-6 + DCA NCHARS +GET6F, CIF 10 /** + JMS I [ICHAR + JMP SKPCMF + TAD (-211 + SZA CLA + JMP NOTABF + TAD (240 + DCA I CHRPTR + ISZ NCHARS + JMP .-3 + TAD (240 + DCA CHAR + JMP CCHEKF +NOTABF, TAD CHAR + DCA I CHRPTR + ISZ NCHARS + JMP GET6F +CCHEKF, TAD I X10 + TAD (-303 + SZA CLA + JMP NOCMTF +SKPFL, CIF 10 /** + JMS I [ICHAR + JMP SKPCMF + CLA + JMP SKPFL +NOCMTF, TAD CHAR + TAD (-240 + SNA CLA + JMP GOTFST +CCARDF, TAD X16 + DCA CHRPTR + JMP RDFRST +GOTFST, TAD CHRPTR + CIA + TAD (LINE+4 + DCA NCHARS + TAD [LINE-1 + DCA CHRPTR + JMS I [SAVECP + TAD (HDRLST-1 + DCA X10 /PREPARE TO SEARCH THE LIST +CLOOP1, CDF 10 /(FNC NAMES UP IN FLD 1)** + TAD I X10 /OF LEGAL HEADER LINES + CDF + SZA /CODE IS AS UNDER 'CMDLUP' + JMP CLOOP2 + CLA CMA RAL + TAD STACK + DCA STACK + CDF 10 /** + TAD I X10 + CDF + DCA TEMP + JMP I TEMP +CLOOP2, DCA TEMP + JMS I [GET2C + JMP BADCMF + CIA + TAD TEMP + SNA CLA + JMP CLOOP1 +SEARCH, CDF 10 /** + TAD I X10 + CDF + SZA CLA + JMP SEARCH + ISZ X10 + JMS I [RESTCP + ISZ STACK + ISZ STACK + CDF 10 /** + TAD I X10 + CDF + SZA + JMP CLOOP2 +BADCMF, JMS I [RESTCP /NOT A FUNCTION OR SUBROUTINE + JMP I (LINE1 /SO GO TO MAIN PART OF COMPILER +BADDIE, JMS I [MESSAG /SOMETHING MISSING FROM SYS + 323 /S + 331 /Y + / ANALYZE PROGRAM HEADER + PAGE +SUBRTN, CLA CMA /SET TO -1 FOR SUBR + JMP XXXFUN+1 +REAFUN, TAD (102 /SET TYPE TO REAL + DCA TYPE + JMP XXXFUN +LOGFUN, IAC /SET TYPE OF FUN +DBLFUN, IAC /WITH DOUBLEMINT GUM ! +CMPFUN, IAC + IAC +INTFUN, TAD (101 + DCA TYPE + JMS I [CHECKC /LOOK FOR 'N' + -316 + JMP BADBGN +XXXFUN, CLA IAC + DCA FUNCTN /SET SWITCH + CDF 10 /1.05/ KILL ENTRY FOR 'MAIN' + DCA I (ALIST+14 /1.05/ BUT DO IT BEFORE THE M BUCKET + CDF /1.05/ CONTAINS ANYTHING USEFULL + JMS I [GETNAM /GET FUNC/SUBR NAME + JMP BADBGN + JMS I [LOOKUP /PUT INTO SYMBOL TABLE + DCA PROGNM + TAD PROGNM /SET UP TYPE + IAC + DCA TEMP + TAD STACK + DCA X12 /SAVE POINTER + DCA TEMP2 /ZERO ARG COUNTER + CDF 10 + TAD TYPE /PUT IN THE TYPE BITS + TAD (1000 + DCA I TEMP + CDF + JMS I [CHECKC /LOOK OFR ( + -250 + JMP ISITFN /IS IT A FUNCTION ? +ARGLUP, JMS I [GETNAM /GET THE ARG + JMP BADBGN + JMS I [LOOKUP + IAC + DCA TEMP /ADDR OF TYPE WORD + CDF 10 + TAD I TEMP + SZA CLA + JMP BADBGN /ALREADY AN ARG + TAD (20 + DCA I TEMP + CDF + CMA + TAD TEMP /OUTPUT ADDR OF ARG + JMS I [PUSH + ISZ TEMP2 /KEEP COUNT + JMS I [COMARP /LOOK FOR , OR ) + JMP BADBGN /NEITHER + JMP ARGLUP /, + TAD TEMP2 /) HOW MANY ARGS ? + CDF 10 + DCA I NEXT /INTO ARG LIST + TAD TEMP2 + CIA + DCA TEMP2 + TAD NEXT /SAVE ADDR OF ARG LIST + DCA ARGLST + CDF + TAD X12 /RESTORE THE STACK + DCA STACK +MOVARG, TAD I X12 /PUT ARGS INTO ARG LIST + CDF 10 + DCA I NEXT + CDF + ISZ TEMP2 + JMP MOVARG + JMP I [NEXTST /DO NEXT LINE + TYPE=WORD6 +ISITFN, TAD FUNCTN /IS IT A FUNCTION + SPA SNA CLA /WITH NO ARGS ? + JMP I [NEXTST /NO, WE'RE OK +BADBGN, JMS I [ERMSG + 2010 + JMP I [NEXTST +BDATA, JMS I [CHECKC /LOOK FOR A + -301 + JMP BADBGN + CLL CMA RAL /SET FUNCTION SWITCH + DCA FUNCTN /2.02/ STORE IT DUMMY!! + TAD (BDLIST-1 /POINTER TO LIST OF PATCHES + DCA X10 +BDLOOP, CDF 10 + TAD I X10 /GET PATCH LOCATION + CDF + SNA + JMP I [NEXTST /NO MORE PATCHES + DCA TEMP /SAVE PATCH ADDRESS + TAD BADJMP /GET ERROR JUMP + DCA I TEMP /STORE IT + JMP BDLOOP /LOOP +BADJMP, JMP I [BDERR + / INITIAL SYMBOL TABLE + FIELD 1 + *2020 + NOPUNC + *20 + ENPUNC + 0 +BLNKCN, 111;0 /BLANK COMMON SLOT +ALIST, 0;0;0;0;0;0;0;0;0;0;0;0;MAIN;0;0;0;0;0;0;0;0;0;0;0;0;0 +HOLIST, 0 +FPLIST, 0 +DPLIST, 0 +INTLST, ONE +CMPLST, 0 +SNLIST, 0 +ONE, THREE;0;1;2000;0 +THREE, SIX;0;2;3000;0 +SIX, 0;0;3;3000;0 +TRUE, 0;0145;0 +MAIN, 0;1000;0;0111;1600 +FREE, 0 + / BLOCK DATA PATCH LIST +BDLIST, IF /BLOCK DATA PATCH LIST + DOUBLE + DO + GOTO + CALL + READ + REWIND + ENDFIL + FORMAT + WRITE + BACKSP + ASSIGN + STOP + PAUZE + DFINFL + FIND + ITSAR + 0 + / INITIALIZATION + *2200 +START, SKP /NON-CHAINED ENTRY POINT + JMP .+5 /CCL ENTRY + CIF CDF 10 /START HERE + JMS I (200 /COMMAND DECODE + 5 + 0624 /DEFAULT EXT IS .FT + TAD I L7600 /IS AN OUTPUT FILE GIVEN ? + SNA CLA + JMP MYFILE /NO, USE FORTRN.TM +MOVOFN, TAD I OFNAME /MOVE NAME INTO PAGE 0 + CDF + DCA I NAMEOF + CDF 10 + ISZ NAMEOF + ISZ OFNAME + ISZ OFNSIZ + JMP MOVOFN +EXTEST, TAD I (7604 /SET DEFAULT EXTENSIONS + SZA + JMP EXTSET + TAD I (7643 + SPA + JMP GETRA /A WAS SET.USE RA + AND L41 /CHECK FOR L+G + SNA CLA + TAD (0610 /USE RL + TAD (1404 /USE LD +EXTSET, DCA I (7604 + TAD I (7604 + CDF 0 + DCA I NAMF + CDF 10 + TAD I (7611 + SNA + TAD (1423 /.LS FOR LISTING + DCA I (7611 + TAD I (7616 + SNA + TAD (1520 /.MP FOR LOAD MAP + DCA I (7616 +EFILE, CLA IAC /OPEN PASS1 OUTPUT FILE + JMS I (200 + 3 +OBLOK, TMPFL2 +OSIZE, 0 + JMP OBAD /BADDIE + CDF + TAD OBLOK /SAVE STARTING BLOCK + DCA OUBLOK + TAD OBLOK + DCA I (OUFILE + TAD OSIZE + DCA OULEN + CDF 10 + CLA IAC + JMS I (200 /GET PASS2 + 2 +SPASS2, PASS2N + 0 + JMP OBAD + CLA IAC + JMS I (200 + 2 +SP2O, PAS2ON /GET PASS2 OVERLAY + 0 + JMP OBAD + CDF /SAVE PASS2 AND PASS2O BLOCKS + TAD SPASS2 + DCA PASS2B + TAD SP2O /SKIP FIRST BLOCK + IAC /ITS THE CORE TABLE + DCA I (PASS2O + CIF + JMP INITLN /GO START COMPILE +MYFILE, CDF /PUT DEFAULT INTO 17600 + TAD I NAMOF + DCA I NAMEOF + TAD I NAMOF /ALSO INTO PAGE 0 + CDF 10 + DCA I OFNAME + ISZ NAMOF + ISZ NAMEOF + ISZ OFNAME + ISZ OFNSIZ + JMP MYFILE + CLA IAC /SET DEV TO SYS + DCA I L7600 + JMP EXTEST /GO OPEN FILE +OBAD, CIF CDF + JMP BADDIE +OFNAME, 7601 /IGNORE DEVICE (ALWAYS USE SYS) +NAMEOF, TMPFIL+4 +NAMOF, TMPFIL +OFNSIZ, -3 +TMPFL2, 0617;2224;2216;2415 /FORTRN.TM +PASS2N, 2001;2323;6200;2326 /PASS2.SV +PAS2ON, 2001;2323;6217;2326 /PASS2O.SV +NAMF, TMPFIL+7 +L7600, +GETRA, 7600 /CLA + TAD (2201 /V3C USE RA + JMP EXTSET +L41, 41 + PAGE +/ PROGRAM HEADER LIST +HDRLST, TEXT 'INTEGERFUNCTIO' + INTFUN + TEXT 'REALFUNCTION' + REAFUN + TEXT 'COMPLEXFUNCTIO' + CMPFUN + TEXT 'DOUBLEPRECISIONFUNCTIO' + DBLFUN + TEXT 'LOGICALFUNCTIO' + LOGFUN + TEXT 'FUNCTION' + XXXFUN + TEXT 'SUBROUTINE' + SUBRTN + TEXT 'BLOCKDAT' + BDATA + 0 + / PS-8 FILE INPUT ROUTINES +/NEED TWO PAGES BEC. MOVING ICHAR OUT OF FIELD 1 REQUIRES +/ALOT OF FIELD DIDDLING. + *5400 +MORCHR, TAD (214 /FIX CHAR + CDF 0 /** + DCA I QCHAR + CDF 10 + TAD I (ICHAR + IAC /UPDATE ADDR + DCA TCHAR + CIF CDF 0 + TAD I QCHAR /RETURN VALUE IN AC + JMP I TCHAR +TCHAR, 0 +QCHAR, CHAR +/ EXTENDED OPERATOR LIST +OPRLST, -01;-1604;ANDOPR + -17;-2200;OROPR + -05;-2100;EQOPR + -16;-0500;NEOPR + -07;-0500;GEOPR + -07;-2400;GTOPR + -14;-0500;LEOPR + -14;-2400;LTOPR + -30;-1722;XOROPR + -05;-2126;EQVOPR + 0 +/ EXPONENT TABLE +PETABL, 0004;2400;0000 /1E1 + 0000;0000;0000 + 0007;3100;0000 /1E2 + 0000;0000;0000 + 0016;2342;0000 /1E4 + 0000;0000;0000 + 0033;2765;7020 /1E8 + 0000;0000;0000 + 0066;2160;6744 /1E16 + 6770;1000;0 + 0153;2356;1326 /1E32 + 6501;2670;2655 + 0325;3023;6017 /1E64 + 5117;7747;6466 + 0652;2235;6443 /1E128 + 7114;0164;6145 + 1523;2523;7565 /1E256 + 7734;7374;7357 + 3245;3430;6320 /1E512 + 2565;1407;2176 +ENDSTM, 211;"E;"N;"D;215;211;215;232 /V3C +/FAKE END STATEMENT USED IF PROGRAM HAS NONE + PAGE + /MAIN PART OF OS/8 INPUT ROUTINES + +ICHAR, 0 /READ CHAR FROM INPUT FILE + CDF 10 + ISZ INJMP /BUMP THREE WAY UNPACK SWITCH + ISZ INCHCT +INJMPP, JMP INJMP +/ CDF ** + TAD INEOF /DID LAST READ YEILD END OF FILE ? + SNA CLA + JMP INGBUF /NO, DO ANOTHER READ +GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE + JMP ENDIN /END OF INPUT +INGBUF, TAD INCTR /BUMP RECORD COUNTER + CLL IAC + SNL + DCA INCTR /RESTORE IF IT HASN'T OVERFLOWED + SZL + ISZ INEOF /SET END OF FILE SWITCH + CDF 10 /** + CIF 0 /** + JMS I INHNDL /DO THE READ + 0210 /ONE BLOCK TO FIELD 1 +INBUFP, INBUF +INREC, 0 + JMP INERR /HANDLER ERROR +INBREC, ISZ INREC /BUMP RECORD NUMBER + TAD INBUFP /RESET BUFFER POINTER +SVIBPT, DCA INPTR /V3C + TAD (-601 /SET CHAR COUNT + DCA INCHCT + TAD INJMPP /RESET THREE WAY JUMP SWITCH + DCA INJMP + JMP ICHAR+1 /GO AGAIN +INERR, ISZ INEOF /EITHER EOF OR BADDIE + SMA CLA + JMP INBREC /END OF FILE, DO NEXT FILE + JMP TERR /INPUT ERROR, GIVE I F AND EXIT +ENDIN, TAD (ENDSTM /V3C IF NO END STATEMENT, FORCE ONE + JMP SVIBPT + +/ENDIN, TAD INCALL /END OF INPUT IS USR IN CORE ? +/ TAD (-200 +/ CIF 0 /** +/ SZA CLA +/ JMP I (ENDX /NO, ITS END OF PROG +TERR, JMS I (MESSAG /YES, BAD INPUT. WAS SQ.BRCK** + 311 + 306 +INJMP, HLT /3 WAY CHAR UNPACK BRANCH + JMP ICHAR1 + JMP ICHAR2 +ICHAR3, TAD INJMPP /RESET JUMP SWITCH + DCA INJMP + TAD I INPTR + AND (7400 /COMBINE THE HIGH ORDER BITS + CLL RTR /OF THE TWO WORDS + RTR + TAD INTMP /TO FORM THE THIRD CHAR + RTR + RTR + ISZ INPTR /BUMP WORD POINTER + JMP ICHAR1+1 /DO SOME COMMON STUFF +ICHAR2, TAD I INPTR /SAVE THE HIGH ORDER BITS + AND (7400 + DCA INTMP /FOR THE THIRD CHAR + ISZ INPTR /GO TO THE SECOND WORD +ICHAR1, TAD I INPTR /GET THE LOW 8 BITS +/ CDF + AND (177 /AND I MEAN ONLY 8 !! + SNA /V3C YOU WERE WRONG - YOU MEANT ONLY 7 + JMP ICHAR+1 + TAD (-32 /IS IT ^Z (END OF FILE) + SNA + JMP GETNEW /YES, LOOK FOR THE NEXT FILE + TAD (232-212 + SNA + JMP ICHAR+1 /IGNORE LINE FEEDS + TAD (212-215 + SNA + JMP ICHARN /RETURN ON CARRIAGE RETURN ** + IAC + SNA + JMP ICHAR+1 /IGNORE FORM FEEDS + JMP I (MORCHR /** +ICHARN, CIF CDF 0 + JMP I ICHAR +INTMP, 0 +INFPTR, 7617 /POINTER TO INPUT FILE LIST +INEOF, 1 +INCHCT, +INNEWF, -1 /FETCH HANDLER FOR NEXT FILE + CDF 0 /** + TAD (INDEVH+1 /THIS IS WHERE IT GOES ** + DCA INHNDL + CDF 10 + TAD I INFPTR /GET NEXT INPUT FILE INFO + SNA + JMP I INNEWF /NO MORE FILES + CDF 10 /WAS CIF 10** + JMS I INCALL /CALL MONITOR + 1 /FETCH HANDLER +INHNDL, 0 /ENTRY ADDR GOES HERE + JMP INERR+3 /THIS CAN'T HAPPEN HERE + TAD I INFPTR /GET LENGTH + AND (7760 + SZA /A ZERO HERE MEANS >=256 BLOCKS + TAD (17 /PUT IN SOME MORE BITS + CLL CML RTR + RTR + DCA INCTR /STORE LENGTH OF FILE + ISZ INFPTR + TAD I INFPTR /GET STARTING RECORD NUMBER + DCA INREC + ISZ INFPTR + DCA INEOF /CLEAR EOF FLAG + ISZ INNEWF + JMP I INNEWF +INCTR, 0 +INCALL, 200 /CHANGED TO 7700 AFTER FIRST TIME +INPTR, 0 + PAGE + / KEYWORD LIST +CMDLST, -1106;0;IF /IF + -0417 + -2502 + -1405 + -2022 + -0503 + -1123 + -1117;0;DOUBLE /DOUBLE PRECISION + -0417;0;DO /DO + -0717 + -2417;0;GOTO /GOTO + -0317 + -1515 + -1716;0;COMMON /COMMON + -0317 + -1520 + -1405;0;COMPLE /COMPLEX + -0317 + -1624 + -1116 + -2505;0;NEXTST /CONTINUE + -0301 + -1414;0;CALL /CALL + -2205 + -0114;0;REAL /REAL + -2205 + -0104;0;READ /READ + -2205 + -2711 + -1604;0;REWIND /REWIND + -2205 + -2425 + -2216;0;RETURN /RETURN + -0516 + -0406 + -1114;0;ENDFIL /ENDFILE + -0516;0;XEND /END + -0411 + -1505 + -1623 + -1117;0;DIMENS /DIMENSION + -0401 + -2401;0;DATA /DATA + -0617 + -2215 + -0124;0;FORMAT /FORMAT + -2722 + -1124;0;WRITE /WRITE + -0521 + -2511 + -2601 + -1405 + -1603;0;EQUIV /EQUIVALENCE + -0405 + -0611 + -1605 + -0611 + -1405;0;DFINFL /DEFINEFILE + -1116 + -2405 + -0705;0;INTEGE /INTEGER + -1417 + -0711 + -0301;0;LOGICA /LOGICAL + -0530 + -2405 + -2216 + -0114;0;EXTERN /EXTERNAL + -0201 + -0313 + -2320 + -0103;0;BACKSP /BACKSPACE + -0123 + -2311 + -0716;0;ASSIGN /ASSIGN + -2001 + -2523;0;PAUZE /PAUSE + -2324 + -1720;0;STOP /STOP + -0611 + -1604;0;FIND /FIND + 0 /END OF LIST + $ + diff --git a/sw/f4/FRTSRC/fcomp.bi b/sw/f4/FRTSRC/fcomp.bi new file mode 100644 index 0000000..6f0f1a5 --- /dev/null +++ b/sw/f4/FRTSRC/fcomp.bi @@ -0,0 +1,168 @@ +$JOB FORTRAN IV ASSEMBLY +/ +.DATE +/ +/ +/ +/ ******************************************************************* +/ ******************************************************************* +/ +/ PAL-8 ASSEMBLY +/ +/ ******************************************************************* +/ ******************************************************************* +/ +/ +.PAL LIBRA +.LOAD LIBRA +.SAVE SYS LIBRA=0;200 +.DELETE LIBRA.BN +/ +/ ******************************************************************* +/ +.PAL LOAD +.LOAD LOAD +.SAVE SYS LOAD=0;200 +.DELETE LOAD.BN +/ +/ ******************************************************************* +/ +.PAL PASS2 +.LOAD PASS2 +.SAVE SYS PASS2 +.DELETE PASS2.BN +/ +/ ******************************************************************* +/ +.PAL PASS2O4 BLOCKS LEFT ONLY DO 4 + TAD [4 + CLL RTR + RTR + RTR + TAD LDRIOC /ADD READ/WRITE + CDF 0 + TAD I (OUTFLD + TAD (-CDF + DCA LDRIOC /STORE R/W + BLOCK COUNT + FLD BITS + TAD BLKBEG + DCA LDRIOA + JMS I [IOHAN /DF MUST BE 0 HERE! + LIMGU /LOADER IMAGE FILE +LDRIOC, 0 +LDRIOA, 0 +LDRIOB, 0 + CDF 10 +LDRIOR, CLA + JMP I LDRIO + SETBGX, 0 + CLA IAC + TAD GPTR + JMS SETBPT /EXTREMELY COMMON SEQUENCE + JMP I SETBGX + +SETBPT, 0 + DCA BPTR /STORE BPTR + CLA IAC + TAD BPTR + DCA BPT2 /AND PTR TO NEXT WD + JMP I SETBPT +ORGMSG, TEXT /ILLEGAL ORIGIN/ +SYMMSG, TEXT /OVER SYMB/ +IOMSG, TEXT %LOADER I/O ERROR% +ENTMSG, TEXT %OS/8 ENTER ERROR% + PAGE + /TTYHAN- TTY HANDLER FOR OUTPUT OF ANY MESSAGE IN ANY FIELD. +/ MESSAGE MUST BE FIELD CONTAINED & TERMINATE WITH 0 +/ HANDLER CAN BE CALLED ACROSS FLDS WITH AC CLR. +/ RTN WITH"IF & DF" SET TO CALLING FLD. +/ +/ CALL CDF X /X=FLD OF CALLER*10 +/ CIF Y /Y=FLD OF TTYHAN*10 +/ JMS TTYHAN +/ CDF Z /Z=FLD OF MESS.BUF +/ BUFADR /MESS BUF. ADDR. +/ +TTYHAN, 0 + TAD (6203 /SETUP MICRO INSTR + RDF /CDF & CIF FOR RTN + DCA CRLFF+1 + TAD I TTYHAN /SET UP FLD OF + DCA TTYCDF /MESS BUF + ISZ TTYHAN + CMA + TAD I TTYHAN /SET UP MESS BUFF ADDR-1 + DCA MESADR + ISZ TTYHAN + DCA MESADR+1 +TTYCDF, 0 + JMS CRLF +TTYLP, ISZ MESADR+1 + JMP .+3 + TAD I MESADR + JMP HAF + ISZ MESADR + CLA CMA + DCA MESADR+1 + TAD I MESADR + RTR + RTR + RTR +HAF, AND [77 + SNA + JMP CRLFF + TAD [240 + AND [77 + TAD [240 + JMS TTYO + JMP TTYLP +CRLFF, JMS CRLF + 0 + JMP I TTYHAN +MESADR, 0 + 0 + RTNOS8, 0 /HERE ON PASS1 FATAL ERROR + STA + CDF 10 + DCA I (OVLTBL /PRINT SYMBOL MAP W/O OVERLAY LENGTH TABLE +DOMAP, JMS I (SYMMAP + CDF + TAD I RTNOS8 /ADDR OF TTY + DCA .+3 /MSG + JMS I [TTYHAN + CDF + 0 + TAD (TTYO + DCA PPACK /FAKE OUT SYMBOL PRINTER + TAD LNONUM + DCA GTYP /PUT LEVEL AND OVERLAY IN GTYP + JMS I (CVLOVL /OUTPUT LEVEL AND OVERLAY + AC7775 + DCA TMP5 /PRINT 3 DIGIT FILE-WITHIN-OVERLAY + TAD MCNT + TAD MBGCNT + IAC + CLL RTL + RAL + JMS I (CVRT + JMS CRLF /OUTPUT CRLF AFTERWARDS + JMP I .+1 /RTN TO + 7605 /OS8 + +LDRNAM, 1;0617;2224;2216;1404 /SYS:FORTRN.LD + ZBLOCK 5 /NO DEFAULT SYMBOL MAP DEVICE + +TTYO, 0 + TLS + TSF + JMP .-1 + CLA + JMP I TTYO +/ +CRLF, 0 + TAD (215 + JMS TTYO + TAD (212 + JMS TTYO + JMP I CRLF + /OS8ER- USED WHEN AN OS/8 ERROR OCCURS WHICH IS FATAL + +OS8ER, 0 + CDF 0 + JMS I [TTYHAN + CDF 0 /FLD OF MESS BUF + SYSERR /ADR OFMESS BUF + JMP I [7605 /RTN TO OS8 + +SYSERR, TEXT /SYSTEM ERROR/ +TYTBL, 4040 /CHARS FOR SMAP + 0530 /EX (EXTERN) + 4040 /GOOD TYPES ARE + 4040 /SPACES + 1505 /ME (MUL ENTRY) + 1523 /MS (MUL SECTN) + 4040 /GEN 8MOD SECT + 4040 /8MOD COM SECT + 4040 /8MOD F1 SECT + PAGE + /IOHAN- I/O HANDLER 1)FETCHES A OS8 DEVICE HANDLER; +/ 2)CHKS FOR E.O.FILE;3)ISSUES CALL TO THE HANDLER. +/ RTN TO CALLER WITH "IOFLG" SET IF +/ NUM OF BLKS TRANSF LESS THAN REQ AMT. +/ CAN BE CALLED FROM ANY FLD +/ IF AC=0,DO ALL OF THE ABOVE. +/ IF AC=DEV NUM,DO ONLY "FETCH"PART +/ +/ CALL CDF X +/ CIF Y +/ JMS IOHAN +/ ADDR /PTR TO UNIT,LEN,STBLK OF FILE IN FLD 1 +/ ARG(1)/OS8 ARG: FCN CTRL WD +/ ARG(2)/ " : TRNASF BUF ADR +/ ARG(3)/ " : REL STBLK OF TRANSF +/ +IOHAN, 0 + DCA UNITSV /SAV DEV NUM IF ONE + DCA IOFLG /CLR FLG + RDF + TAD P6201 + DCA GETCDF+1 + TAD P6203 /SETUP CIF & CDF FOR + RDF /RTN JMP + DCA RTNIO +/FETCH A DEV HANDLER OR LOOKUP ENTRY PT +/IF DESIRED HANDLER IS IN CORE + TAD UNITSV /GET DEV NUM IF ONE + SNA CLA /JUST A FETCH? + JMP .+3 /NO + JMS INQIRE /YES + JMP RTNIO + TAD I IOHAN /GET PTR TO UNIT(DEV NUM) + DCA ULSADR + CDF 10 + TAD I ULSADR /GET DEV NUM + AND [17 + SNA + JMS I [OS8ER + DCA UNITSV + JMS INQIRE +/CHK FOR E.O.FILE + ISZ IOHAN + JMS GETCDF + TAD I IOHAN /GET FCN CTRL WD + CLL RTL /NUM OF PAGES IS CONVRTED + RTL /TO NUM BLKS & PUT + RTL /IN BITS 8-11 + AND [17 + DCA TMP0 /NUM BLKS TO TRANSF + /SETUP FCN CTRL WD; TRANSF BUF ADR; & ABS STBLK OF TRANSF +/FOR OS8 CALL TO HANDLER + TAD I IOHAN /FCN CTRL WD + DCA FCNWD + ISZ IOHAN + TAD I IOHAN /TRANSF BUF ADR + DCA FCNWD+1 + ISZ IOHAN + TAD I IOHAN /GET REL STBLK & BUILD + TAD TMP0 /ABS STBLK + CIA CLL + ISZ ULSADR + CDF 10 + TAD I ULSADR /FILE LEN-(REL STB+NUM BLKS) + SNL SZA /E.O.FILE CONDITION? + JMP .+3 /YES + CLA /NO + JMP SETSBN + TAD TMP0 + SMA SZA /ANY BLKS TO TRANSF? + JMP IOH /YES + CLA /NO +/CHK IF FILE LEN=0; IF SO DO SEQ STUFF + TAD I ULSADR + SNA CLA /SEQ DEV? + JMP IOH+1 /YES + CMA /NO,=-1 IF NUM BLKS TRANSF L.T. REQ + DCA IOFLG + JMP RTNIO +IOH, DCA TMP0 /THIS NUM OF BLKS +/UPDATE FCN CTRL WD IN OS8 CALL + TAD FCNWD + AND (4077 /REMOVE REQ NUM OF PGS + DCA FCNWD /& PUT IN THE + TAD TMP0 /ALTERED NUM + CLL RTR + RTR + RTR + TAD FCNWD + DCA FCNWD + CMA /=-1 IF NUM BLKS TRANSF L.T. REQ + DCA IOFLG +/SETUP STARTING BLK NUMBER +/ +SETSBN, ISZ ULSADR + CDF 10 + TAD I ULSADR /GET ABS STBLK + JMS GETCDF /GET DF + TAD I IOHAN /ADD REL STBLK + DCA FCNWD+2 + TAD I IOHAN /UPDATE REL STBLK + TAD TMP0 /BY NUM BLKS OF TRANSF + DCA I IOHAN + /CALL TO THE HANDLER +P6203, CIF CDF 0 /IOHAN & OS8 DEV HAN IN FLD 0 + KSF /CHK FOR CTRLC + JMP .+5 + KRS + TAD (-203 + SNA CLA + JMP I [7605 + JMS I IOENT +FCNWD, 0 + 0 + 0 + JMP HNDERR /ERROR RETURN OF CALL + ISZ IOHAN +RTNIO, 0 /CIF INSTR + JMP I IOHAN +IOENT, 0 +ULSADR, 0 +UNITSV, 0 +/ +GETCDF, 0 + 0 + JMP I GETCDF + +HNDERR, JMS I [RTNOS8 + IOMSG + /INQIRE- DETERMINE IF DESIRED DEV HANDLER IS IN CORE +/ & IF SO,GET ITS ENTRY PT + DVTBL=7647 +INQIRE, 0 + CDF 10 + TAD UNITSV + TAD (DVTBL-1 + DCA IOENT /ADR OF ENRTY PT IN RESID. TBL + TAD I IOENT /GET ENTRY PT IF ONE + DCA IOENT + TAD IOENT + SZA CLA /DEV HAN WAS IN CORE? + JMP I INQIRE /YES + TAD (7201 /NO + DCA P6201+4 + TAD UNITSV /GET DEV NUM BK +P6201, CDF 0 + CIF 10 + JMS I USR + 1 + 0 + JMS I [OS8ER + TAD .-2 + DCA IOENT + JMP I INQIRE + PAGE + NXTESD, 0 + ISZ EPTR /ADV PTR TO + ISZ EPTR /WD 0 OF + TAD EPTR /NEXT ENTRY + AND [377 /IF AT BLK + SNA CLA /BOUNDARY + TAD [4 /BUMP IT FOUR + TAD EPTR + JMS I [SETEPT + TAD [3 /CHECK FOR + TAD EPTR /END OF + DCA TMP0 /ESD + TAD I TMP0 /TYPE WD + AND [17 /TO AC B8-B11 + SZA /LAST ESD? + ISZ NXTESD /NO + DCA ETYP /SAVE TYPE + JMP I NXTESD + ADVOVR, 0 /UPDATE PASS1 PASS2 ARGS + ISZ MCNT /MORE MODS IN THIS OVR? + JMP SAMOVR /YES + JMS NXTOVR /SET ARGS FOR NEXT OVER + JMP EOLVL /RTN HERE= END OF LEVEL + TAD P2FLG /DOING PASS2 ? + SMA CLA + JMP BY10 /NO + TAD (2 /GET NEW LDR + TAD BSECTP /IMAGE REL BLK + DCA TMP0 /FOR NEXT OVR + TAD TMP0 + DCA NDX0 + TAD I NDX0 /LENGTH OF OVERLAY + TAD I TMP0 /PLUS OLD RELATIVE BLOCK + DCA I TMP0 /EQUALS NEW RELATIVE BLOCK +BY10, TAD LNONUM /ADD 1 TO BITS + TAD (20 /4-7 OF LEVEL + DCA LNONUM /AND OVR LAY NUM + JMP SAMOVR +EOLVL, JMS NXTOVR /GET NXT OVR NEW LEVEL + JMP SAMOV4 /HERE=END OF ALL LEVELS + TAD LNONUM /ADD 1 TO + AND [3400 /THE LEVEL + TAD (400 /BITS (1-3) + DCA LNONUM /AND CLEAR THE OVR BITS + TAD P2FLG + SMA CLA /DOING PASS2 ? + JMP BY7 /NO + TAD [4 + TAD BSECTP /UPDATE BIN SECTION PTR + DCA BSECTP + JMP SAMOVR + BY7, ISZ I (LEVSYM+2 /SET THE INTERNAL LEVEL SYMBOL TO LEVLN+1 + TAD (LEVSYM /ENTER NEW + JMS I [LOOK /LEVEL SYMBOL INTO GST + TAD [4 + TAD LNONUM /SET TYPE + DCA I GPTR /TO PROG SECTION + IAC /SET PTR TO + TAD GPTR /NEW LEVEL + DCA I [LVPTR +LEVRND, TAD I BPT2 + CLL + TAD [377 /ROUND UP OLD LEVEL + AND [7400 /TO A BLOCK BOUNDARY + SZL + ISZ I BPTR /MIND THE CARRIES! + DCA I BPT2 +SAMOVR, TAD [3 /ADV PTR TO + TAD RFPTR1 /NXT RALF + DCA RFPTR1 /MODULE + JMP I ADVOVR +SAMOV4, ISZ ADVOVR /BUMP RETURN + TAD P2FLG + SPA CLA + JMP SAMOVR /SKIP ROUNDUP IF PASS 2 + JMS I (LEVLUP /MERGE OVERLAY SIZE INTO LEVEL SIZE + JMP LEVRND /AND RND UP LAST LEVEL + NXTOVR, 0 /HERE AT END OF OVERLAY + ISZ MTBL /GET NUM OF + TAD I MTBL /MOD IN NXT + SNA /OVR + JMP I NXTOVR /=END OF LEVEL + DCA MBGCNT + TAD MBGCNT + CIA + DCA MCNT + TAD P2FLG + SMA CLA + JMS I (LEVLUP /SET CUR. LEVL =MAX (CUR LEVL, CURNT OVR) + ISZ NXTOVR /RTN P+1 IF + JMP I NXTOVR /NOT END OF LEVEL + + +SETCNT, 0 + TAD (MCTTBL+1 /PTR TO MOD + DCA MTBL /COUNT TBL + TAD I MTBL /-NUM IN + DCA MBGCNT + TAD MBGCNT + CIA /MAIN + DCA MCNT + TAD (MODTBL+3 /PTR TO TOP + DCA RFPTR1 /OF MOD TBL + DCA I (OVRSIZ + DCA I (OVRSIZ+1 + JMP I SETCNT +MTBL, 0 + PAGE + /LOOKUP OR ENTER A SYMBOL INTO +/GLOBAL SYMBOL TABLE (GST). PTR +/TO SYMBOL IN FIELD 1 IS IN +/AC. USUALLY ITS AN ESD. +/RTN P+1=NO MATCH +/RTN P+2=MATCH + +LOOK, 0 + DCA TMP0 /PTR TO SYM + CDF 10 + TAD I TMP0 /SELECT + RTR /BUCKET + RTR /A-Z, SPACE + RTR /OR POUND + AND [77 + TAD (BUCKET-1 /PTR TO BUCKET +LOP5, DCA TMP1 /PTR TO PREV ENTRY + TAD I TMP1 /PTR TO NEXT ENTRY + SNA /0=BUCKET BOTTOM + JMP HOOKIN /NO MATCH + IAC /APPEND SYMBOL + DCA GPTR /LOOK FOR + AC7775 /3 WORD MATCH + DCA TMP2 + TAD TMP0 + DCA EPTR +YUCCH, TAD I EPTR + CIA CLL + TAD I GPTR + SZA CLA + JMP YECCH /SYMBOLS DIFFER + ISZ EPTR + ISZ GPTR + ISZ TMP2 /ALL MATCH? + JMP YUCCH /NO + ISZ LOOK /BUMP RTN +SETTYP, TAD I EPTR /GET ESD TYPE + AND [17 + DCA ETYP + CLA IAC + TAD EPTR + JMS I [SETEPT /BUMP EPTR AND SET EPT2 + TAD I EPTR /GET ESD NUM + RTR /IN B1-B7 + RTR /AND SET + AND (177 /REFERENCE + TAD (ESDPG /POINTER + DCA REFPTR + TAD I GPTR /SET GST + AND [17 /TYPE + DCA GTYP /FIELD BITS OF + TAD I EPTR /VALUE WORDS + AND [7 /CLR + DCA I EPTR /HI 9 + JMP I LOOK + YECCH, SZL /IS NEW GUY LESS THAN GST ENTRY? + JMP HOOKIN /YES HOOK-IN HERE + TAD I TMP1 + JMP LOP5 /TRY NEXT +HOOKIN, TAD I TMP1 /GET FWD LINK + DCA I NDX4 /TO NEXT INTO + TAD NDX4 /NEW. PUT FWD + DCA I TMP1 /LINK TO NEW INTO PREV. + TAD TMP0 /3 SYM + DCA EPTR /INTO GST + AC7775 + DCA TMP2 + TAD I EPTR + DCA I NDX4 + ISZ EPTR + ISZ TMP2 + JMP .-4 + ISZ NDX4 /SET PTR TO + TAD NDX4 /WORD 4 (TYPE) + DCA GPTR /OF GST + ISZ NDX4 /SET PTR TO NEXT + ISZ NDX4 /FREE ENTRY + TAD [7 /SEE IF + TAD NDX4 /GST IS FULL + TAD ENDSYM /END OF GST + SPA SNA CLA + JMP SETTYP /ITS OK + JMS I [RTNOS8 /SYMBOL TABLE + SYMMSG /OVER FLOW +ENDSYM, 1-OVLTBL + +SETEPT, 0 + DCA EPTR + CLA IAC + TAD EPTR + DCA EPT2 /SET PTR TO BOTH WDS OF DBLWD + JMP I SETEPT + GETTYP, 0 /ADV GST PTR + TAD [7 /TO WD 4 OF + TAD GPTR /ENTRY + DCA GPTR /CHECK FOR + TAD GPTR + TAD ENDSYM + SMA CLA + JMP I GETTYP + TAD I GPTR /END OF GST. + SZA CLA /IF NOT END, + ISZ GETTYP /ISZ RETURN. + JMP I GETTYP + +OLINE, 0 /OUTPUT A LINE OF TEXT TO THE SYMBOL MAP + DCA TMP5 +OLINLP, TAD I TMP5 + JMS I (HAFWD + TAD I TMP5 + ISZ TMP5 + AND [77 + SZA CLA + JMP OLINLP + JMS I [PCRLF /DOUBLE SPACE AFTERWARDS + JMS I [PCRLF + JMP I OLINE + PAGE + /HERE TO OUTPUT SYMBOL MAP +/EACH SYMBOL IN GST IS 7 WORDS LONG +/THE FORMAT IS: +/WD0 PTR TO NEXT ALPHABETICAL SYMBOL +/WD1 SYMBOL NAME IN PACKED SIX BIT +/WD2 ASCII. 00 IS INTERPRETED AS SPACE +/WD3 SIX CHARS MAX PER SYMBOL +/WD4 B0=1=TRAP VECT SYMBOL ON PASS1 OR +/ B0=1=PASS2 ERROR, B1-B3=LEVEL NUM +/ (0-7) B4-B7=OVERLAY NUM (0-17) +/ B8-B11=TYPE. TYPE FORMAT IS: +/ 0=END OF ESD TBL (NA TO LDR) +/ 1=ENTRY POINT +/ 2=EXTERN +/ 3=COMMON SECTION +/ 4=PROGRAM SECTION +/ 5=MULTIPLE ENTRY POINT +/ 6=MULTIPLE SECTION +/ 7=GENERAL 8-MODE SECTION +/ 10=FIELD1 8-M0DE SECTION +/ 11=COMMON PG0 8-MODE SECTION +/ 12-17=UNDEFINED +/ +/WD5 B0-B8=PTR TO PARENT SYMBOL (0R 0) +/ ON PASS1 =TRAP VECTOR DISPLACEMENT +/ ON PASS2 +/ B9-B11=FIELD BITS OF SYMBOL +/WD6 ADDR BITS OF SYMBOL + +/OUTPUT FORMAT OF MAP IS: +/ +/SYMBOL VALUE LEVEL OVRNUM TYPE(*) +/ +/THE TYPE COLUMN IS EITHER 2 BLANKS OR +/EX=EXTERN +/ME=MULTIPLE ENTRY POINT +/MS=MULTIPLE SECTION +/ASTERISK MEANS SOME TYPE OF ILLEGAL +/REFERENCE TO A SYMBOL AND USUALLY +/MEANS A LOADER ORIGINATED TRAP HAS +/BEEN GENERATED SOMEWHERE IN THE BINARY +/E.G. SUBR GROG AT LEVEL 2 CALLS SUBR +/COLUMBO AT LEVEL 1. A USER 7 TRAP +/WOULD BE GENERATED IN SUBR GROG, AND +/THE SYMBOL COLUMBO WOULD HAVE AN +/ASTERISK ASIDE OF IT IN THE TYPE +/COLUMN + SYMMAP, 0 + CDF + TAD I (LDRNAM+5 /MAP UNIT + SNA /IS IT 0 ? + JMP NOMAP /YES, NO MAP TO OUTPUT + JMS I [IOHAN /FETCH HANDLER + TAD I (LDRNAM+5 /ENTER OUTPUT + CIF 10 + JMS I USR + 3 +MPBLK, LDRNAM+6 + 0 + JMP ENTERR /WHOOPS WE HAVE AN ENTER ERROR + TAD I (LDRNAM+5 + AND [17 + CDF 10 + DCA I (SMAPU /STORE SYMBOL MAP UNIT + TAD (SMAPU /SYMMAP ARGS + DCA NDX0 /FOR I/O + TAD MPBLK+1 /LENGTH + CIA + DCA I NDX0 + TAD MPBLK + DCA I NDX0 + TAD (BUCKET /START AT 1ST + DCA RLEN /BUCKET (A) + TAD (-42 /DO UP UNTIL BUT NOT INCL. + DCA RBLK /POUND SIGN + AC7775 /INIT PACK ARGS + DCA FATAL + TAD (RALFBF + DCA TMP4 + TAD SM600 + DCA BLKCNT + JMS I [PCRLF + TAD (TLINE + JMS I (OLINE + TAD (STLINE + JMS I (OLINE /OUTPUT TITLE AND SUBTITLE + TAD I RLEN /1ST SYM +LOP10, DCA GPTR + TAD GPTR /ANY MORE IN + SZA /THIS BUCKET ? + JMP JOUSYM /YES + ISZ RLEN /NXT BUCKET + ISZ RBLK /DONE ALL + JMP LOP10-1 /NO + ISZ SWITZ /BEEN HERE BEF? + JMP DUNMP /YES ALL DONE + CLA CMA /SET FOR JUST + DCA RBLK /POUND SYMS + TAD SVMAIN + SNA /DO ONLY #MAIN? + JMP LOP10-1 /NO - DO ALL # SYMBOLS +PRMAIN, CLA /** REPLACED WITH JMS I (OUTSYM ** + DUNMP, TAD [-4 /OUT PUT + DCA TMP5 /THE HIGHEST LOCATION + TAD A1 /USED BY THE PROGRAM + TAD (4060 /FLD BITS + JMS HAFWD + TAD A1+1 + JMS I (CVRT + TAD (HLINE + JMS I (OLINE /PRINT " = HIGHEST LOC USED" + JMS I (PROVLY /PRINT OVERLAY TABLE +SM600, CLA /** AC NOT 0 ON RETURN** + TAD (214 + JMS I PPACK + TAD (232 /CTRL Z +OUFILP, JMS I PPACK + TAD BLKCNT /HAVE WE FILLED + TAD [600 /A BLOCK UP COMPLETELY? + SZA CLA + JMP OUFILP /NO + CDF /CLOSE SYMMAP + TAD I (SYLST /AC=LENGTH + DCA SMPCLN + TAD I (LDRNAM+5 /MAP UNIT + CIF 10 + JMS I USR + 4 + LDRNAM+6 +SMPCLN, 0 + JMS I [OS8ER +NOMAP, CDF 10 + JMP I SYMMAP +JOUSYM, JMS I (OUTSYM + TAD I GPTR /NEXT SYM TO DO + JMP LOP10 + HAFWD, 0 /OUTPUT THE 2 6 BIT ASCII CHARS IN AC + DCA TMP3 + TAD TMP3 /LEFT HALF 1ST + RTR + RTR + RTR + JMS SIXTO8 + TAD TMP3 + JMS SIXTO8 + JMP I HAFWD + +SIXTO8, 0 /CVRT AC FROM + AND [77 /6 TO 8 BIT ASCII + SZA + TAD [240 /TURN ZEROS TO BLANKS + AND [77 + TAD [240 + JMS I PPACK /PUT IN BUFF IN PS/8 FORMAT + JMP I SIXTO8 + +ENTERR, DCA I (DOMAP /CANCEL SYMBOL MAP FROM RTNOS8 + JMS I [RTNOS8 /AS WE MASY HAVE COME FROM SYMMAP + ENTMSG + PAGE + /PACK ASCII IN AC INTO OUTPUT BUFF IN +/OS/8 3 WORD FORMAT TO 2 12 BIT WORDS + +PACK, 0 + ISZ FATAL /3RD WORD ? + JMP ONEOR2 /NO + DCA TMP0 /SAVE CHAR + AC7776 /BU BUFF PTR + TAD TMP4 + DCA TMP4 + AC7775 + DCA FATAL /RESET CNTR + JMS ROL /POSITION HI + DCA I TMP4 + ISZ TMP4 + JMS ROL /POSITION LO +ONEOR2, DCA I TMP4 + ISZ TMP4 + ISZ BLKCNT /BLOCK FULL ? + JMP I PACK /NO + JMS WRBUF + TAD SBPTR + DCA TMP4 /RESET ARGS + TAD (-600 + DCA BLKCNT + JMP I PACK + +ROL, 0 + TAD TMP0 /3RD CHAR + RTL /POSITION + RTL /BITS + DCA TMP0 /SAV FOR NXT CALL ON LO + TAD TMP0 + AND [7400 + TAD I TMP4 /ADD IN OLDY + JMP I ROL + +WRBUF, 0 /WRITE OUT + CDF /SYM MAP + JMS I [IOHAN /BUFFER + SMAPU /ADDR OF SYM U + 200^1!4000!10 /1 BLK OF FLD 1 +SBPTR, 7000 /1ST ADDR +SYLST, 0 /REL BLK + CDF 10 + JMP I WRBUF + CVRT, 0 /CONVERT AC TO + DCA CVRTMP /ASCII NUM + TAD TMP5 /-NUM OF DIGITS + DCA TMP1 /TO CONVERT +LOP7, TAD CVRTMP /CVRT LEFT TO + RTL /RIGHT + RAL /3 BITS PER + DCA CVRTMP /DIGIT + TAD CVRTMP + RAL + AND [7 + TAD (260 + JMS I PPACK + ISZ TMP1 /ENOUGH ? + JMP LOP7 /NO + JMS I (HAFWD /OUTPUT A PAIR + JMP I CVRT /OF SPACES + +OUTSYM, 0 /DO ONE SYMBOL + DCA NDX1 /ADDRESS IN AC ON ENTRY + AC7775 + DCA TMP2 + TAD I NDX1 /SYMBOL IS 1ST + JMS I (HAFWD + ISZ TMP2 + JMP .-3 + TAD I NDX1 /SAVE + DCA GTYP /TYPE + TAD I NDX1 /FLD OF SYMBOL + JMS PR15 + JMS CVLOVL /CONVERT ADDR, LEVEL, OVERLAY + TAD GTYP /NOW DO TYPE + AND (17 /ITS B8-B11 + TAD (TYTBL-1 /PTR TO TBL OF + DCA TMP0 /CHAR PAIRS FOR + CDF 0 + TAD I TMP0 /TYPE EG EX FOR + CDF 10 + JMS I (HAFWD /EXTERN + TAD GTYP /IF ERROR WAS + SPA CLA /FOUND DURING PASS2 B0 OF TYPE=1 EG ILLEGAL SUBR CALL. * ON MAP INDICATES + TAD (12 /PASS2 ERROR + TAD [240 + JMS I PPACK + JMS PCRLF + JMP I OUTSYM + +CVRTMP, 0 + CVLOVL, 0 + CLA CMA + DCA TMP5 /DO LEVEL NUM + TAD GTYP /ITS B1-B3 OF + RAL /OF TYPE WORD + JMS CVRT + AC7776 /DO OVER NUM + DCA TMP5 /ITS B4-B7 OF + TAD GTYP /TYPE WORD + RTL /POSITION INTO + AND (1700 /HI 2 DIGITS + JMS CVRT + JMP I CVLOVL + +PCRLF, 0 + TAD (215 /EOL + JMS I PPACK + TAD (212 + JMS I PPACK + JMP I PCRLF + +PR15, 0 + AND [7 + TAD (4060 + JMS I (HAFWD + TAD [-4 /NOW DO ADDR OF + DCA TMP5 /SYMBOL + TAD I NDX1 + JMS CVRT + JMP I PR15 + PAGE + /PASS 2 OF LOADER - TRANSFORMS BINARIES INTO LOADER IMAGE FILE + +PASS2, DCA LNONUM /SET FOR MAIN + JMS I (BLDTV /BUILD TRAP VECTOR + TAD LBCNT /PROCESS LIBR + CIA /MODULES 1ST + SNA /ANY TO DO? + JMP BY12 /NO + DCA LBCNT /=-NUM TO DO + TAD LBPTR /PTR TO 1ST + DCA RFPTR1 /LIBR MOD + JMS SETREF /INIT RELOC ARGS AND PROCESS TXT + TAD [3 /ADV TO NXT + TAD RFPTR1 /LIBR MOD. + DCA RFPTR1 + ISZ LBCNT /DONE LIBR? + JMP .-5 /NO +BY12, JMS I (SETCNT /SET ARGS TO PROCESS USER MODS. + JMS SETREF /DO 1 MOD + JMS I (ADVOVR /ADVANCE ARGS + JMP .-2 /RTN HERE IF MORE TO DO + JMS I (WRALL /WRITE OUT ALL THE RESIDENT BIN BLOCKS + /END OF PASS 2 - RETURN TO OS8 OR CHAIN TO RSYS + + TAD (7616 + DCA NDX0 + TAD I (LIMGU /SAVE UNIT AND BLOCK OF LOADER IMAGE + DCA I NDX0 /FILE IN CD AREA IN CASE WE CHAIN + TAD I (LIMGU+2 + DCA I NDX0 /TO THE RUN-TIME-SYSTEM + DCA I NDX0 /A PRECAUTION + CDF 0 + CIF 10 + JMS I USR + 10 /LOCK USR IN + TAD (200 + DCA USR + TAD I (LDRNAM + CIF 10 + JMS I USR + 4 + LDRNAM+1 /CLOSE LOADER IMAGE FILE +LDCLEN, 0 + JMS I [OS8ER /OOPS! + JMS I (SYMMAP /PRINT SYMBOL TABLE IF REQUESTED + TAD I (OS8SWS + CDF 0 + AND (40 /TEST /G SWITCH + SNA CLA + JMP I [7605 /NOT ON - RETURN TO OS8 + CLA IAC +CHAIN, CIF 10 + JMS I USR +CHCODE, 2 + RTSNAM /LOOKUP RTS + 0 + JMP NORTS + TAD (6 + DCA CHCODE /CHANGE LOOKUP TO CHAIN + JMP CHAIN + +NORTS, DCA I (LDRNAM+5 /KILL SECOND STORAGE MAP + JMS I [RTNOS8 + RTSMSG +RTSNAM, 0622;2423;0000;2326 /FRTS.SV + SETREF, 0 + JMS I (RDRLES /GET MODULE ESD TABLE + AC7776 + DCA EPTR +LOP12, JMS I .+4 /GET NXTESD + JMP BY11 /ALL DONE + TAD EPTR /LOOK UP + JMS I [LOOK /SYMBOL + NXTESD + CLA CMA /IGNORE ESD IF + TAD ETYP /ITS AN ENTRY + SNA CLA /POINT + JMP LOP12 /IGNORE + TAD GPTR /PUT ADDR OF + DCA I REFPTR /GST SYM IN + JMP LOP12 /ESD REF. PAGE +BY11, CDF 0 /COMPUTE 1ST + TAD EPTR /TEXT BLK + AND [7400 + CLL RTL + RTL + RAL + IAC + DCA I (TXTBLK + CLA CMA /SET CNT TO -1 + DCA BLKCNT /TO KICK OFF 1ST TXT READ + TAD RFPTR1 /PTR TO + DCA I (TXTBLK-3 /RALF MOD + CDF 10 + JMS I (TXTSCN /RELOCATE + JMP I SETREF /TEXT + PAGE + BLDTV, 0 /BUILD UP + TAD TRPCNT /TRAP VECTOR + SNA CLA /ANY TO DO? + JMP I BLDTV /NO + TAD .+2 /GET BASE + JMS I [LOOK /ADDR OF + TRPSYM /TRAP VECT + ISZ GPTR + TAD I GPTR + DCA TMP0 + ISZ GPTR + TAD I GPTR + DCA TMP1 + TAD TMP0 /FOR SUBR + DCA TRAPV /TRPVEC + TAD TMP1 + DCA TRAPV+1 + JMS NEWORG /PROCESS NEW ORIGIN + DCA TRPCNT /WILL BE USED TO MARK GST SYMS + TAD .+2 /THAT HAVE A VECTOR ENTRY + JMS I [LOOK /GET SWAPPER + SWPSYM /ADDR + ISZ GPTR + ISZ GPTR + TAD I GPTR + DCA RFPTR1 + TAD SYMTM3 /SCAN GST +LOP11, DCA GPTR /FOR ALL + JMS I [GETTYP /TRAP SYMS + JMP I BLDTV /ALL DONE + TAD I GPTR /IF TYPE WD + SMA CLA /B0=1, THEN SYMBOL NEEDS A VECTOR ENTRY + JMP LOP11+1 /TRY NEXT 1ST WD OF ENTRY IS + TAD (3000 /TRAP3 + JMS I [PUTBIN + TAD RFPTR1 /NXT IS + JMS I [PUTBIN /SWAP ADDR + CLL CML CLA RAR /CLR B0 + TAD I GPTR /OF TYPE WD + DCA I GPTR + TAD I GPTR + ISZ GPTR + RTL + RTL + DCA TMP0 /HAVE TO MUSH SOME BITS AROUND: + TAD TMP0 /OVERLAY NUMBER MOVES FROM B4-7 TO B0-3 + AND [7400 + DCA TMP1 /LEVEL NUMBER MOVES FROM B1-3 TO B6-8 + TAD TMP0 + RTL + RTL + AND (70 + TAD TMP1 + TAD I GPTR /ADD FLD BITS TO MESS + JMS I [PUTBIN + TAD TRPCNT /ADV VECT + TAD (10 /ENTRY NUM + DCA TRPCNT /COUNTER + TAD I GPTR /TAG HI 9 + TAD TRPCNT /OF GST SYM + DCA I GPTR /WD5 WITH TV ENTRY NUMBER + ISZ GPTR + TAD I GPTR /ENTER + JMS I [PUTBIN /ADDR + AC7776 + TAD GPTR + JMP LOP11 /FOR THIS SYM + NEWORG, 0 + TAD BSECTP + JMS I [SETEPT /SET PTR TO CURRENT SECTION + TAD I EPT2 + CIA CLL + TAD TMP1 + DCA TMP3 + TAD TMP3 + AND (6000 + DCA TMP2 /DO A DOUBLE PRECISION SUBTRACT + CML RAL + TAD I EPTR + CIA CLL + TAD TMP0 + SPA + JMP BADORG /OUT OF RANGE + CLL RAR + TAD TMP2 /COMBINE AND SHIFT RIGHT 8 + RAL + RTL + RTL /(I.E. LEFT 5) + DCA TMP2 + TAD TMP2 + ISZ EPT2 + TAD I EPT2 /ADD TO RELATIVE BLOCK OF SECTION + DCA NEWBLK + ISZ EPT2 + TAD TMP2 + CIA + TAD I EPT2 + SPA + JMP BADORG /ORIGIN OUT OF RANGE + DCA NEWLEN + JMS I (NEWBB /GET BUFFER USING NEWBLK AND NEWLEN + TAD TMP3 + AND (1777 + TAD BLKBEG + DCA BLKSIZ /FORM POINTER INTO PROPER BUFFER + JMP I NEWORG +BADORG, JMS I [RTNOS8 + ORGMSG /ORIGIN OUT OF CURRENT FILE LIMITS + JMP I NEWORG + PAGE + PROVLY, 0 /ROUTINE TO PRINT OVERLAY INFO IN SYMBOL MAP + JMS I [PCRLF + TAD (OTLINE + JMS I (OLINE + TAD (OVLTBL-1 + DCA NDX1 +PROVLP, TAD I NDX1 /GET ENTRY + SPA /TEBLE ENDS WITH -1 + JMP I PROVLY + DCA GTYP + TAD [240 + JMS I PPACK + JMS I (CVLOVL /PRINT LEVEL AND OVERLAY + TAD GTYP + JMS I (PR15 /PRINT 15-BIT LENGTH + JMS I [PCRLF + JMP PROVLP + +RDRLES, 0 /READ A + TAD RFPTR1 /PTR TO RALF + DCA RLARG-1 /MOD + DCA RLARG+2 /STRT AT BLK 0 + CDF /AND READ + JMS I [IOHAN /3 BLKS INTO + 0 /10000-11400 +RLARG, 200^3!10 + 0 + 0 + CDF 10 + JMP I RDRLES + /STARTING WITH THE LATEST, +/WRITE OUT ALL CORE RESIDENT +/BINARY BUFFERS + +WRALL, 0 + TAD BP + IAC /PTR TO + DCA TMP0 /CURNT BLK + TAD I TMP0 + SNA CLA /ALL DONE ? + JMP I WRALL /YES + AC4000 + JMS I (LDRIO /WRITE IT + TAD I BP + SNA + JMP I WRALL + DCA BP + JMP WRALL+1 + +NOTREL, JMS I [RTNOS8 + RELMSG + +RELMSG, TEXT /BAD INPUT FILE/ + +RTSMSG, TEXT /NO FRTS/ + MERGE, 0 + JMS I (GETTXT /COMBINE TXT + DCA FTMP0 /PAIR WITH + JMS I (GETTXT /PAIR WHOSE + DCA FTMP0+1 /ADDR IS IN BPTR + CLL + TAD I BPT2 + TAD FTMP0+1 + DCA TMP1 + RAL + TAD I BPTR + TAD FTMP0 + AND [7 + DCA TMP0 + TAD FTMP0 /GET THE OPCODE OR WHATEVER + AND [7770 /IS IN THE HIGH 9 BITS + TAD TMP0 /AND COMBINE THEM WITH THE RELOCATED ADDRESS + JMS I [PUTBIN /AND OUTPUT THE MESS + TAD TMP1 + JMS I [PUTBIN /DON'T FORGET WORD 2 + JMP I MERGE + +GETCTL, 0 /GET TEXT + JMS I (GETTXT /CTRL WORD + DCA TMP0 /B4-B11 + TAD TMP0 /IS TYPE + AND [377 /INDICATOR + DCA REFPTR /SOMETIMES + TAD REFPTR /ITS AN ESD. + TAD (ESDPG /WHEN IT IS, + DCA GPTR /GPTR PNTS + TAD I GPTR /TO THE + DCA GPTR /CORRESPONDING GST SYM (WORD 4) + JMS I [SETBGX /AND BPTR POINTS TO THE VALUE + TAD TMP0 /TEXT TYPE + RTL /IS IN + RTL /B0-B3 + RAL /PUT IN + AND [17 /AC8-AC11 + TAD GETCTL + DCA GETCTL /USE IT TO BUMP RETURN ADDRESS + JMP I GETCTL + PAGE + /COME HERE ON ORIGIN OR WHEN CROSSING +/AN AREA BOUNDARY TO SELECT A BINARY +/CORE BUFFER FOR A NEW LOADER IMAGE +/AREA. THE BINARY BUFFER TABLE +/ASSOCIATES CORE BUFFERS TO LOADER +/IMAGE AREAS. + +/EACH ENTRY HAS FOUR WORDS - THEY CONTAIN: + +/WORD 1 POINTER TO BUFFER OF NEXT EARLIEST REFERENCE +/WORD 2 RELATIVE BLOCK NUMBER (0 IF UNUSED) +/WORD 3 NUMBER OF BLOCKS LEFT UNTIL END OF SECTION +/WORD 4 BUFFER ADDRESS AND FIELD + +/EACH ENTRY MAPS FROM 1 TO 4 BLOCKS (400 TO 2000 OCTAL WORDS) FROM THE +/ADDRESSES GENERATED BY THE LOADER ONTO THE LOADER IMAGE FILE. +/THE RELATIVE BLOCK NUMBERS ARE ALWAYS OF THE FORM S+4N, WHERE +/S IS THE RELATIVE BLOCK NUMBER OF THE NEAREST BINARY SECTION +/ (A BINARY SECTION IS AN OVERLAY OR "MAIN"). + +/THE BUFFERS ARE ORGANIZED AS A CHAIN IN ORDER OF REFERENCE, +/WITH WORD 1 BEING THE LINK TO THE NEXT EARLIEST BUFFER. IN CASE +/A BUFFER NEEDS TO BE WRITTEN THE CHAIN IS TRAVERSED AND THE LAST BUFFER +/WRITTEN OUT, SINCE IT WAS THE LEAST RECENTLY ACCESSED. + NEWBB, 0 /ENTER WITH NEW + TAD BP + DCA NDX5 /SAVE CURRENT "MOST RECENT" BUFFER + TAD I NDX5 + CIA + TAD NEWBLK /CHECK WHETHER THE BUFFER WE WANT + SNA CLA /IS THE CURRENT BUFFER + JMP QUIKIE /YES - SAVE GRIEF +NEWBB4, TAD BP /MAKE THE CURNT + DCA BPPREV /BUFFER THE PREVIOUS BUFF + TAD I BP /MAK THE BUF OF + DCA BP /NEXT EARLIEST REFERENCE THE NEW CURNT BUFF + TAD BP /GET THE PTR TO + IAC /LDR IMAGE BLK + DCA CURBLK /IN THIS BUFF + TAD I CURBLK /HAVE WE SCANNED + CIA /IS NEWBLK + TAD NEWBLK /IN CORE + SNA CLA /? + JMP GOTBLK /YES + TAD I BP /ARE WE AT THE + SZA CLA /BUFFER OF EARLIEST REF? + JMP NEWBB4 /NO DO NEXT + STL /INITIALIZE LINK AS FLAG + TAD I CURBLK /IS THERE A + SNA CLA /BLK TO WRITE? + JMP VIRGIN /NO - NONE TO READ, EITHER + AC4000 + JMS I (LDRIO /YES WRITE IT + CLL /SET FLAG THAT BUFFER WAS WRITTEN +VIRGIN, TAD NEWBLK + DCA I CURBLK + ISZ CURBLK + TAD NEWLEN /STORE NEW BLOCK # AND LENGTH + DCA I CURBLK /IN BUFFER CONTROL WORD + RAR /GET "VIRGIN FLAG" + DCA NEWBUF + TAD MAXBLK + CMA CLL + TAD NEWBLK /CHECK IF THE BLOCK WE'RE MAPPING + SNL CLA /IS LARGER THAN ANY OTHER SO FAR - + JMP .+3 /IF SO WE DON'T HAVE TO READ IT + TAD NEWBLK + DCA MAXBLK /UPDATE MAXBLK + TAD NEWBUF /LINK = MAX FLAG, SIGN = VIRGIN FLAG + SNL SMA CLA /IF NEITHER IS ON, + JMS I (LDRIO /READ THE BLOCKS INTO THE BUFFER +GOTBLK, TAD I BP + DCA I BPPREV /BREAK NEW BUFFER OUT OF THE CHAIN + STA + TAD NDX5 /NDX5 CONTAINS PTR TO OLD "MOST RECENT" + 1 + DCA I BP /MAKE NEW BUFFER THE BUFFER OF LATEST REFERENCE +QUIKIE, JMS NEWBUF /SET UP FOR PUTBIN + JMP I NEWBB /AND RETURN + /COME HERE TO CUMPUTE A 15 BIT +/BUFFER ADDRESS FROM AN ENTRY +/IN THE BINARY BUFFER TABLE. + +NEWBUF, 0 + TAD [3 + TAD BP + DCA OUTFLD + TAD I OUTFLD /LOAD ADRESS AND FIELD + AND (7600 + DCA BLKBEG + TAD I OUTFLD + AND (70 + TAD (CDF + DCA OUTFLD /DECOMPOSE INTO ADDRESS AND CDF + JMP I NEWBUF + +BPPREV, 0 +MAXBLK, 0 + /COME HERE TO STORE 1 WORD +/IN SOME BINARY OUTPUT BUFFER + +PUTBIN, 0 + DCA TMP2 /SAVE DATA + TAD ORGFLG /N.E. 0 MEANS + SZA CLA /INHIBIT + JMP I PUTBIN /BINARY OUTPUT BECAUSE OF NEW ORIGIN + TAD OUTINH /N.E. 0 MEANS + SNA CLA /INHIBIT BIN OUT BECAUSE OF BAD ORIGIN + JMP OUTFLD /ITS OK + TAD I OUTINH /SET B0 OF + RAL /OFFENDING GST + CLL CML RAR /SYMBOL + DCA I OUTINH /SEE SUBR REORG + JMP I PUTBIN /FOR DEFINITION OF C(OUTINH) +OUTFLD, 0 /CDF X + TAD TMP2 /STORE IT + DCA I BLKSIZ /AWAY + CDF 10 /RESTORE FLD + ISZ BLKSIZ /BUMP PTR + TAD BLKBEG + CIA + TAD BLKSIZ /HAVE WE + AND (1777 /CROSSED A + SZA CLA /BLK BOUND? + JMP I PUTBIN /NO + TAD NEWBLK + TAD [4 + DCA NEWBLK + TAD NEWLEN + TAD [-4 + DCA NEWLEN /BUMP BLOCK NUMBER AND REMAINING BLOCKS + JMS NEWBB /SELECT A NEW BUFFER + TAD BLKBEG + DCA BLKSIZ /RE-INITIALIZE WORD POINTER + JMP I PUTBIN +CURBLK, 0 + PAGE + /COME HERE TO SCAN AND RELOCATE +/THE TEXT OF AN ENTIRE MODULE + +TXTSCN, 0 /SET CTRL WD + JMS I (GETCTL /ARGS. RTN TO .+1,2,3, OR 4 + JMP RELC2 /SPECIAL TYPE + JMP RELC6 /DIRECT COPY + JMP REORG /NEW ORIGIN + TAD I GPTR /RELOCATE FPP + AND [17 /PAIR + DCA TMP0 /GST SYM TYPE + AC7776 /IS RELOCATION + TAD TMP0 /WITH RESPECT + SZA CLA /TO GST EXTERN? + JMP BY2 /NO +SETTRP, JMS GETTXT /BAD TEXT. + CLA + JMS GETTXT /IGNORE RELOCATION AND MAKE AN ERROR TRAP + CLA + TAD (3000 /=TRAP3 + JMS I [PUTBIN + TAD (JUERR /RTS ERROR + JMS I [PUTBIN /TRAP SUBR +BY2M5, TAD I GPTR /SET ILLEGAL + RAL /REFERENCE + CLL CML RAR /BIT IN + DCA I GPTR /GST TYPE WD + JMP TXTSCN+1 /DO NEXT +BY2, TAD (-5 /RELOCATE TO + TAD TMP0 /A MULTIPLE + SNA CLA /ENTRY? + JMP SETTRP /YES + TAD I GPTR /CHECK FOR LEGALITY OF REFERENCE + AND (0360 /WITH RESPECT TO LEVEL AND OVERLAY NUMBER + DCA TMP1 / = GST OVER NUM + TAD LNONUM /=CURNT MOD + AND [3400 /LEVEL NUM + DCA TMP2 + TAD I GPTR + AND [3400 + SNA /RELOCATE TO MAIN? + JMP RELC /YES, ITS OK + CIA /IS RELOCATION + TAD TMP2 /ACROSS LEVELS + SZA /? + JMP TSTTRP /YES + TAD LNONUM /=CURRENT MOD + AND (0360 /OVER NUM + CIA + TAD TMP1 /WITHIN LEVL CALL IS LEGAL ONLY + SNA CLA /IF WITHIN OVR ALSO. + JMP RELC /ITS OK + /** TSTTRP REPLACED BY "SKP CLA" IF /U SPECIFIED +TSTTRP, SMA CLA /NOT OK - IS X LEVL LO TO HI? + JMP SETTRP /NO + TAD I BPTR /TRAP VECT + TAD [7770 /SUBTRACT 1 FROM ENTRY NUM + AND [7770 /IN HIGH 9 BITS OF GST WD 5 + CLL RAR /DIV BY 2 TO GET ENTRY NUM * 4 + TAD TRAPV+1 /LINK IS 0 + DCA I (SYMX+1 /STORE VECTOR ENTRY ADDRESS + RAL + TAD TRAPV /IN SYMX AS A DOUBLEWORD + DCA I (SYMX + TAD (SYMX + JMS I [SETBPT /COMBINE IT WITH TXT PAIR + JMS I (MERGE /I.E. RELOCATE TO TRAP VECT + TAD FTMP0 + AND [7 + SNA + TAD FTMP0+1 + SNA CLA /WERE LOW ORDER 15 BITS OF TXT=0? + JMP TXTSCN+1 /YES, ITS OK + JMP BY2M5 /SET ILL REF BIT. NOTE TRAP IS NOT GENERATED + +RELC, JMS I (MERGE /MAKE FPP PAIR AND STORE IN BIN BUFFER + JMP TXTSCN+1 /DO NEXT +RELC2, TAD REFPTR /CHK IND. + SNA CLA /FOR SPECIAL TYPE + JMP I TXTSCN /0=END OF TEXT + JMP TXTSCN+1 /1=IGNORE 1 WORD OF TEXT +RELC6, TAD REFPTR /IND HOLDS + CIA /NUM OF WDS + DCA REFPTR /TO COPY + JMS GETTXT + JMS I [PUTBIN + ISZ REFPTR + JMP .-3 + JMP TXTSCN+1 +REORG, ISZ ORGFLG /SET INHIBIT BIN OUT FLG + JMS I (MERGE /GET NEW ORIGIN + TAD I GPTR /SEE IF + AND (3760 /ORIGIN IS + CIA /TO A DIFFERENT + TAD LNONUM /BINARY SECTION + SZA CLA /? + TAD GPTR /YES - SET INHIBIT/ERROR FLAG + SNA + JMS I (NEWORG /NO - SET UP NEW ORIGIN + DCA OUTINH + DCA ORGFLG + JMP TXTSCN+1 + GETTXT, 0 /GET ONE WORD OF TEXT FROM THE BUFFER + ISZ BLKCNT + JMP RDTCDF + CDF /TO READ IN + JMS I [IOHAN /RALF TEXT + 0 /PTR TO UNIT + 200^4!10 /OR 200^17!20 + 0 +TXTBLK, 2 + TAD .-2 /SET TXT + DCA RBLK /BUF PTR + TAD TXTWDS /-NUM OF + DCA BLKCNT /WDS-1 IN +RDTCDF, CDF 10 /OR CDF 20 + TAD I RBLK + CDF 10 + ISZ RBLK + JMP I GETTXT /RETURN +TXTWDS, -2000 /OR -7400 + PAGE + /ENTER A SYMBOL INTO GST. PTR TO ESD +/SYMBOL IS IN AC + + JMP I PUTSYM /FOR XPAGE RTN +PUTSYM, 0 + JMS I [LOOK /LOOKUP SYMBOL + JMP I (NOMAT /NEW SYMBOL DISPOSITION +/TYPE OF MATCH 2 EXTERNS, 2 COMMONS, ETC. +/ETYP HOLDS SYM TYPE FOR ESD GTYP HOLDS GST TYPE + + TAD (5 + DCA TMP0 /FOR ME,MS + TAD ETYP + TAD (-7 + SPA + TAD (2 + TAD [4 + RAR CLL + CMA + DCA TMP2 + CML CMA /GET -1 + TAD GTYP /RESTR LNK, GET GST TYP-1 + RAL + TAD (MYSTIC /GET ADDR OF 4 CODES + DCA TMP1 + CDF 0 + TAD I TMP1 /GET 4 CODES + CDF 10 +CTST, ISZ TMP2 /WHICH CODE ? + JMP SHFT3 /NOT THIS 1 + AND [7 + TAD T2J /PICK UP JMP I + DCA .+1 + 0 +T2J, JMP I .+1 + ISCOM3 /FORT COMM N FLD1 SECTION + PUTSYM-1 /ESD IS EXT JUST EXIT + REP /GST IS EXT GO REPLACE + MULENT /MULTIPLE ENTS + ISCOM /2 F COMMS OR 2 COMMZS OR 2 FLD1S + BADDY /MULTIPLE SECTS + BADDY /UNDEF TYPES + BADDY + BADDY +SHFT3, RAR + RTR + JMP CTST + BADDY, TAD MCNT + TAD MBGCNT + DCA MTMCNT /SAVE PARAMS FOR ERROR MESSAGE LATER + CLA IAC + TAD LNONUM /MULTIPLE SECTION + DCA FATAL + ISZ TMP0 /IS FATAL +MULENT, TAD I GPTR /SET TYPE TO + AND (7760 /5 FOR MUL ENT + TAD TMP0 /OR 6 FOR + DCA I GPTR /MUL. SECTION + JMP I PUTSYM + +ISCOM3, TAD (11 /F COMM N FLD1 (RITE9=11) + DCA I GPTR /SET TYP TO F1 + ISZ F1FLG +ISCOM, JMS I [SETBGX + TAD BPTR /UPDATE + DCA I REFPTR /ESD REFERENCE PTR + JMS I (MAXCOM /PUT LARGER OF 2 COMMONS INTO + JMP I PUTSYM /GST WORDS 5 AND 6 +MTMCNT, 0 + /THE FOLOWING TABLE IS USED TO +/DISPOSITION SYMBOL MATCHES BETWEEN +/A RALF ESD AND A GST SYMBOL +/EACH DIGIT IN THE TABLE IS AN INDEX +/INTO A TABLE THAT IS USED TO CALL +/ROUTINES TO HANDLE THE VARIOUS TYPES +/OF MATCHES: +/ 0=FORT COMMON AND FLD1 SECTION +/ 1=ANY MATCH WITH ESD EXTERN +/ 2=ANY MATCH WITH GST EXTERN +/ 3=MULTIPLE ENTRY POINTS +/ 4=2 FORT COMMONS OR 2 FIELD1 +/ SECTIONS OR 2 COMMZ SECTS +/ 5=MULTIPLE SECTIONS +/ 6-7=UNDEFINED AND HALT +/ +/THE FIRST 2 WORDS COVER ALL POSSIBLE +/MATCHES WITH GST TYPE 1, THE SECOND +/TWO WORDS ARE FOR GST TYPE 2 ETC +/THE 4 DIGITS IN THE FIRST WORD OF +/ANY PAIR CORRESPOND TO ESD TYPES +/11,7,3,1 RESPECTIVELY +/ESD CORRESPONDENCE FOR THE 2ND WORD +/IS 12,10,4,2 +/ESD TYPE 12 IS UNDEFINED + +MYSTIC, 5553 /G1 E(11,7,3,1) + 7551 /E(12,10,4,2) + 2222 /G2 E(11,7,3,1) + 7221 /E(12,10,4,2) + 0545 /G3 + 7551 + 5555 /G4 + 7551 + 5553 /G5 + 7551 + 5555 /G6 + 7551 + 5555 /G7 + 7551 + 5555 /G10 + 7451 + 4505 /G11 + 7551 + +ESDSCN, 0 + CLL STA RTL /-3 + TAD I (0 + SZA CLA + JMP I (NOTREL /NOT RALF MODULES - NASTY! + TAD I (2 /CHK FOR DP + SPA CLA /HARDWARE REQUIRED + ISZ DPFLG /ISZ=YES + AC7776 /ENTER ESD OF MODULE + DCA EPTR /INTO GST. ESD STARTS AT 10000 + JMS I (NXTESD /GET NXT 1 + JMP I ESDSCN /NO MORE + TAD EPTR + JMS PUTSYM /ENTER IT + JMP .-4 /DO ANOTHER + +MSMSG, TEXT /MULT SECT/ +CORMSG, TEXT /OVER CORE/ +LIMSG, TEXT /OVER IMAG/ +MNMSG, TEXT /NO MAIN/ + PAGE + /CONTINUATION OF SUB PUTSYM + +REP, DCA GTYP + AC7775 /REPLACE GST + TAD ETYP /EXTERN + SNA /IS IT A REF TO COMMON? + JMP MNSECN /YES + TAD M4 /IS IT A REF + SMA CLA /8 MODE SECN ? + JMP NOMAT + TAD I GPTR /NO CHK FOR + AND [3400 /CROSS LEVEL + CIA /REFERENCE + DCA TMP0 /COMPARE WITH + TAD LNONUM /CURNT LEVEL + AND [3400 + SNA /DOING MAIN ? + JMP NOMAT /YES DONT CHK FOR TRAP ENTRY + TAD TMP0 + SNA CLA /X LEVEL? + JMP NOMAT + ISZ TRPCNT /YES BUMP TRAP VECTOR COUNTER + AC4000 /SET B0=1, GST SYM WILL GO IN TRAP VECTOR +NOMAT, DCA GTYP + TAD ETYP /ENTER GST + TAD (.+3-1 /WORDS 4,5,6. + DCA TMP0 /DISPATCH ESD + JMP I TMP0 /TYPE 1,2,3,4 + JMP ENTMN2 /ENTRY POINT + JMP ENTMN /EXTERN + JMP MNSECN /COMMON SECN + JMP PRGSCN /PROGRAM SECN +M4, -4 +M7, -7 + JMP MNS8 /GEN 8 MODE SCT + JMP MNCZ /COMM 8 MODE + JMP MNF1 /FLD1 8 MODE + PRGSCN, TAD LNONUM + AND [3400 /IS IT A MAIN + SNA CLA /? + JMP MNSECN /YES + TAD I [OVRSIZ + DCA TMP0 + TAD I [OVRSIZ+1 + DCA TMP1 /SAVE OLD OVERLAY SIZE + CLL + TAD I EPT2 + TAD TMP1 + DCA I [OVRSIZ+1 + RAL + TAD I EPTR + TAD TMP0 + DCA I [OVRSIZ /SET OVLY SIZE = OVLY SIZE + SECTION SIZE + TAD TMP0 + DCA I EPTR + TAD TMP1 + DCA I EPT2 /SET SECTION SIZE = OLD OVERLAY SIZE + TAD GPTR /PUT ADDR OF + IAC /GST WD5 OF + DCA I REFPTR /SECTION SYM INTO ESD REFERENCE PAGE +ENTM2, TAD [LVPTR /SET REFERENCE + DCA REFPTR /TO PARENT SYM =WD5 OF #YLVLN +ENTMN, TAD LNONUM /=CURNT OVRLAY AND CURNT LEVEL NUM + JMP MNSEC5 + ENTMN2, TAD LNONUM /SEE IF ENTRY + AND [3400 /POINT IS IN + SNA CLA /MAIN? + JMP ENTMN /YES + TAD I REFPTR /IS PARENT + JMS I [SETBPT /REFERENCE TO + CLA CMA /COMMON? + TAD REFPTR /LOOK FOR + DCA TMP0 /TYPE CODE 3 + AC7775 + TAD I TMP0 + SNA + JMP ENTMN /YES, HANDLE LIKE A MAIN ENTRY POINT + TAD M4 /IS IT A REF + SNA CLA /TO AN 8 SECT? + JMP MNSEC5 /YES HANDLE LIKE MAIN + CLL + TAD I BPT2 + TAD I EPT2 + DCA I EPT2 /SET OVR ENT = OVR ENT + OVR + RAL + TAD I BPTR + AND [7 /WATCH HIGH-ORDER BITS + TAD I EPTR + DCA I EPTR + JMP ENTM2 /SIZE OF SECTION +MNF1, ISZ F1FLG /SET FOR NE TO + JMP MNSECN /0 SO DO8S WILL +MNCZ, ISZ CZFLG /KNOW THESE + JMP MNSECN /TYPES OF SECTS + MNS8, ISZ S8FLG /EXIST AND WILL FIT THEM INTO CORE +MNSECN, TAD GPTR /PUT ADDR OF + IAC /GST WD5 OF + DCA I REFPTR /SECTION SYM INTO ESD REFERENCE PAGE + TAD (SYMX+1 /THIS VALUE + DCA REFPTR /YIELDS 0 IN HI 9 WD 5 OF GST SYM +MNSEC5, TAD ETYP /SYM TYPE TO AC8-11. AC MAY HAVE + TAD GTYP /LEVEL AND OVR BITS (AC1-7) ALREADY SET + DCA I GPTR /GST WD4 HOLDS SYMBOL TYPE + JMS I [SETBGX /SET BPTR TO GST WORD + DCA TMP0 /PREPARE FOR DIVISION BY 7 + TAD I REFPTR + TAD (2-SYMTBL /GET OFFSET FROM SYMTBL + TAD M7 + ISZ TMP0 + SMA + JMP .-3 /DIVIDE BY REPEATED SUBTRACTION + STA /AC IS NOT NECESSARILY ZERO! + TAD TMP0 + CLL RTL /ROTATE SYMBOL NUMBER INTO AC BITS 0-8 + RAL + TAD I EPTR /AND INSERT IT INTO THE ADDRESS + DCA I BPTR /DOUBLEWORD TO FORM THE GST + TAD I EPT2 /ADDRESS DOUBLEWORD + DCA I BPT2 + JMP I .+1 + PUTSYM-1 + PAGE + STPAS1, DCA I NDX0 /ZERO OUT GST + ISZ STCNT /NDX0 SET UP BY PASS0 + JMP STPAS1 + JMS I (SETCNT /SET MOD CNTS + JMS I (RDRLES /READ A RALF ESD + JMS I (ESDSCN /PROCESS IT + JMS I (ADVOVR /UPDATE COUNTS + JMP .-3 /DO NEXT + TAD LIBRSW + SNA CLA /LIBRARY SEARCH POSSIBLE? + JMP I (DOCORE /NO - SKIP IT + TAD SYMTM3 /TOP OF + DCA GPTR /GST + TAD RFPTR1 /1ST FREE + DCA LBPTR /ENTRY IN MODULE TBL THIS IS WHERE LIBR MODULES WILL GO + JMS I (GETEXT /GET AN + JMP .+3 /EXTERN +LOP4, JMS I (GETEXT + TAD RESFLG /=1 IF + DCA IOFLG /LIBR CAT IS ENTIRELY CORE RES + DCA LBREC /SET I/O FOR + DCA LSTBLK /BLK 0 OF LIBRARY + DCA RBLK /SET REL BLK + DCA RLEN /AND LENGTH + JMP BY3 /TO 0 +NXTENT, TAD NDX1 /ADV TO + AND [-4 /NXT ENTRY + TAD (2 /BUT GET + DCA NDX1 /LENGTH OF + JMS I (GETLEN /PREV ONE 1ST + ISZ NUMENT /MORE IN CORE? + JMP BY3+1 /YES + TAD IOFLG /END OF + SZA CLA /CATALOGUE? + JMP LOP4 /YES, NO MATCH ON THIS EXTERN +BY3, JMS RDLBR /GET NEXT + TAD [-4 /CAT. BLKS + TAD GPTR /LOOK FOR + DCA NDX0 /LIBR MATCH + AC7775 + DCA TMP0 + LBFLD, CDF 0 /CDF 20 IF GREATER THAN 8K CORE + TAD I NDX1 + CDF 10 + CMA /IS IT THE END + SNA /OF CAT ? + JMP LOP4 /YES + IAC + TAD I NDX0 + SZA CLA /MATCH 1? + JMP NXTENT /NO TRY NXT LIBR ENTRY + ISZ TMP0 /ALL MATCH? + JMP LBFLD /NO + JMS I (GETLEN /UPDATE RBLK, + CLA CMA /RLEN + TAD RFPTR1 /ENTER MOD + DCA NDX0 /INTO TBL + TAD I (MODTBL /LIBR UNIT + DCA I NDX0 + TAD RLEN /LENGTH OF + DCA I NDX0 /MODULE + TAD I (MODTBL+2 /STARTING BLOCK OF LIBRARY, + + TAD RBLK / RELATIVE BLOCK OF MODULE = + DCA I NDX0 / ABSOLUTE BLK OF MOD + ISZ LBCNT /=NUM OF LIBR MOD IN MAIN + TAD GPTR /SAVE GST + DCA LSTBLK /PTR + JMS I (RDRLES /READ IN ESD + DCA LNONUM /SET FOR MAIN + JMS I (ESDSCN /PROCESS ESD + TAD [3 /ADV MODULE + TAD RFPTR1 /TBL PTR + DCA RFPTR1 + TAD LSTBLK + DCA GPTR + ISZ MLEFT /MOD TBL FULL? + JMP LOP4 /NO DO SOME MORE + JMP I (DOCORE + +LIBRSW, 0 /NON-ZERO IF LIBRARY SEARCH POSSIBLE +STCNT, SYMTBL-OVLTBL + RDLBR, 0 + TAD IOFLG /IS THIS + SZA CLA /THE END + JMP ENDLB /OF CAT.? + CDF /NO + JMS I [IOHAN /READ SOME + MODTBL /MORE +LBARG, 200^5 /OR 200^17!20 + LB0BUF /OR 0 +LBREC, 0 /REL CAT BLK + TAD LBREC /GET -NUM OF + CIA /BLKS READ, + TAD LSTBLK /AND COMPUTE + DCA TMP0 /THE NUM OF + TAD (-100 /ENTRIES IN + ISZ TMP0 /CORE. THERE + JMP .-2 /ARE 100 PER + DCA OLDCNT /BLOCK + TAD LBREC /UPDATE + DCA LSTBLK /LSTBLK +ENDLB, TAD OLDCNT + DCA NUMENT + CLA CMA /SET PTR TO + TAD LBARG+1 /1ST ENTRY + DCA NDX1 + CDF 10 + JMP I RDLBR +LSTBLK, 0 +MLEFT, 0 +RESFLG, 1 +NUMENT, 0 +OLDCNT, 0 + PAGE + + /END OF PASS 1 - FIT EVERYTHING INTO CORE + +DOCORE, TAD TRPCNT + SNA CLA + JMP LOP3-3 /NO OVRS + TAD (TRPSYM /ENTER TRAP + JMS I [LOOK /VECT. SYM + TAD [4 /ITS A + DCA I GPTR /MAIN SECN + ISZ GPTR /GST WD6 + ISZ GPTR /HOLDS LENGTH + TAD TRPCNT /GET SIZE OF + RTL CLL /TRAP VECTOR + DCA I GPTR /= NUMBER OF ENTRIES * 4 + JMS I (DO8S /GO DO ALL 8 MODE SECTIONS + TAD SYMTM3 /ALLOCATE + DCA GPTR /CORE FOR +LOP3, JMS I [GETTYP /ALL MAIN NON 8 MODE + JMP DUNMN /SECTIONS + AC7775 /4=PROG + TAD I GPTR /SECN, 3=COMMON + RAR CLL + SNA CLA + JMS I (FIT /GO FIT SECN + JMP LOP3 + DUNMN, STA + DCA I NDX7 /TERMINATE OVERLAY LENGTH LIST + TAD A1 + DCA I (OVLTBL /STORE ENTRY FOR LEVEL 0 + TAD A1+1 + DCA I (OVLTBL+1 + TAD A1+1 + CLL + TAD [377 + AND [7400 + SZL + ISZ A1 /(WATCH CARRY!) + DCA A1+1 /DITTO FOR NON-FIELD 0 + CLA IAC /WILL HOLD + DCA BLKCNT /SIZE OF LOADER IMAGE + TAD (1460 /RESET INT. + DCA I (LEVSYM+2 /#YLVLN SYM + TAD (QUSRLV-1 /WHERE OVRLAY + DCA NDX3 /DSRN INFO GOES IN LHDR + CLA IAC + DCA I NDX3 /USER MAIN IS LEVEL 0 + TAD (10 + DCA I NDX3 /SET UP LOADING INFORMATION FOR USER MAIN + STA /IN THE USRLV TABLE JUST LIKE + TAD A1 /ANY OTHER OVERLAY LEVEL + CLL RAR + TAD A1+1 /LENGTH HAS TO BE COMPUTED FROM + RAL /CORE LENGTH + RTL + RTL + DCA TMP0 + CLA IAC + DCA I NDX3 /USER MAIN FIRST THING IN LDR IMAGE + TAD TMP0 + DCA I NDX3 + TAD TMP0 + LOP6, TAD BLKCNT /UPDATE LENGTH + DCA BLKCNT /OF LDR IMAGE + ISZ I (LEVSYM+2 /NEXT LEVEL + TAD (LEVSYM /LOOKUP + ISZ NLVL + JMS I [LOOK /#YLVLN + JMP DUNLVL /DONE ALL OVR LEVELS + JMS I (FIT /FIT LEVEL + ISZ GPTR /IN CORE + TAD I NDX3 /NUMBER OF OVERLAYS ON THIS LEVEL - ALSO + CIA /SERVES AS AN INDICATOR TO THE RUN-TIME + DCA TMP0 /SYSTEM THAT THIS LEVEL IS INITIALLY + TAD I GPTR /UNINHABITED. + AND [7 /GET FIELD BITS + CLL RTL + RAL + ISZ GPTR + TAD I GPTR /AND ADDRESS BITS + DCA I NDX3 /PUT-EM OUT + TAD BLKCNT /STARTING BLOCK OF LEVEL + DCA I NDX3 + TAD BLKSIZ + DCA I NDX3 /LENGTH OF A SINGLE OVERLAY IN THE LEVEL + TAD BLKSIZ /(NUM OF OVRS)* + ISZ TMP0 /NUM OF BLKS + JMP .-2 /AC=LENGTH OF LEVEL + JMP LOP6 /DO NEXT LEVEL +NLVL, 0 + DUNLVL, CLA /AC NOT ZERO! + TAD SYMTM3 /NOW RESOLVE + DCA GPTR /ALL OTHER SYMBOLS +LP1, JMS I [GETTYP + JMP I (ALLDN1 /ALL DONE + JMS I [SETBGX /SET BPTR TO GST WD5 + TAD I BPTR + AND [7770 + SNA + JMP LP1 /NO RELATIVE SYMBOL - DON'T RELOCATE + DCA EPTR + TAD EPTR /FIGURE OUT THE SYMBOL TABLE ADDRESS + CLL RTR /OF THE RELATIVE SYMBOL BY + STL CMA RAR /TAKING 7 * THE RELATIVE SYMBOL NUMBER + TAD EPTR /IN BITS 0-8 AND ADDING IN THE BASE + TAD (SYMTBL-1 /ADDRESS OF THE SYMBOL TABLE + JMS I [SETEPT + TAD I EPT2 + CLL + TAD I BPT2 + DCA I BPT2 + RAL + TAD I BPTR + AND [7 /THROW AWAY THE OLD RELATIVE SYMBOL # + TAD I EPTR + DCA I BPTR /AND PERFORM THE RELOCATION + JMP LP1 /DO AGAIN + PAGE + ALLDN1, TAD A1 + DCA I (QHGHAD /SAVE HIGHEST PROGRAM ADDRESS + TAD A1+1 /SO THAT RTS WILL KNOW HOW MUCH ROOM + DCA I (QHGHAD+1 /IT HAS FOR BUFFERS & THINGS + TAD FATAL /ANY MULTIPLE + SNA /SECTIONS? + JMP NOMSCT /NO + DCA LNONUM + CDF 0 + TAD I (MTMCNT + DCA MBGCNT /RESTORE ERROR PARAMETERS + CDF 10 + JMS I [RTNOS8 + MSMSG +NOMSCT, TAD (SASYM /GET STRT + JMS I [LOOK /ADDR MAIN + SKP /NO MAIN + JMP .+3 + JMS I [RTNOS8 + MNMSG + TAD SVMAIN /IF .NE. SET TO + SZA /POINT TO GST + TAD GPTR /FOR PND MAIN + DCA SVMAIN /FOR /S THINGS IN SYMMAP RT. + CDF 0 + TAD I (JOUSYM + DCA I (PRMAIN /ENABLING PRINTING OF #MAIN ON ERRORS + CDF 10 + ISZ GPTR + TAD I GPTR /MAKE SWAPPER CONTROL WORD + DCA I (QRTSWP /LEVEL 0, OVERLAY 0 IS MAIN + ISZ GPTR + TAD I GPTR /12 BIT ADDR + DCA I (QRTSWP+1 + TAD DPFLG /N.E. MEANS LDR IMAGE NEEDS DP HRDWRE + DCA I (QDPFLG /RETAIN INFO IN LHDR FOR PASS3 + CDF 0 /FETCH LDR + TAD I (LDRNAM /IMAGE + JMS I [IOHAN /HANDLER + TAD BLKCNT + CLL RTL /SINCE WE KNOW THE LENGTH OF THE + SZL SPA /LDR IMAGE FILE, TELL IT TO THE USR + CLA /(UNLESS ITS >255) + RTL + SZL + CLA + TAD I (LDRNAM /OPEN LDR + CIF 10 /IMAGE + JMS I USR + 3 +LDRBLK, LDRNAM+1 +LDRLEN, 0 + JMP I (ENTERR + TAD BLKCNT /SEE IF LDR + STL /IMAGE WILL + TAD LDRLEN /FIT ON + SZL SNA CLA /TENTATIVE FILE + JMP .+3 /IT FITS + JMS I [RTNOS8 /OUTPUT FILE + LIMSG /TOO SMALL + TAD BLKCNT /CLOSE LDR + DCA I (LDCLEN /IMAGE FILE + TAD (LIMGU-1 /PASS2 + DCA NDX0 + TAD I (LDRNAM + CDF 10 + AND [17 + DCA I NDX0 /UNIT + TAD BLKCNT + DCA I NDX0 /LENGTH + TAD LDRBLK + DCA I NDX0 /STRT BLK + CDF 0 + JMS I [IOHAN + LIMGU /WRITE OUT LOADER IMAGE HEADER BLOCK + 4210 + LHDR + 0 /IN RELATIVE BLOCK 0 OF LOADER IMAGE FILE + CDF 10 + /SET UP TABLE THAT RELATES +/BINARY SECTINS TO LDR +/IMAGE RELATIVE BLOCK NUMS. +/1 DBL WD AND 2 SINGLE-WD ARGUMENTS PER +/SECTION (15 BIT ADDR, RELATIVE +/BLOCK, AND LENGTH). THERE ARE +/8 SECTIONS +/(MAIN, LEVL1,....,LEVL7) +/TABLE STARTS AT LHDR AND +/IS USED BY SUBR NEWORG + + TAD (LHDR-1 + DCA NDX1 + TAD (QUSRLV /NOW DO THE + DCA NDX0 /8 LEVELS + TAD [-10 + DCA TMP0 +SETSLP, TAD I NDX0 + DCA BSECTP + TAD BSECTP + CLL RTR + RAR + AND [7 + DCA I NDX1 /FIRST COMES 15-BIT ADDRESS + TAD BSECTP + AND [7400 + DCA I NDX1 + TAD I NDX0 + DCA I NDX1 /THEN RELATIVE BLOCK NUMBER + TAD I NDX0 + DCA I NDX1 /THEN LENGTH + ISZ NDX0 /SKIP OVER NEXT OVERLAY COUNT + ISZ TMP0 + JMP SETSLP + TAD (LHDR /PTR TO TOP + DCA BSECTP /OF TABLE + CLA CMA /SET FLG + DCA P2FLG /FOR SUBR ADVOVR + JMP I .+1 + PASS2 + PAGE + DO8S, 0 /DO 8 SECTIONS + TAD CZFLG /ANY 8 MODE + SZA CLA /COMMONS ? + JMS FIT8S /GO FIT IT + TAD F1FLG /ANY 8 MODE + SNA CLA /FIELD 1 ? + JMP .+3 /NO + STA + JMS FIT8S + TAD S8FLG /ANY GEN 8 MODE + SNA CLA /SECTIONS ? + JMP I DO8S /NO ALL DONE + TAD [7770 /THIS WILL + DCA OVRFLO /INHIBIT FLD1 OVER FLOW ERR + CLA IAC + JMS FIT8S + JMP I DO8S + +/FIT 8 MODE SECTIONS + +FIT8S, 0 + TAD [7770 + DCA STYPE /-8M0DE SECT TYPE (7-11) + TAD SYMTM3 /SEARCH GST FOR + DCA GPTR /8 MODE SECTNS +F8SECT, JMS I [GETTYP + JMP I FIT8S /ALL DONE + TAD STYPE + TAD I GPTR + SZA CLA /8 SECTION ? + JMP F8SECT /NO + JMS I [SETBGX + TAD I BPT2 + TAD (177 /ROUND SECTION LENGTH + AND (7600 /TO A PAGE BOUNDARY + DCA I BPT2 + JMS I (FIT /NOW FIT IT + TAD OVRFLO /SEE IF FLD1 + TAD A1 /IS OVR FLOWED **** + SPA SNA CLA /? + JMP F8SECT /DO ANOTHER +TOOBIG, JMS I [RTNOS8 + CORMSG /PRINT ERROR & GO AWAY +STYPE, 0 + FIT, 0 /FIT SECTION + JMS I [SETBGX /SET BPTR TO POINT TO GST WD5 + TAD I BPT2 + AND [7400 + CLL RAL + TAD I BPTR + RTL + RTL /GET LENGTH OF SEGMENT IN BLOCKS + DCA BLKSIZ + TAD I BPT2 + CLL + TAD A1+1 + DCA TMP5 + TAD A1+1 + DCA I BPT2 + TAD TMP5 + DCA A1+1 /SET BPTR = A1 + RAL /WHILE SETTING A1 = A1 + BPTR + TAD I BPTR + TAD A1 + DCA TMP5 + TAD TMP5 + AND [7770 + SZA CLA /IF NEW ADDRESS IS > 77777, + JMP TOOBIG /THE THING WILL NEVER FIT + TAD A1 + DCA I BPTR + TAD TMP5 + DCA A1 + JMP I FIT /RETURN + LEVLUP, 0 /LEVEL = MAX (LEVEL, OVRSIZ); OVRSIZ=0 + TAD I [OVRSIZ + TAD LNONUM + DCA I NDX7 /RECORD THE SIZE OF THIS OVERLAY + TAD I [OVRSIZ+1 /FOR THE SYMBOL MAP PRINTOUT + DCA I NDX7 + TAD [OVRSIZ + JMS I [SETEPT + TAD I [LVPTR + JMS I [SETBPT + JMS MAXCOM + DCA I EPT2 + DCA I EPTR + JMP I LEVLUP + +MAXCOM, 0 /BPTR = MAX (EPTR, BPTR) + TAD I EPTR + CIA CLL + TAD I BPTR + SZA CLA /CHECK HIGH-ORDER WORDS FIRST + JMP .+4 /THEY DIFFER + TAD I EPT2 + CIA CLL + TAD I BPT2 /USE LOW ORDER WORDS IF HIGH ORDERS ARE = + SZL CLA /IS EPTR > BPTR? + JMP I MAXCOM /NO - EXIT + TAD I EPTR + DCA I BPTR + TAD I EPT2 + DCA I BPT2 /YES - BPTR=EPTR + JMP I MAXCOM + GETLEN, 0 + CDF 0 /OR CDF 20 + TAD I NDX1 /LEN OF ENTRY + CDF 10 + SNA /=0 MEANS LENGTH HAS ALREADY + JMP I GETLEN /BEEN COMPUTED. NE 0 MEANS + DCA TMP0 /ENTRY POINT IS THE 1ST IN A NEW MODULE + TAD RLEN /UPDATE REL + TAD RBLK /BLOCK AND + DCA RBLK /LENGTH OF + TAD TMP0 /NEW MODULE + DCA RLEN + JMP I GETLEN + +GETEXT, 0 /LOOK FOR GST + JMS I [GETTYP /EXTERN + JMP I (DOCORE /END OF GST + TAD I GPTR /TYPE WD TO AC + AND [17 /B8-B11 + RTR CLL /2=EXTERN + SZA CLA /GOT ONE? + JMP .-6 /NO, RETRY + JMP I GETEXT + PAGE + +LB0BUF= . + /START OF PROGRAM + +START, ISZ XSTRT /IF CHAINED TO + CIF CDF 10 + CLL STA RAL + AND I (7643 /AND OUT THE /L SWITCH + DCA I (7643 + JMP I .+1 +XSTRT, PASS0 + /THIS SUBROUTINE SHOULD RESIDE IN THE +/FIELD 0 I/O BUFFER SINCE IT +/EXECUTES ONLY ONCE +/SUBROUTINE TO DETERMINE CORE SIZE +/ +/THIS WORKS ON ANY PDP-8 FAMILY COMPUTER. +/THE VALUE,FROM 1 TO 10(OCTAL) OF THE 1ST NON-EXISTENT +/MEMORY FLD IS RETURNED IN THE AC. +/ +/NOTE--THIS ROUTN MUST BE PLACED IN FLD 0 +/ +CORE, 0 + TAD (6203 + RDF + DCA CORTN + CDF 0 + TAD I (7777 + AND COR70 + SNA + JMP CORELP + CLL RTR + RAR + JMP CORTN +CORELP, CDF 0 /NEEDED FOR PDP-8L + TAD TRYFLD /GET FLD TO TST + CLL RTL + RAL + AND COR70 /MASK USEFUL BITS + TAD CORELP + DCA .+1 /SET UP CDF TO FLD + 0 + TAD I CORLOC /SAV CURRENT CONTENTS + NOP /HACK FOR PDP-8 + DCA .-3 + TAD .-2 /7000 IS A GOOD PATTERN + DCA I CORLOC +COR70, 70 /HACK FOR PDP-8.,NO-OP + TAD I CORLOC /TRY TO READ BK 7000 + 7400 /HACK FOR PDP-8,.NO-OP + TAD .-1 /GUARD AGAINST WRAP AROUND + TAD CORLOC+1 /TAD 1400 + SZA CLA + JMP .+5 /NON EXISTENT FLD EXIT + TAD COR70-6 /RESTORE CONTENS DESTROYED + DCA I CORLOC + ISZ TRYFLD /TRY NXT HIGHER FLD + JMP CORELP + TAD TRYFLD + TAD (-1 +CORTN, 0 + JMP I CORE +CORLOC, COR70+2 /ADR TO TST IN EACH FLD + 1400 /7000+7400+1400=0 +TRYFLD, 1 /CURRENT FLD TO TST + PAGE + *6600 +DATCHG, 0 /FIND THE MONTH/YEAR + CLL RTR /THIS CODE FINDS THE MONTH + RAR /BY CALCULATING THE ADDRESS + AND (777 /OF THE CORRECT MONTH + CLL RTR /IN THE TABLE OF MONTHS + RTR + AND (36 + TAD (MONTHS-3 /HAVE THE ADDRESS OF MONTH-1 + DCA NDX2 /SAVE IT IN FIELD 0, PAGE 0 + CDF 0 /CHANGE DATA FIELD TO 0 + TAD I NDX2 /GET FIRST 2 CHARS. OF MONTH + CDF 10 /CHANGE DATA FIELD TO 1 + DCA I (LDATE+2 /INSERT INTO THE TEXT LINE + CDF 0 /CHANGE DATA FIELD TO 0 + TAD I NDX2 /GET LAST 2 CHARS. OF MONTH + CDF 10 /CHANGE DATA FIELD TO 1 + DCA I (LDATE+3 /INSERT INTO THE TEXT LINE + TAD I (OSDATE /GET THE DATE--FIND THE YEAR + AND (7 /GET THE YEAR OFFSET BITS + DCA I (YRTEMP /STORE THEM AWAY + CDF 0 /CHANGE DATA FIELD TO 0 + TAD I (7777 /GET THE DATE EXTENSION BITS + CDF 10 /CHANGE DATA FIELD TO 1 + AND (600 /MASK TO GET BITS 3 AND 4 + CLL RTR /ROTATE TO GET THEM INTO + RTR /BIT POSITIONS 7 AND 8 + TAD (106 /GET THE NEW BASE YEAR + TAD I (YRTEMP /ADD THE YEAR OFFSET BITS + CIF 10 /CHANGE THE DATA FIELD TO 1 + JMP I DATCHG /HAVE THE YEAR + GETDAT, 0 + TAD I (YRTEMP /GET THE YEAR + AND (7700 /MASK AND ROTATE + CLL RTR /TO GET THE FIRST + RTR /DIGIT (IN SIXBIT) + RTR + TAD (5500 /STICK A HYPHEN IN FRONT + DCA I (LDATE+4 /PUT IN THE TEXT LINE + TAD I (YRTEMP /GET THE YEAR AGAIN + AND (77 /MASK AND ROTATE TO + CLL RTL /GET THE SECOND DIGIT + RTL /(IN SIXBIT) + RTL + TAD (40 /STICK A SPACE AFTER IT + CIF 10 /CHANGE INSTRUCTION FIELD TO 1 + JMP I GETDAT + MONTHS, 5512;0116 /-JAN + 5506;0502 /-FEB + 5515;0122 /-MAR + 5501;2022 /-APR + 5515;0131 /-MAY + 5512;2516 /-JUN + 5512;2514 /-JUL + 5501;2507 /-AUG + 5523;0520 /-SEP + 5517;0324 /-OCT + 5516;1726 /-NOV + 5504;0503 /-DEC + PAGE + FIELD 1 +/PAGE 0 FLD1 TAGS FOR PASS0 +/(PASS 0 LIVES WITH THE USR RESIDENT) + +NMCTS= 20 +MODCNT= 21 +LVLCNT= 22 +OVRCNT= 23 +PTRULS= 24 +MXFLD= 25 + *2000 + +/START OF GLOBAL SYMBOL TABLE +/BUCKET COMES FIRST, INTERNAL +/SYMBOLS AND FIELD 1 CONSTANTS ARE +/HERE ALSO. GST RUNS FROM +/SYMTBL TO OVLTBL-1 + +BUCKET, AAAAAA;0;0;0;EEEEEE;0 /A,B,C,D,E,F + 0;0;0;0;0;0 /G-L + 0;0;0;0;0;0 /M-R + 0;0;0;0;0;0 /S-X + 0;0 /Y,Z + 0;0;0;0;0 /UNUSED BUCKETS MUST BE 0 + 0 /SPACE (FOR BLANK COMMON) + 0;0 + POUND /POUND SIGN FOR INTERNAL SYMBOLS, ALL ARE OF THE FORM (POUND XXXXX) + TRPSYM, TEXT '#YTRAP' + 0 /TRAP VECTOR +LEVSYM, TEXT '#YLVL0' + 0 /OVERLAY LEVEL +SWPSYM, TEXT '#SWAP' + 0;0 +SASYM, TEXT '#MAIN' + 0;0 /STARTING ADDRESS + +/TITLE LINE FOR LOADER MAP + +TLINE, TEXT 'LOADER V' + *.-1 +LXX, VERNUM&70^7+VERNUM+6060 /VERNUM IN SIXBIT + PATCH&77^100+40 /PATCH LEVEL +LDATE, TEXT ' NO-DA -TE ' +STLINE, TEXT 'SYMBOL VALUE LVL OVLY' +HLINE, TEXT '= 1ST FREE LOCATION' +OTLINE, TEXT 'LVL OVLY LENGTH' +SMAPU, ZBLOCK 3 /SYMMAP UNIT, LENGTH, ST BLK # +LIMGU, ZBLOCK 3 /LDR IMG " +OVRSIZ, 0;0 +LVPTR, OVRSIZ +SYMX, 1;SYMTBL-2 + /SYSTEM SYMBOL TABLE + +AAAAAA, 0 + TEXT /ARGERR/ + *.-1 + 1;0 + JARGER + +EEEEEE, 0 + TEXT /EXIT/ + 1;0 + JEXIT + +POUND, .+7 + TEXT /#ARGER/ + *.-1 + 1;0 + JARGER + .+7 + TEXT /#BAK/ + 1;0 + JBAK + .+7 + TEXT /#DATE/ + 1;0 + JDATE + .+7 + TEXT /#DEF/ + 1;0 + JDEF + .+7 + TEXT /#DISMS/ + *.-1 + 1;0 + JDISMS + .+7 + TEXT /#ENDF/ + 1;0 + JENDF + .+7 + TEXT /#EOFSW/ + *.-1 + 1;0 + JEOFSW + .+7 + TEXT /#EXIT/ + 1;0 + JEXIT + .+7 + TEXT /#HANG/ + 1;0 + JHANG + .+7 + TEXT /#IDLE/ + 1;0 + JIDLE + .+7 + TEXT /#INT/ + 1;0 + JINT + .+7 + TEXT /#RDAO/ + 1;0 + JRDAO + .+7 + TEXT /#READO/ + *.-1 + 1;0 + JREADO + .+7 + TEXT /#RENDO/ + *.-1 + 1;0 + JRENDO + .+7 + TEXT /#RETRN/ + *.-1 + 1;0 + JRETRN + .+7 + TEXT /#REW/ + 1;0 + JREW + .+7 + TEXT /#RSVO/ + 1;0 + JRSVO + .+7 + TEXT /#RUO/ + 1;0 + JRUO + .+7 + TEXT /#SWAP/ + 1;0 + JSWAP + .+7 + TEXT /#T812/ + 1;0 + JT812 + .+7 + TEXT /#UE/ + 0 + 1;0 + JUERR + .+7 + TEXT /#WDAO/ + 1;0 + JWDAO + .+7 + TEXT /#WRITO/ + *.-1 + 1;0 + JWRITO + 0 /LAST ONE + TEXT /#WUO/ + 1;0 + JWUO +SYMTBL, 0 /START OF GST + /PASS0- THIS IS THE BEGINNING OF PASS0 + +PASS0, JMP .+4 /NORMAL ENTRY PT + DCA CDSW /CHAINED TO ENTRY PT - NO DECODE 1ST TIME + TAD (7616 + DCA PTRIO + TAD (-10 + DCA LVLCNT /SET LEVEL AND OVERLAY COUNTERS + DCA OVRCNT + CIF 0 + JMS I (CORE /DETERMINE CORE SIZE + DCA MXFLD + JMS I (CORMOV + CDF 0 + 0-1 + CDF 0 + LB0BUF-1 /MOVE LOWER FIELD 0 TO A SAFE PLACE + -2000 + CDF 0 + TAD I (OSJSWD /GET JOB STATUS WORD + AND (376 /CLEAR DESIRED FLAGS + TAD (3403 /SET NO RESTART, USR AND CD AREAS CLEAR + DCA I (OSJSWD /AS WELL AS BATCH FLAG + CDF 10 + TAD I (OSDATE + SNA + JMP NODATE + CLL RTR /ROTATE AND MASK TO GET THE DAY + RAR + AND (37 + JMS MAKSXB /CONVERT TO SIXBIT + DCA I (LDATE+1 /PUT THE DAY INTO THE TEXT LINE + TAD I (OSDATE /GET THE DATE---FIND MONTH + CIF 0 /CHANGE DATA FIELD TO 0 + JMS I (DATCHG /FIND THE MONTH/YEAR + JMS MAKSXB /CONVERT THE YEAR TO SIXBIT + DCA YRTEMP /STORE IT AWAY + CIF 0 /CHANGE INSTRUC. FIELD TO 0 + JMS I (GETDAT /PRINT THE YEAR + DCA I (LDATE+5 /PUT REST OF YEAR IN TEXT LINE + /SET UP OTHER POINTERS TO MODULE TABLES + +NODATE, TAD (-NUMMOD + DCA I (MCTTBL + TAD (MCTTBL+1 + DCA NMCTS /INITIALIZE MODULE CT TBL PTR + TAD (MODTBL+2 + DCA PTRULS /INITIALIZE MODULE TBL PTR + DCA MODCNT + DCA I (MODTBL /CLEAR LIBRARY UNIT + DCA I NMCTS /CLEAR FOR 1ST LEVEL MODULE COUNTS +CDSW, JMP I (RALFLP /ZEROED IF CHAINED TO + JMP I (DECO + +MAKSXB, 0 + DCA TMP0 + DCA TMP1 + TAD TMP0 + TAD (-12 + ISZ TMP1 + SMA + JMP .-3 /SUBTRACT 10 IN A LOOP + TAD (5772 /AS GOOD A NUMBER AS ANY + DCA TMP0 + TAD TMP1 + CLL RTL + RTL + RTL /GET THE TENS DIGIT INTO POSITION + TAD TMP0 + JMP I MAKSXB +YRTEMP, 0 + PAGE + /DECODE COMMAND DECODER INPUT + +RALFLP, JMS I (200 + 5 /COMMAND DECODE + 2214 /.RL DEFAULT EXTENSION + TAD (7616 + DCA PTRIO + TAD I (OS8SWS+1 + AND (40 + CDF 0 + SZA CLA /IS /S SWITCH ON? + DCA I (SVMAIN+LB0BUF /CLEAR (RELOCATED) SVMAIN +DECO, CDF 10 /FOR FULL SYMBOL MAP LISTING + TAD I (7600 /CHK FOR LOADER IMAGE FILE + SNA /OUTPUT FILE? + JMP SM /NO + AND (0017 /MUST BE AN "MS" DEV + TAD (OS8DCB-1 + DCA TMP0 + TAD I TMP0 + SPA CLA /IS IT? + JMP .+4 /YES +SM1, TAD (DEVERR /NO,ERR + JMS I (ERORR + JMP RALFLP + TAD I P7604 + SNA + TAD (1404 /.LD + DCA I P7604 /INTO EXTENSION IF NONE SPECIFIED + JMS I (CORMOV /MOVE LOADER IMAGE FILE NAME + CDF 10 + 7600-1 + CDF 0 /INTO FIELD 0 + LDRNAM+LB0BUF-1 + -5 +SM, TAD I (7605 /CHK FOR SYM MAP FILE + SNA + JMP SM2 /NONE + AND (17 + TAD (OS8DCB-1 + DCA TMP0 + TAD I TMP0 + RAL /LOOK AT "READ ONLY" BIT IN DCB + SPA CLA + JMP SM1 /ERROR - NO GOOD FOR OUTPUT + TAD I (7611 + SNA + TAD (1423 /.LS DEFAULT MAP EXTENSION + DCA I (7611 + JMS I (CORMOV /MOVE SYMMAP FILE NAME INTO FIELD 0 + CDF 10 +P7604, 7605-1 + CDF 0 + LDRNAM+LB0BUF+4 + -5 + /COLLECT INPUT FILES + +SM2, TAD I (OS8SWS + CLL RAR + SZL CLA / IS /L SWITCH ON? + JMP LIBRAR /YES - THIS IS A LIBRARY FILE +FILELP, TAD I PTRIO + SNA + JMP FINLIN /NO MORE INPUT FILES + DCA TMP0 + TAD TMP0 + AND (17 + ISZ PTRULS + DCA I PTRULS /STORE UNIT NUMBER + TAD TMP0 + AND (7760 + CLL RTR + RTR + TAD (7400 + CIA + ISZ PTRULS + DCA I PTRULS /STORE LENGTH + TAD I PTRIO + ISZ PTRULS + DCA I PTRULS /STORE STARTING BLOCK NUMBER + ISZ MODCNT + JMP FILELP /CONTINUE + +FINLIN, JMS I (CORDSW /CHECK C AND O SWITCHES + TAD I (OS8SWS + AND (40 + SZA CLA /IF THE /G SWITCH IS ON + JMP I (EOPAS0 /ITS THE END + TAD I (OS8SWS-1 + SPA CLA /IF AN ALTMODE TERMINATED THE LINE, + JMP I (EOPAS0 /DITTO + TAD (-MCTTBL-1 + TAD NMCTS + SZA CLA /ARE WE STILL IN THE MAIN SECTION? + JMS I (UPDMOD /NO - UPDATE OVERLAY & MODULE COUNTS + JMP RALFLP + LIBRAR, TAD I PTRIO + AND (17 + DCA I (MODTBL /STORE LIBRARY PARAMETERS + TAD I PTRIO /NEGLECTING LENGTH, WHICH WILL + DCA I (MODTBL+2 /BE FILLED IN LATER + TAD I PTRIO + SNA CLA + JMP FINLIN /ONLY ONE FILE ALLOWED ON THE LINE + TAD (MIERR + JMP SM1+1 /OTHERWISE ITS MIXED INPUT + PAGE + /UPDMOD- UPDATE MODULE COUNT TBL + +UPDMOD,0 + CLL + TAD MODCNT /UPDATE -NUM OF + TAD I (MCTTBL /UNUSED MODULES + DCA I (MCTTBL + SZL + JMP MAXRLF /MAX NUMBER EXCEEDED + ISZ OVRCNT /BUMP OVERLAY NUMBER +SKPCLA, SKP CLA + JMP MAXOVL /MORE THAN 16 OVERLAYS IN A LEVEL + TAD MODCNT /UPDATE +NUM OF + TAD I NMCTS /MODULES IN LAST LEVEL + SNA /**** + JMP I UPDMOD + DCA I NMCTS + ISZ NMCTS /ADV PTR TO NXT LOC + DCA I NMCTS /ZERO THE NXT LOC IN PREPARATION + DCA MODCNT /CLR CNT FOR NXT LEVEL + JMP I UPDMOD + +/CORDSW- LOOK FOR SWS C AND O + +CORDSW, 0 + TAD I (OS8SWS+1 + AND (10 + SNA CLA /CHECK FOR /U SWITCH + JMP CHKCSW + CDF 0 + TAD SKPCLA /INHIBIT LEVEL CHECKING + DCA I (TSTTRP + CDF 10 +CHKCSW, TAD I (OS8SWS + RTL + SPA CLA + JMP I (RALFLP + TAD I (OS8SWS+1 + RTL + SMA CLA + JMP I CORDSW + +/O-SWITCH + + JMS UPDMOD + ISZ NMCTS /ADV PTR FOR NXT GUY + DCA I NMCTS /CLR FOR NXT LEVEL MOD CNT + TAD (-21 + DCA OVRCNT + ISZ LVLCNT /BUMP LEVEL COUNTER + JMP I (RALFLP + TAD (MXLERR + JMP MAXRLF+1 /TOO MANY LEVELS + MAXRLF, TAD (MXRERR + JMS ERORR + CDF CIF 0 + JMP I (7605 +MAXOVL, TAD (MXOERR + JMP MAXRLF+1 + +/ERORR- PRINTS OUT ERROR MESSAGES OF A +/ BUFR LOCATED IN FLD1 +/ ENTER WITN ADR OF BUFR IN AC +/ +ERORR, 0 + DCA BFADR + CDF 10 /CALL TTYHAN + JMS I (CORMOV + CDF 0 + LB0BUF-1 /MOVE LOWER FIELD 0 BACK + CDF 0 /SO WE CAN USE THE MESSAGE HANDLER + 0-1 + -2000 + CIF 0 + JMS I (TTYHAN + CDF 10 +BFADR, 0 + JMP I ERORR + MIERR, TEXT /MIXED INPUT/ +DEVERR, TEXT /BAD OUTPUT DEVICE/ +MXRERR, TEXT /TOO MANY RALF FILES/ +MXLERR, TEXT /TOO MANY LEVELS/ +MXOERR, TEXT /TOO MANY OVERLAYS/ + PAGE + /PASS1, PASS2 INITIALIZATION + +EOPAS0, JMS I (UPDMOD /BUMP COUNTS FOR LAST LINE OF INPUT + ISZ NMCTS + DCA I NMCTS /PUT IN A DOUBLE ZERO AT THE END + JMS I (CORMOV + CDF 0 + LB0BUF-1 + CDF 0 + 0-1 /MOVE LOWER FIELD 0 BACK INTO PLACE + -2000 + TAD I (MODTBL + SZA CLA /USER-SPECIFIED LIBRARY? + JMP RDLIBH /YES + CLA IAC + JMS I (200 + 2 /LOOKUP + LIBRY + 0 + JMP NOLIB /FORLIB.RL NOT FOUND + TAD .-3 /GET STARTING BLOCK + DCA I (MODTBL+2 + CLA IAC + DCA I (MODTBL /STORE UNIT AND BLOCK # +RDLIBH, STL RTR + DCA I (MODTBL+1 /JUST TO BE CAREFUL + CIF 0 + JMS I (IOHAN /READ BLOCK 0 OF THE LIBRARY CATALOG + MODTBL + 0210 +PLB, RALFBF + 0 + STA + TAD I PLB + SNA CLA /IS IT AN HONEST - TO - GOD LIBRARY? + JMP .+4 /YES +NOLIB, DCA I (MODTBL + DCA I (MODTBL+2 + DCA I (RALFBF+3 /ZERO COUNT WORD IN BUFFER + TAD I (RALFBF+3 + DCA I (MODTBL+1 /STORE LENGTH OF CATALOGUE + TAD (LHDR-1 + DCA NDX0 + TAD (-400 + DCA TMP0 + DCA I NDX0 /0 OUT + ISZ TMP0 /LDR HDR + JMP .-2 /GET PAGE 0 + /PASS1 INITIALIZATION CONTINUED + + TAD I (MCTTBL /UNUSED + DCA TMP2 /MODULES + TAD (MCTTBL+2 /GET NUMBER OF OVERLAYS + DCA NDX0 / IN EACH LEVEL + TAD (QUSRLV+4 /WHERE THE + DCA TMP0 /CNTS GO IN + JMP BY0 /LDR HDR BLK +LOP0, ISZ I TMP0 /INCREMENT NUMBER OF OVERLAYS IN THIS LEVEL + TAD I NDX0 + SZA CLA /END OF LEVEL? + JMP LOP0 /NO + TAD (4 /THIS LEVEL + TAD TMP0 + DCA TMP0 +BY0, DCA I TMP0 /RESET CNT + TAD I NDX0 /0,0 ENDS + SZA CLA /MOD CNT TBL + JMP LOP0 /DO MORE PTR TO + TAD I (MODTBL+1 /GET LENGTH OF LIBRARY CATALOG + DCA TMP4 /BLOCKS + TAD TMP2 /CHK FOR MAX + SZA CLA /NUM OF RALFS 0=MOD TBL IS FULL + TAD I (MODTBL /CHK FOR NO + CDF + DCA I (LIBRSW /LIBRARY AND SET SWITCH ACCORDINGLY + TAD TMP2 /-NUM LEFT + DCA I (MLEFT /OF RALF MODS + TAD (SYMTBL-1 /PTR TO TOP + DCA I (NDX4 /OF GST + TAD I (OSJSWD + AND (7377 /KILL "BATCH PROTECTED" FLAG + DCA I (OSJSWD + AC7776 /IS THERE + TAD MXFLD /GREATER THAN 12K OF CORE + SPA SNA CLA /? + JMP LS16K /NO + TAD (200^12!30 /SET TXT I/O + DCA I (TXTBLK-2 /BUFFS UP IN FLD 3 + TAD (-5000 /-WDCNT (12 + DCA I (TXTWDS /BLKS) + TAD (6231 /CDF 30 + DCA I (RDTCDF +LS16K, TAD (7700 /USR IS NOT + DCA I (USR /IN CORE + CDF 10 + JMP I (INIBFS +LIBRY, 0617;2214;1102;2214 /FORLIB.RL + PAGE + /THIS IS THE INITIAL BINARY BUFFER TABLE + +R= LDBUFS-BUFTAB + +BUFTAB, .+4+R; 0; 0; 3200 /03200-05177 +B8KPT, .+4+R; 0; 0; 5200 /05200-07177 + .+4+R; 0; 0; 0020 /20000-21777 +B12KPT, .+4+R; 0; 0; 2020 /22000-23777 +B16KPT, .+4+R; 0; 0; 4020 /24000-25777 + .+4+R; 0; 0; 0040 /40000-41777 +B20KPT, .+4+R; 0; 0; 2040 /42000-43777 + .+4+R; 0; 0; 4040 /44000-45777 + .+4+R; 0; 0; 0050 /5000-51777 + 0; 0; 0; 2050 /52000-53777 + INIBFS, TAD MXFLD + TAD (JMP STBPTR-1 + DCA .+1 + HLT /DISPATCH ON NUMBER OF FIELDS +STBPTR, DCA B8KPT + DCA B12KPT + DCA B16KPT + DCA B20KPT + NOP + NOP /NOT SET UP TO USE MORE THAN 24K + NOP + JMS I (CORMOV + CDF 10 + BUFTAB-1 /MOVE THE BINARY BUFFER TABLE + CDF 10 + LDBUFS-1 /INTO A SAFE PLACE + -50 + CDF 0 + TAD LVLCNT /SET -NUM OF + TAD (11 /LEVELS + CIA + DCA I (NLVL + TAD (-5 /NUM OF LIBR + DCA TMP2 /BLKS FOR 8K + CLA CMA + TAD MXFLD + SNA CLA /GREATER THAN 8K CORE? + JMP TO8K /NO SET LIBR ARGS + DCA I (LBARG+1 + TAD (200^12!20 /12 BLKS FLD2 + DCA I (LBARG + TAD (6221 /CDF 20 + DCA I (LBFLD + TAD (6221 + DCA I (GETLEN+1 + TAD (-12 + DCA TMP2 +TO8K, TAD TMP2 /WILL LIBR + TAD TMP4 /BE CORE + SMA SZA CLA /RESIDENT? + DCA I (RESFLG /NO + TAD (SYMTBL-1 + DCA I (NDX0 + CDF 10 + TAD (ESDPG-1 /ENTER DEFAULT + DCA NDX0 /VALUES FOR + TAD (-200 /ESD REF PAGE + DCA TMP0 /IT SAVES + TAD (SYMTBL+5 /PROBLEMS WITH + DCA I NDX0 /EXTERNS + ISZ TMP0 + JMP .-3 + CLA STL RTL + DCA I (LHDR /STORE LOADER IMAGE CODE IN HEADER + TAD (VERNUM + DCA I (QVERNO /STORE LOADER VERSION NUMBER + CIF 0 + JMP I (STPAS1 + PAGE + /CORMOV- A CORE MOVE FOR A CHUNK OF CORE IN +/ ANY FLD TO ANY FLD. +/ +/ CALL JMS CORMOV +/ CDF Z1 /Z1=FROM FLD +/ ADDR1 /ADDR OF (1ST LOC-1) +/ CDF Z2 /Z2=TO FLD +/ ADDR2 /ADDR OF (1ST LOC-1) +/ -N /-OCT NUM OF WDS TO MOV +/ +CORMOV, 0 + CLA CMA + TAD CORMOV + DCA NDX0 + TAD I NDX0 + DCA TOCDF-2 + TAD I NDX0 + DCA NDX1 + TAD I NDX0 + DCA TOCDF + TAD I NDX0 + DCA NDX2 + TAD I NDX0 + DCA TMP0 + 0 + TAD I NDX1 +TOCDF, 0 + DCA I NDX2 + ISZ TMP0 + JMP TOCDF-2 + CDF 10 + JMP I NDX0 /RTN + + $$$$$ + diff --git a/sw/f4/FRTSRC/ltr.ra b/sw/f4/FRTSRC/ltr.ra new file mode 100644 index 0000000..0951798 --- /dev/null +++ b/sw/f4/FRTSRC/ltr.ra @@ -0,0 +1,50 @@ +/ LTR (LOAD TRUTH) EMULATION ROUTINES +/ +/ VERSION 5A 4-26-77 MH +/ + SECT #LTR + ENTRY #EQ + FLDA TRUE + STARTF +#EQ, JA . + JEQ #EQ-3 + FCLA + JA #EQ-1 + ENTRY #NE +#NE, JA . + JEQ .+4 + FLDA TRUE + STARTF + JA #NE + ENTRY #GE + FLDA TRUE + STARTF +#GE, JA . + JGE #GE-3 + FCLA + JA #GE-1 + ENTRY #LE + FLDA TRUE + STARTF +#LE, JA . + JLE #LE-3 + FCLA + JA #LE-1 + ENTRY #GT + FLDA TRUE + STARTF +#GT, JA . + JGT #GT-3 + FCLA + JA #GT-1 + ENTRY #LT + FLDA TRUE + STARTF +#LT, JA . + JLT #LT-3 + FCLA + JA #LT-1 +TRUE, F 1.0 + F 0.0 + END + diff --git a/sw/f4/FRTSRC/onqib.ra b/sw/f4/FRTSRC/onqib.ra new file mode 100644 index 0000000..2357697 --- /dev/null +++ b/sw/f4/FRTSRC/onqib.ra @@ -0,0 +1,102 @@ +/ +/ VERSION 5A 4/28/77 PT +/ + FIELD1 ONQI + 0 + JMP SETINT /SET UP #INT INITIALLY + ISZ ONQI /BUMP ARG POINTER + ISZ INTQ+1 /BUMP INTERRUPT Q POINTER + IOF /** + DCA% INTQ+1 /STICK IOT ONTO INT Q + TAD XSKP /FOLLOWED BY A SKIP + ISZ INTQ+1 + DCA% INTQ+1 /ONTO INT Q + ISZ ONQI /SKIP FIRST WORD OF ADDR + ISZ INTQ+1 +ONQISW, TAD% ONQI /GET INT HANDLER ADDRESS + ISZ ONQI + DCA% INTADR+1 /ONTO ADDRESS STACK + TAD INTADR+1 /NOW MAKE JMS% + AND L177 + TAD L4600 + DCA% INTQ+1 /ONTO INT Q + ISZ INTADR+1 + ION /:: + ISZ IQSIZE /ROOM FOR MORE ? + JMP% ONQI /YES + TAD .-1 /NO, CLOSE OUT THESUBR + DCA ONQI+1 + JMP% ONQI +SETINT, TAD ONQISW /DO THIS PART ONLY ONCE + DCA ONQI+1 + CDF + IOF /** + TAD XSKP /FIX UP #INT + DCA% XINT+1 + ISZ XINT+1 + TAD INTQ+1 + DCA% XINT+1 + ISZ XINT+1 + TAD CIFCDF + DCA% XINT+1 + ION /** +CIFCDF, CDF CIF 10 + JMP ONQI+1 /BACK TO ONQI + EXTERN #INT +XINT, ADDR #INT +INTQ, ADDR IHANDL +INTADR, ADDR IHADRS +IQSIZE, -5 +XSKP, SKP +L177, 177 +L4600, 4600 + CDF CIF + JMP% IHANDL +IHANDL, 0 + REPEAT 16 + JMP IHANDL-2 +IHADRS, 0;0;0;0;0 + + ENTRY ONQB +ONQB, 0 + JMP SETBAK /SETUP #IDLE + TAD% ONQB /GET ADDRESS OF IDLE JOB +ONQBSW, ISZ ONQB + DCA% BAKADR+1 /STORE ONTO BACKROUND JOB Q + TAD BAKADR+1 /MAKE A JMS% + ISZ BAKADR+1 + AND L177 + TAD L4600 + ISZ BAKQ+1 + DCA% BAKQ+1 + ISZ BQSIZE /MORE ROOM ? + JMP% ONQB /YES + TAD .-1 /NO, CLOSE THE DOOR + DCA ONQB+1 + JMP% ONQB +SETBAK, TAD ONQBSW /CLOSE OFF #IDLE INITIALIZATION + DCA ONQB+1 + CDF + TAD XSKP /FIX UP #IDLE + DCA% XIDLE+1 + TAD BAKQ+1 + ISZ XIDLE+1 + DCA% XIDLE+1 + ISZ XIDLE+1 + TAD CIFCDF + DCA% XIDLE+1 + CIF CDF 10 + JMP ONQB+1 + EXTERN #IDLE +XIDLE, ADDR #IDLE +BAKQ, ADDR BAKRND +BAKADR, ADDR BHADRS +BQSIZE, -5 + CDF CIF + JMP% BAKRND +BAKRND, 0 + REPEAT 6 + JMP BAKRND-2 +BHADRS, 0;0;0;0;0 + END + diff --git a/sw/f4/FRTSRC/p2ocfg.pa b/sw/f4/FRTSRC/p2ocfg.pa new file mode 100644 index 0000000..f9db3cf --- /dev/null +++ b/sw/f4/FRTSRC/p2ocfg.pa @@ -0,0 +1,2 @@ +/ CONFIGURATION FILE TO GENERATE PASS2O (PH, APR 2008) +OVERLY=1 diff --git a/sw/f4/FRTSRC/pass2.pa b/sw/f4/FRTSRC/pass2.pa new file mode 100644 index 0000000..0a6b273 --- /dev/null +++ b/sw/f4/FRTSRC/pass2.pa @@ -0,0 +1,4679 @@ +/3 OS/8 FORTRAN (PASS TWO) +/ +/ VERSION 4A PT 16-MAY-77 +/ +/ OS/8 FORTRAN COMPILER - PASS 2 +/ +/ BY: HANK MAURER +/ UPDATED BY: R. LARY + M. HURLEY +/ +/ +/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +VERSON=4 + /SEE F4.PA FOR LIST OF MAINTENANCE RELEASE CHANGES -S.R. +/ALSO, ADDED SAFETY CDF 0 TO BUMP ROUTINE TO FIX BUG +/MASSAGED LINK IN THAT AREA TO GET ROOM +/ALSO, +/ FIXED BUG RE DN ERROR PRINTING WRONG LINE NUMBER +/ +/ +/CHANGES FOR OS/8 V3D AND OS/78 BY P.T. +/.PATCH LEVEL FOR PASS2 IS IN LOCATION 327 + + IFNDEF OVERLY + IFNZRO OVERLY + *2 /V3C +TEM, 1 /V3C +LINENO, 1 /LINE NUMBER +VERS, -VERSON /VERSION NUMBER +ERRPTR, 5001 /POINTER TO THE ERROR LIST +FILDEV, 0 /THIS IS THE FILE DESCRIPTOR +FILBLK, 0 /FOR RALF +X10, COMREG-1 /INTER PASS COM REGION +X11, 0 +X12, 0 +X13, 0 +X14, 0 +X15, 0 +X16, 0 +X17, 0 /AUTO INDEX REGISTERS +ENTRY, 0 /THINGS USED BY SYMBOL + /TABLE FIDDLER +OENTRY, 0 +BUCKET, 0 +TYPE, 0 +TEMP, 0 /GENERAL TEMPS +TEMP2, 0 +ARG1, 0 /ARGS AND TYPES +BASE1, 0 +TYPE1, 0 +ARG2, 0 +BASE2, 0 +TYPE2, 0 +TMPCNT, 1 /TEMP COUNT +TMPMAX, 0 /MAX TEMP COUNT +LITNUM, 0 /LITERAL DISPLACEMENT + TMPBLK=2 + OUBUF=4400 + COMREG=4600 + STACK1=4700 + OVRLAY=5000 + NPOVLY=700 + XRBUFR=6600 + STACK=7000 /STACK-5 CAN'T BE 0 + INBUF=7200 + NPPAS3=1600 +ARG, 0 /TEMP FOR CODE +AC, 0 /AC FOR MULTIPLY ROUTINE +XR, 0 /XR CHAR FOR OADDR +MQ, 0 /MQ FOR MULTIPLY ROUTINE +XRNUM, 0 /TEMP USED IN XR STUFF +WHATAC, 0 /POINTER TO VAR +WHATBS, 0 /JUST STORED +FREEXR, 0 /NUMBER OF FREE + /INDEX REG +DIMPTR, 0 /POINTER TO DIM INFO + /AFTER GETSS +NARGS, 0 /ARG COUNT FOR SS VAR + /COMPILE +GLABEL, 1 /GENERATED LABEL COUNTER +STKLVL, STACK /STACK LEVEL (CHANGED + /BY DO) +COMMA, 254 /, +PLUS, 253 /+ +IFLABL, 0 /HOLDS LABEL FOR LOG IF +DOTEMP, 7000 /DO LOOP TEMP COUNTER +BINARY, 0 /BINARY IO=1, FORMATTED=0 +INPUT, 0 /INPUT=1 OUTPUT=0 FOR IO STMTS +PROGNM, 0 /POINTER TO PROG/FUNC NAME +FUNCTN, 0 /0=MAIN, 1=FUNC, -2=SUBR +ARGLST, 0 /POINTER TO ARG LIST +DATASW, 0 /=1 IF THIS IS A DATA STMT +GCTEMP, 0 /TEMP USED BY GENCAL +EXTLIT, 0 /EXTERNAL LITERALS LIST +ELCNT, 0 /AND COUNT +IOLOOP, 0 /IO LOOP SWITCH +ARGIO, 0 /ARG IO SWITCH +F1LNAM, 0617;2224;2216;2415 /FILE NAME FORTRN.TM +DEVH, 7607 /DEVICE HANDLER ADDRESS +ACSWIT, 0 /IS NON ZERO IF CALLING AN ARG +IOSTMT, 0 /SET 1 IF IN IO STMT + /(FOR IMPLIED LOOPS) +FMODE, 1 /1 IF IN F OR D MODE (0 IF E) +ASFSWT, 0 /1 IF ASF PROLOG, -1 IF + /ASF END, 0 OTHER +JSRLBL, 0 /LABEL NUMBER FOR CALLS TO ARGS +DPUSED, 0 /=1 IF DP HARDWARE USED +QM4, -4 +Q260, 260 +QTTYOU, TTYOUT +QERMSG, ERMSG +QNEXT, NEXT +QNEXTM, NEXT-2 +QUCODE, UCODE +QCODE, CODE +QINWOR, INWORD +QONUMB, ONUMBR +QSAVEA, SAVEAC +Q6M3, +Q5, 5 +QGENCO, GENCOD +QM6, -6 +QOPCOD, OPCOD +QOPCDE, OPCODE +QOADDR, OADDR +Q17, 17 +QTTYMS, TTYMSG +QXRTBL, XRTABL +QCHKXR, CHEKXR +QGENSF, GENSTF +QGENSE, GENSTE +QOSNUM, OSNUM +QCRLF, CRLF +QOTAB, OTAB +QOUTSY, OUTSYM +QGARG, GARG +Q20, 20 +Q40, 40 +QOUTNA, OUTNAM +QLITRL, LITRL +Q200, 200 +Q255, 255 +Q3, 3 +QOLABE, OLABEL +QGETSS, GETSS +Q256, 256 +QSAVAC, SAVACT +QSKPIR, SKPIRL +QGENCA, GENCAL +QLOADA, LOADA +QMUL12, MUL12 +QGARGS, GARGS +QOINS, OINS +QOCHAR, OCHAR +QNUMBR, NUMBRO +QXRBUF, XRBUFR +QTTYP2, TTYP2C +QTTCRL, TTCRLF +QM63, -63 +Q7605, 7605 +RELCD, 0 +QLABEL, NLABEL +P0F1, 5274 /101-2605 +P0F2, VERROR + / OUTPUT UTILTIY ROUTINES + PAGE +OCNT, +CRLF, 0 /OUTPUT CR LF + TAD (215 + JMS I QOCHAR + TAD (212 + JMS I QOCHAR + TAD (200 + KRS + TAD (-203 + SNA CLA + KSF /CHECK FOR ^C + JMP I CRLF + JMP I (7605 +NCHAR, +OSNUM, 0 /PRINT STMT NUMBER + IAC /SKIP POINTER WORD + DCA NAMPTR + TAD (6211 /ALWAYS IN FIELD 1 + DCA NAMCDF + TAD OSNUM /SAVE ENTRY POINT + DCA OUTNAM + TAD (243 /GET FIRST CHAR (ALWAYS #) + JMP L6201 /GO PRINT NAME +TTCHAR, +OUTSYM, 0 /PRINT OPCODE + DCA NAMPTR /SAVE POINTER TO STUFF + TAD L6201 /ALWAYS FIELD 0 + DCA NAMCDF + TAD OUTSYM /SAVE ENTRY + DCA OUTNAM + JMP NAMCDF /PRINT REST +ONUMT, +OUTNAM, 0 /OUTPUT NAME + DCA NAMPTR /SAVE ADDRESS OF NAME + RDF /GET FIELD OF NAME + TAD L6201 + DCA NAMCDF /SAVE AS CDF + TAD I NAMPTR /GET FIRST CHAR (ALREADY ASCII) + ISZ NAMPTR /SKIP OVER TYPE AND DIM PTR + ISZ NAMPTR +L6201, CDF + JMS I QOCHAR /OUTPUT CHAR + ISZ NAMPTR +NAMCDF, 0 + TAD I NAMPTR /GET NEXT TWO CHARS + CDF + SNA /IS NAME DONE ? + JMP I OUTNAM /YES + DCA NCHAR /SAVE TWO CHARS + TAD NCHAR + RTR /GET UPPER CHAR + RTR + RTR + TAD (240 + AND (77 + TAD (240 + JMS I QOCHAR /OUTPUT IT + TAD NCHAR /NOW DO LOWER + AND (77 + SNA + JMP I OUTNAM /NAME DONE + TAD (240 + AND (77 + TAD (240 + JMP L6201+1 /GO AND OUTPUT IT +ONUMBR, 0 /OUTPUT OCTAL NUMBER + DCA ONUMT /SAVE TEMPORARILY + TAD QM4 /4 DIGITS + DCA OCNT +OLOOP, TAD ONUMT + CLL RTL + RAL + DCA ONUMT + TAD ONUMT + RAL + AND (7 + TAD Q260 + JMS I QOCHAR + ISZ OCNT + JMP OLOOP + JMP I ONUMBR +TTYP2C, 0 /PRINT 2 CHARS ON THE TTY + DCA TTCHAR + TAD TTCHAR + RTR + RTR + RTR + JMS CONVRT + TAD TTCHAR + JMS CONVRT + JMP I TTYP2C +NAMPTR, +CONVRT, 6401 /CONVERT TO ASCII + AND (77 + SZA + TAD (240 + AND (77 + TAD (240 + JMS I QTTYOUT + JMP I CONVRT +TTCRLF, 0 + TAD (215 + JMS I QTTYOUT + TAD (212 + JMS I QTTYOUT + JMP I TTCRLF +TTYMSG, 0 /PRINT 2 CHAR ERROR MESSAGE + CDF + TAD I TTYMSG + ISZ TTYMSG /PRINT ERROR MESSAGE + JMS I QERMSG +FATAL, JMP I QNEXT /FATAL ERROR MESSAGE + TAD I FATAL + JMS I QERMSG + JMP I Q7605 /RETURN TO PS8 +DP2C1, TEXT '.+2,1' +NEG, JMS I QUCODE /NEGATE CODE + NEGTBL-1 + JMP I QNEXT + PAGE + / OPCODE JUMP TABLE + + TAD TEMP2 + SKP /CODE ALREADY READ +NEXT, JMS I QINWORD /GET NEXT INPUT WORD + TAD (XPUSH /INDEX INTO JUMP TABLE + DCA TEMP2 + CDF 10 + TAD I TEMP2 + CDF 0 + DCA TEMP2 /GET JUMP ADDRESS + JMP I TEMP2 /GO THERE + /OPTIMIZING RELATIONAL CODE FOR OS/8 F4 +/COMPLIMENTS OF R.L. + +LE, STL RTL /2 +LT, TAD QM4 /GENERATE -4 FOR LT, -2 FOR LE + JMP GE+1 /GO TO COMMON RELATIONAL CODE +GT, STL RTL +GE, IAC /GENERATE 1 FOR GE, 3 FOR GT + DCA RELCD /ALL THIS FUNNY STUFF IS BECAUSE SOME + JMS I QCODE /OF THE RELATIONAL SKELETONS OPTIMIZE BY + LETABL-6;5 /PERFORMING THE RELATIONAL ON THE NEGATIVE + TAD RELCD /OF THE FAC - WHEN THIS HAPPENS SPECIAL + SPA /CODE IN THE SKELETON DOES AN "ISZ RELCD", + CIA /CHANGING ABS(RELCD) TO ITS OPPOSITE RELATIONAL + JMP RELGEN /E.G. GE(1) TO LE(2), LE(-2) TO GE(-1) + +EQ, CLA IAC /SINCE EQ AND NE ARE SIGN-INDEPENDENT, +NE, DCA RELCD /WE DON'T NEED THAT KLUDGE BUT FOR COMPATIBILITY + JMS I QCODE /WITH RTPS THE OS/8 FORTRAN SYSTEM FUNCTION + EQTABL-6;5 /"#CEQ" WORKS THE WRONG WAY - IT PRODUCES + CLA IAC /A 1.0 IF THE COMPLEX AC WAS (0.,0.) + AND RELCD /AND A 0.0 OTHERWISE - SO WE HAVE TO REVERSE + SZA CLA /THE SENSE OF COMPLEX .EQ. AND .NE. RELATIONS. +RELGM1, TAD Q5 +RELGEN, DCA RELCD /STORE "FINAL" RELCD + JMS I QINWORD /GENTLY PROBE AHEAD IN THE INPUT + DCA TEMP2 + TAD TEMP2 + TAD (XPUSH-XLOGIF + SNA CLA /IF THIS WAS THE TOP RELATION OF A LOGICAL IF, + JMP LIFOPT /WE'RE IN A POSITION TO OPTIMIZE + TAD RELCD /OTHERWISE OUTPUT A CALL TO THE + CLL RAL /ROUTINE CORRESPONDING TO THE RELATIONAL + TAD (LTRNE + DCA .+3 + CLA IAC + JMS I (OJSR /GENERATE A JSA #XX + 0 + JMP I QNEXTM2 /PROCESS THE WHATCHIMACALLIT + +LIFOPT, TAD TYPE1 /SEE IF WE SHOULD GENERATE A "STARTF" FIRST + AND Q17 /ONLY WORRY ABOUT D.P. + TAD QM4 /SINCE THE ROUTINE #CEQ DOES A STARTF + DCA FMODE /FMODE=0 ONLY IF ARGS WERE D.P. + JMS I QGENSF /GENERATE STARTF IF NECESSARY + JMP I .+1 + LIFBGN+1 /GO TO LOGICAL IF PROCESSOR + +EQV, JMS I QCODE /.EQV. LOGICAL OPERATOR + EQVTBL-6;0 + JMP RELGM1 + / PASS TWO OUTPUT ROUTINE +OCHAR, 0 /OUTPUT A CHAR TO THE + /RALF INPUT FILE + AND (377 + DCA OUTEMP /SAVE CHAR + ISZ OUJUMP /BUMP THREE WAY SWITCH +OUJUMP, JMP . + JMP CHAR1 + JMP CHAR2 + TAD OUTEMP /HIGH FOUR BITS GO INTO + CLL RTL /THE HIGH ORDER BITS OF THE + RTL /FIRST WORD OF THE TWO WORD PAIR + AND (7400 /SEE NOTE * BELOW + TAD I OUPOLD /COMBINE WITH OTHER BITS + DCA I OUPOLD + TAD OUTEMP /THE OTHER FOUR BITS OF THIS CHAR + CLL RTR /GO INTO THE HIGH ORDER FOUR + RTR /BITS OF THE SECOND + /WORD OF THE PAIR + RAR + AND (7400 + TAD I OUPTR + DCA I OUPTR + TAD OUJMP /RESET 3 WAY BRANCH + DCA OUJUMP + ISZ OUPTR /BUMP BUFFER POINTER + ISZ OUWDCT /AND DOUBLE WORD COUNTER + JMP I OCHAR /BUFFER NOT FULL + JMS OUDUMP /DUMP IT + JMP I OCHAR +CHAR2, TAD OUPTR /SAVE FIRST WORD POINTER + DCA OUPOLD + ISZ OUPTR /GO TO SECOND WORD +CHAR1, TAD OUTEMP /STORE CHAR 1 OR 2 + DCA I OUPTR + JMP I OCHAR +OUTEMP, +OUDUMP, 0 /BUMP THE DUFFER + TAD OSIZE /ANY ROOM LEFT ? + SNA + JMP OUERR + IAC + DCA OSIZE /YES, ITS OK + JMS I DEVH /WRITE + 4200 /CONTROL WORD + OUBUF /BUFFER POINTER +OBLOCK, 0 /BLOCK NUMBER + JMP OUERR /ERROR + ISZ OBLOCK /INCREMENT BLOCK NUMBER + ISZ FILSIZ /AND FILE SIZE + TAD OBLOCK-1 /SET BUFFER POINTER + DCA OUPTR + TAD (-200 /SET DOUBLE WORD COUNT + DCA OUWDCT + JMP I OUDUMP +OUERR, JMS I (FATAL /FATAL OUTPUT ERROR + 1706 +/ * THE PONY EXPRESS STARTED IN 1860 AND ONLY RAN +/ FOR 19 MONTHS WHILE LOSING $200,000. +OUPOLD, 0 +OUPTR, OUBUF +OUJMP, JMP OUJUMP +OUWDCT, -200 +OSIZE, 0 +DD1, TEXT '1' + PAGE + / READ FROM FORTRN.TM + +INWORD, 0 /READ A WORD FROM INPUT FILE + ISZ INBCNT /ANYTHING LEFT IN BUFFER ? + JMP NOREAD /YES + ISZ INRCNT /ANYTHING LEFT IN FILE? + SKP + JMP I (END /NO, END OF PROG + JMS I DEVH /READ NEXT BLOCK +X200, 0200 + INBUF +INBLOK, 0 + JMP INERR /INPUT ERROR + ISZ INBLOK /BUMP BLOCK NUMBER + TAD (-400 /RESET COUNTER + DCA INBCNT + TAD INBLOK-1 /RESET POINTER + DCA INBPTR +NOREAD, TAD I INBPTR /GET WORD FROM BUFFER + ISZ INBPTR /BUMP BUFFER POINTER + JMP I INWORD +INERR, JMS I (FATAL /FATAL INPUT ERROR + 1105 +INBCNT, -1 /FORCE READ FIRST TIME +INBPTR, 0 +INRCNT, 0 + / CODE UTILITIES +GETSS, 0 /GET POINTER TO DIM INFO + CDF 10 + IAC + DCA DIMPTR /ADDR OF TYPE WORD + TAD I DIMPTR + ISZ DIMPTR /MOVE TO DIM/EQUIV POINTER + AND X200 /EQUIV INFO ? + SNA CLA + JMP .+3 /NONE + TAD I DIMPTR /SKIP EQUIV INFO + DCA DIMPTR + TAD I DIMPTR /ADDRESS OF DIM INFO + JMP I GETSS +NUMBRO, 0 /OUTPUT 15 BIT OCTAL NUMBER + TAD AC /IS HIGH DIGIT 0 ? + SNA + JMP .+3 /YES, PRINT 4 DIGITS ONLY + TAD Q260 /MAKE IT ASCII + JMS I QOCHAR /PUT IT + TAD MQ /NOW LOW FOUR DIGITS + JMS I QONUMBR + JMP I NUMBRO +UCODE, 0 /GEN CODE FOR UNARY OPERATORS + JMS I QSAVEAC /SAVE AC IF NEEDED + JMS GARG + JMP OTERR /OPERATOR/TYPE ERROR + TAD ARG1 /IS ARG IN AC ? + SNA CLA + TAD Q5 /YES, USE SECOND HALF OF TABLE + TAD TYPE1 + TAD I UCODE /PLUS TABLE ADDRESS + DCA USKEL + CDF 10 + TAD I USKEL /ADDR OF SKELETON + SNA + JMP OTERR /0 MEANS BAD + /OPERATOR/TYPE COMBO + DCA USKEL /SAVE SKELETON ADDR + JMS I QGENCOD /GO DO THE CODE +USKEL, 0 + DCA I X16 /RESULT IN AC + ISZ X16 /BUMP STACK POINTER + ISZ X16 /TYPE IS ALREADY THERE + ISZ UCODE /FIX RET ADDR + JMP I UCODE +GARG, 0 /GET ONE ARG + CLL CMA RTL /BACK UP ONE ENTRY + TAD X16 + DCA X16 + TAD X16 /USABLE POINTER + DCA X15 + TAD I X15 /GET OPERAND + DCA ARG1 + TAD I X15 + DCA TYPE1 + TAD I X15 + DCA BASE1 + TAD TYPE1 /CHECK TYPE + TAD QM6 + SMA CLA + JMP I GARG /TAKE ERROR EXIT + ISZ ARG2 /MAKE SURE ARG2 ISN'T ZERO + JMS I (MPTRA1 /MOVE THE POINTER IF + /THERE IS ONE + ISZ GARG + JMP I GARG + +TTYOUT, 0 /OUTPUT TO THE TTY + TLS + TSF + JMP .-1 + CLA + KSF + JMP I TTYOUT /NO KEYBOARD FLAG + KRB + AND (177 /ACCEPT PARITY ASCII + TAD (-3 /^C ? + SNA + JMP I Q7605 /YES, BACK TO PS8 + TAD (3-17 /^O ? + SZA CLA + JMP I TTYOUT /NO, RETURN + DCA TTYOUT+1 /KILL OUTPUT STUFF + DCA TTYOUT+2 + DCA TTYOUT+3 + JMP I TTYOUT /RETURN + LTRNE, TEXT '#NE' + TEXT '#GE' + TEXT '#LE' + TEXT '#GT' + TEXT '#LT' + TEXT '#EQ' + PAGE + / SOME TEXT + +P2, TEXT '+2' +XVAL, TEXT '#VAL' +DP4, TEXT '.+4' +FADD, TEXT 'FADD' +FLDA, TEXT 'FLDA' +FSUB, TEXT 'FSUB' + / SAVE AC ROUTINES +SAVACT, 0 /SAVE TOP OF STACK IF + /NECESSARY + TAD SAVACT /SAVE RETURN ADDR + DCA SAVEAC + CLL CMA RAL + JMP SAVEAC+2 /BACK UP ONLY ONE ENTRY +SAVEAC, 0 /STORE AC IF NEEDED + TAD (-5 /LOOK AT STACK TWO DOWN + TAD X16 + DCA SATEMP + TAD I SATEMP /IF 0, RESULT WAS LEFT IN AC + SZA CLA + JMP I SAVEAC /NO, NO STORE NEEDED + TAD TMPCNT /STORE TEMP NUMBER + DCA I SATEMP + ISZ SATEMP /MOVE TO TYPE WORD + TAD I SATEMP /GET TYPE + JMS SAVE /GO DO ACTUAL STORE + JMP I SAVEAC +SAVE, 0 /SAVE AC + DCA ACSTOR /THIS IS THE TYPE + TAD ACSTOR /IS IT COMPLEX OR DOUBLE? + TAD QM4 + SNA + JMP NOC /ITS DOUBLE + IAC + SZA CLA + JMP NOCORD /NO + JMS I QGENCOD /STARTE; FLDA #CAC + SEGCAC-1 +NOC, JMS ACSTOR /%FSTA #TMP+XXXX + JMS TMPBMP /THIS USE TWO TEMPS + JMP I SAVE +NOCORD, JMS ACSTOR /%FSTA #TMP+XXXX + JMP I SAVE + SATEMP, +ACSTOR, 0 /GENERATES FSTA TEMP+XXXX + JMS I QOPCOD /OUTPUT %FSTA %TEMP+XXXX + FSTA + JMS I QOADDR + TMPCNT /TMPCNT CONTAINS THE + /ARG NUMBER + JMS TMPBMP /BUMP TEMPORARY NUMBER + JMP I ACSTOR + +TMPBMP, 0 /ROUTINE TO BUMP TEMPORARIES + TAD TMPCNT /BIGGER THAN MAX? + CIA CLL + TAD TMPMAX + SZL CLA + JMP .+3 /GO BUMP TEMP CNT + TAD TMPCNT /NEW TEMP MAX + DCA TMPMAX + ISZ TMPCNT /INCR TEMP COUNT + JMP I TMPBMP + / PUSH ARG ONTO STACK +PUSH, JMS SAVEAC /GO SAVE AC IF NEEDED + JMS I QINWORD /GET ADDR OF NEW VAR + DCA TEMP /SAVE IT + TAD TEMP /PUSH IT + DCA I X16 + ISZ TEMP /GO TO TYPE + CDF 10 + TAD I TEMP /GET TYPE + CDF + AND Q17 /PUSH TYPE + DCA I X16 /ONTO STACK +CKPDL, DCA I X16 /ZERO BASE WORD + TAD X16 /IS STACK FULL ? + CIA CLL + TAD (STACK+177 + SZL CLA + JMP I QNEXT /NO, OK + TAD STKLVL /RESET STACK LEVEL + DCA X16 + JMS I QTTYMSG /PRINT MESSAGE + 2004 +DPUSH, JMS I QINWORD /GET THE VAR NAME PTR + DCA I X16 /PUSH IT + JMS I QINWORD /NOW GET THE DISPLACEMENT + JMP CKPDL-1 /GO CHECK FOR OVERFLOW +STARTF, TEXT 'STARTF' + / ARITHMETIC IF +ARTHIF, JMS I QUCODE /GET ARG INTO AC + AIFTBL-1 + JMS I QGENSF /DO ALL TRANSFERS IN FMODE + TAD (JLT /FIRST OPCODE + DCA AJUMP +AIFLUP, JMS I QINWORD /GET NEXT INPUT + DCA TEMP2 /SAVE IT IN CASE ITS NOT LABEL + TAD TEMP2 + CLL + TAD (XPUSH-XLAST /IS IT A LABEL ? + SNL CLA + JMP I QNEXTM2 /NO, PROCEED + JMS I QOPCDE +AJUMP, 0 /OUTPUT CORRECT JUMP + TAD TEMP2 + CDF 10 + JMS I QOSNUM /NOW THE LABEL + JMS I QCRLF + ISZ AJUMP /MOVE TO NEXT OPCODE + ISZ AJUMP + JMP AIFLUP +DOT, TEXT '.' +DP8, TEXT '.+10' + PAGE + / PICK UP TOP TWO ARGS + +GARGS, 0 /GET TOP 2 ARGS FROM STACK + TAD X16 + TAD QM6 /BACK TWO OPERANDS + DCA X15 + TAD X15 + DCA X16 /AND OFFICIALLY POP THE STACK + TAD I X15 /GET FIRST ARG + DCA ARG1 + TAD I X15 /AND TYPE + DCA TYPE1 + TAD I X15 + DCA BASE1 /AND FIRST BASE (IN + /CASE OF SS) + TAD I X15 /NOW SECOND ARG + DCA ARG2 + TAD I X15 + DCA TYPE2 + TAD I X15 + DCA BASE2 + TAD TYPE1 /TYPES MUST BE LT 6 + TAD QM6 + SMA CLA + JMP I GARGS /RETURN BAD + TAD TYPE2 + TAD QM6 + SPA CLA + ISZ GARGS /FIX RETURN + JMS MPTRA1 /GET ARG1 POINTER IF NEEDED + TAD ARG2 /IS ARG2 A POINTER + TAD (-61 + SZA CLA + JMP I GARGS /NO, RETURN + TAD ARG1 /IS ARG1 IN THE AC ? + SZA CLA + JMP .+5 /NO + TAD TMPCNT /YES, STORE THE AC + DCA ARG1 + TAD TYPE1 /GET TYPE + JMS I (SAVE + TAD BASE2 /MOVE POINTER FROM TEMP + /TO BASE+3 + DCA ARG2 + JMS I QGENCOD + MPTR3-1 + TAD (62 /ARG IS NOW POINTED TO + /BY BASE+3 + DCA ARG2 + JMP I GARGS +MPTRA1, 0 /MOVE ARG1 POINTER TO BASE + TAD ARG1 + TAD (-61 + SZA CLA + JMP I MPTRA1 + TAD ARG2 + SZA CLA + JMP .+5 + TAD TMPCNT + DCA ARG2 + TAD TYPE2 /GET THE TYPE + JMS I (SAVE + TAD BASE1 + DCA ARG1 + JMS I QGENCOD + MPTR0-1 + TAD (61 + DCA ARG1 /SET ARG1 TO IND0 + JMP I MPTRA1 + / BINARY OPERATORS +CODE, 0 /GENERATE CODE FOR + /BINARY OPERATORS + JMS GARGS /GET OPERANDS + JMP OTERR /BAD TYPE OPERATOR COMBO + TAD TYPE1 /INDEX INTO TYPE CHECK TABLE + CLL RTL + TAD TYPE1 + TAD TYPE2 + CLL RAL + TAD (TYPMIX-14 /POINTER TO CORRECT ENTRY + DCA SKEL + CDF 10 + TAD I SKEL /RESULTING TYPE + SNA + JMP TYPERR /THIS MIX IS ILLEGAL + DCA TYPE1 /SAVE RESULT TYPE + ISZ SKEL /GET INDEX INTO + /SKELETON TABLE + TAD I SKEL + CDF + TAD I CODE /PLUS BASE GIVES ADDR + /OF M,AC CASE + DCA SKEL + CDF 10 + TAD I SKEL /IS THIS TYPE OPER + /COMBO LEGAL ? + SNA CLA + JMP OTERR /NO + ISZ CODE /POINTS TO RESULTING TYPE + TAD ARG2 + SZA CLA + ISZ SKEL /SECOND ARG IS IN MEMORY + TAD ARG1 + SNA CLA /SKIP ON M,M CASE + ISZ SKEL /MOVE TO AC,M CASE + TAD I SKEL /PICK UP POINTER TO SKELETON + DCA SKEL + JMS I QGENCOD /GO DO THE CODE +SKEL, 0 + DCA I X16 /RESULT IS IN THE AC + TAD I CODE + SNA /IS TYPE SAME AS ARGS ? + TAD TYPE1 /YES + DCA I X16 /STORE IT + DCA I X16 /ZERO BASE WORD + TAD I CODE /IS TYPE SAME AS ARGS ? + SZA + DCA FMODE /NO, WE'RE NOW IN FMODE + JMP I CODE +TYPERR, JMS BUMP /PUT FALSE VALUE ONTO STACK + JMS I QTTYMSG /OUTPUT ERROR + 1524 +OTERR, JMS BUMP /PUT FALSE VALUE ONTO STACK + JMS I QTTYMSG + 1724 +XDPP6, TEXT '#DPT+6' +XFIX, TEXT '#FIX' + PAGE + / CODE GENERATOR (FROM SKELETONS) + +GENCOD, 0 /CODE GENERATOR ROUTINE + CDF + TAD X14 + DCA TEMP14 /FIX COMPLEX FUNCTION BUG + TAD I GENCOD /GET SKELETON ADDRESS + ISZ GENCOD +MPOPUP, DCA X14 /HERE ON MACRO END + DCA MRETN +CODLUP, CDF 10 /STUFF IS IN FIELD 1 + TAD I X14 /GET OPCODE + CDF + SNA + JMP ENDM /IS IT END OF A MACRO ? + SPA + JMP MACRO /ITS A MACRO REFERENCE + DCA .+2 /SAVE OPCODE + JMS I QOPCOD /OUTPUT IT + 0 + CDF 10 + TAD I X14 /ADDRESS ? + CDF + SNA + JMP NOADDR /NO OPERAND FOR THIS INSTR + SPA + JMP DOADDR /ADDRESS IS AN OPERAND + DCA TEMP + JMS I QOTAB /ADDRESS IS A SPECIFIC + TAD TEMP + JMS I QOUTSYM +NOADDR, JMS I QCRLF + JMP CODLUP /DO NEXT LINE +DOADDR, IAC /IS IT ARG1 ? + SZA CLA + JMP ITSA2 /NO, ITS ARG2 + JMS I QOADDR /OUTPUT ARG1 ADDRESS FIELD + ARG1 + JMP CODLUP +ITSA2, JMS I QOADDR /OUTPUT ARG2 ADDRESS + ARG2 /FIELD + JMP CODLUP +MACRO, TAD Q5 /CODES BETWEEN -1 AND -5 ARE SPECIAL + SPA + JMP .+4 /NOT ONE OF THEM + TAD (JMP MJTBL + DCA .+1 + HLT /GO TO PROPER ROUTINE + DCA MSTART /SAVE START OF MACRO + TAD X14 /SAVE RETURN ADDRESS + DCA MRETN + TAD MSTART /GO DO MACRO + DCA X14 + JMP CODLUP + ENDM, TAD MRETN /WAS THIS A MACRO ? + SZA + JMP MPOPUP /YES - GET OUT OF IT + TAD TEMP14 + DCA X14 /RESTORE X14 FOR FUNCAL + JMP I GENCOD /AND EXIT + +LOADA1, JMS I (LOADA /GENERATE LOAD + ARG1 /IF NECESSARY + JMP CODLUP +LOADA2, JMS I (LOADA /GENERATE LOAD + ARG2 /IF NECESSARY + JMP CODLUP +DOSTE, JMS I QGENSE /STARTE IF IN F MODE + JMP CODLUP +SGNNEG, ISZ RELCD /CHANGE SIGN OF RELATIONAL OPERATOR + JMP CODLUP + MSTART=TEMP +MRETN, 0 /MACRO RETURN ADDRESS +TEMP14, 0 + +MJTBL, JMP SGNNEG /-5 - NEGATE RELATIONAL SIGN + JMP LOADA2 /-4 - LOAD ARG 2 + JMP LOADA1 /-3 - LOAD ARG 1 + JMP DOSTE /-2 - START E MODE + JMS I QGENSF /-1 - START F MODE + JMP CODLUP + +XSET, TEXT 'SETX' +ZEROC1, TEXT '0,1' + / GOTO'S AND ASSIGN +CGOTO, JMS GTSTUF /LOOK AT INDEX + JMS I QGENCOD /OUTPUT COMPUTED GOTO CODE + CGTCOD-1 + JMS I QINWORD /GET COUNT + CIA + DCA TEMP2 +CGTLUP, JMS JAGEN + ISZ TEMP2 + JMP CGTLUP + JMP I QNEXT +GOTO, JMS I QGENSF /ALL TRANSFERS IN F MODE + JMS JAGEN + JMP I QNEXT + +JAGEN, 0 + JMS I QOPCDE /OUTPUT JA'S + JA + JMS I QINWORD /GET THE LABEL + CDF 10 + JMS I QOSNUM /OUTPUT IT AS THE ADDRESS + JMS I QCRLF + JMP I JAGEN + +GTSTUF, 0 + JMS I QGARG /GET THE ARG + JMP GTTYPE + CLL CMA RTL /CHECK THE TYPE + TAD TYPE1 + SMA CLA + JMP GTTYPE /NOT INTEGER OR REAL + TAD ARG1 /IS IT IN THE AC ? + SNA CLA + JMP I GTSTUF /YES ALREADY + JMS I QGENCOD + GI-1 /LOAD THE INDEX + JMP I GTSTUF +GTTYPE, JMS I QTTYMSG /GOTO TYPE ERROR + 0726 +JAC, TEXT 'JAC' +FSTA, TEXT 'FSTA' +FNEG, TEXT 'FNEG' + PAGE + / ADDRESS FIELD OUTPUT +OADDR, 0 /OUTPUT ADDRESS FIELD + TAD I OADDR /GET ADDRESS OF PARAMETERS + DCA ARG + ISZ OADDR + TAD I ARG /GET VALUE OF ARG + CLL + TAD (-52 /IS IT A TEMP REFNCE + SNL + JMP TMPREF /YES, 1-51 + TAD (52-61 /IS IT AN ARRAY REFERENCE ? + SZL + JMP SSREF /YES, 52-60 IS XR1-XR7 + SNA + JMP IND0 /INDIRECT THROUGH 0 + TAD (61-7000 /CHECK FOR DO TEMP + SZL + JMP DOTMP + TAD (7000-62 + SNA + JMP IND3 /INDIRECT THROUGH 3 + TAD (63 + DCA TEMP + CDF 10 + TAD I TEMP /IS THIS AN ARG ? + AND Q20 + CDF + SZA CLA + JMP INDARG /YES, REF IT INDIRECTLY + JMS I QOTAB + CDF 10 + TAD I TEMP /LOOK AT TYPE WORD + AND (50 /IS IT LIT OR STMT NO.? + SNA + JMP OUTA /NO, JUST OUTPUT ADDRESS + AND Q40 + SNA CLA + JMP OUTSN /OUTPUT STMT NUMBER + JMP OUTLIT /OUTPUT LITERAL +OUTA, TAD PROGNM /IS THIS THE FUNCTION NAME ? + CIA + TAD TEMP + SNA CLA + JMP FUNNAM /YES, REFERENCE #VAL INSTEAD +OUTA2, CLA CMA /SIMPLE LOCAL VARIABLE REFNCE + TAD TEMP /ADDRESS OF VAR + JMS I QOUTNAM /INTO ADDR FIELD + JMS I QCRLF + JMP I OADDR /END OF ADDRESS +OUTLIT, ISZ TEMP /MOVE TO LITERAL NUMBER + TAD I TEMP + DCA TEMP /DISPLACEMENT FROM %LITRL + CDF + TAD QLITRL /OUTPUT #LIT+ + JMS I QOUTSYM + TAD TEMP /DISPLACEMENT + JMS I QONUMBR + JMP OADRET-1 +FUNNAM, TAD (XVAL /#VAL + JMS I QOUTSYM + JMP OADRET-1 +SSREF, TAD (270 /MAKE IT AN ASCII DIGIT + DCA XR + ISZ ARG /POINT TO THE BASE WORD + TAD I ARG /GET THE ADDR OF THE BASE + DCA ARG + CDF 10 + TAD ARG + IAC /GO TO TYPE OF BASE VAR + DCA TEMP2 + TAD I TEMP2 /IS IT AN ARG TO THE SUBR ? + AND Q20 + SNA CLA + JMP NOTARG /NO, NO INDIRECT STUFF + CDF + JMS SIT + TAD ARG /VAR NAME + CDF 10 + JMS I QOUTNAM + TAD COMMA + JMS I QOCHAR + TAD XR /XR NUMBER + JMS I QOCHAR + JMS I QCRLF +OADRET, JMP I OADDR +IND3, TAD (XBASP3-XBASE /INDIRECT THRU #BASE+3 +IND0, TAD (XBASE /INDIRECT THRU #BASE + DCA TEMP + JMS SIT + TAD TEMP + JMP FUNNAM+1 +OUTSN, CLA CMA /OUTPUT STMT NUMBER + TAD TEMP + JMS I QOSNUM /OUTPUT THE NUMBER + TAD (P2 /+2 (HACK FOR FORMAT) + JMP FUNNAM+1 +INDARG, JMS SIT /INDIRECT INDICATOR + CDF 10 + JMP OUTA2 /OUTPUT ARG NAME +SIT, 0 + TAD (245 /% (INDIRECT) + JMS I QOCHAR + JMS I QOTAB + JMP I SIT +CEQ, TEXT '#CEQ' +XBAC1P, TEXT '#BASE,1+' +XUE, TEXT '#UE' + PAGE + / ADDRESS FIELD OUTPUT + +NOTARG, TAD I TEMP2 /GET TYPE WORD + DCA TEMP /SAVE IT + TAD TEMP + ISZ TEMP2 + AND Q200 /EQUIVALENCED ? + SNA CLA + JMP .+3 + TAD I TEMP2 /SKIP EQUIV INFO BLOCK + DCA TEMP2 + CLL CML RTL + TAD I TEMP2 /ADDRESS OF MAGIC NUMBER + DCA TEMP2 + TAD I TEMP2 /MAGIC NUMBER ITSELF + DCA TEMP2 + CDF + JMS I QOTAB /TAB + TAD ARG /OUTPUT VARIABLE MINUS CONST + JMS VMC + TAD COMMA + JMS I QOCHAR + TAD XR /N + JMS I QOCHAR + JMS I QCRLF /END OF LINE + JMP OADRET +DOTMP, DCA TEMP /ADDRESS RELATIVE TO %DOTMP + JMS I QOTAB + TAD (DOTMPN /OUTPUT #DOTMP + JMS I QOUTSYM + JMP PLUSN /GO OUTPUT +XXXX +TMPREF, CLA + TAD I ARG /BUMP TEMPS BACK CORRECTLY (?) + DCA TMPCNT + JMS I QOTAB /TAB + CLA CMA + TAD I ARG /GET NUMBER + DCA TEMP /INTO TEMP + IFNZRO TMPBLK-2 + CLL STA RAL /V3C -2 (-TMPBLK) + /V3C LINK SET + TAD TEMP /V3C (SAVES A LITERAL) + SNL /V3C + DCA TEMP /YES, SAVE ALTERED DISPLACEMENT + SNL CLA /V3C + TAD (TEMPN2-TEMPN /USE %TEMPX + TAD (TEMPN /USE %TEMP + JMS I QOUTSYM +PLUSN, TAD PLUS /PLUS CONSTANT + JMS I QOCHAR + TAD TEMP /DISPLACEMENT TIMES THREE + CLL RAL + TAD TEMP + JMS I QONUMBR /OUT IT + JMS I QCRLF + JMP OADRET + / UTILITIES +VMC, 0 /OUTPUT VARIABLE MINUS CONST + CDF 10 + JMS I QOUTNAM /PUT VAR NAME + TAD Q255 /- + JMS I QOCHAR + TAD TEMP /THIS CONTAINS THE TYPE + JMS SKPIRL /SKIP ON I,R OR L + TAD Q3 /USE SIX WORDS PER ENTRY + TAD Q3 /REAL, INTEGER, OR + /LOGICAL 3 WORDS + DCA MQ + TAD TEMP2 + JMS MUL12 /DO MULTIPLY + JMS I QNUMBRO /OUTPUT 15 BIT NUMBER + JMP I VMC +SC, +SKPIRL, 0 /SKIP ON TYPE I R OR L + AND Q17 /ISOLATE TYPE CODE + TAD QM4 /IS IT DOUBLE ? + SZA + IAC /NO, IS IT COMPLEX ? + SZA CLA + ISZ SKPIRL /NEITHER, SKIP + JMP I SKPIRL /RETURN +MUL12, 0 /12 BIT MULTIPLY + DCA OPRND + TAD (-15 + DCA SC + JMP STMUL +M12LUP, TAD AC + SNL + JMP .+3 + CLL + TAD OPRND + RAR +STMUL, DCA AC + TAD MQ + RAR + DCA MQ + ISZ SC + JMP M12LUP + JMP I MUL12 +OPRND, +BUMP, 0 /PUT FALSE ENTRY ONTO STACK + CDF 0 /V3C IMPORTANT PROTECTION + DCA I X16 + ISZ X16 + ISZ X16 /THIS PREVENTS UNDER + /FLOWING THE STACK + JMP I BUMP /AFTER SOME ERRORS +EXTERN, TEXT 'EXTERN' +CADD, TEXT '#CAD' +CNEG, TEXT '#CNG' +CMUL, TEXT '#CML' +JLE, TEXT 'JLE' +ORG, TEXT 'ORG' +STARTE, TEXT 'STARTE' +XDPTMP, TEXT '#DPT' + PAGE + / RANDOM CODE GENERATORS + +ERROR, JMS I QINWORD /GET ERROR CODE + JMS I QERMSG /PRINT IT + JMP I QNEXT +EOSTMT, TAD DATASW /WAS THIS A DATA STMT ? + SNA CLA + JMP OPTMYZ /NO + DCA DATASW /KILL SWITCH + JMS I QOPCDE + ORG /ORIGIN BACK TO THE PROGRAM + TAD GLABEL + JMS I QOLABEL + JMS I QCRLF + ISZ GLABEL /BUMP LABEL GENERATOR +OPTMYZ, CLA /CHANGED TO CLA IAC IF /O + JMS I QXRTBL /CLEAR TABLE OR RESET FLAGS + ISZ LINENO /BUMP LINE NUM + TAD LINENO /DISPLAY IN MQ + 7421 /FOR COOLNESS + CLA /FOR NON-EAE FOLKS + TAD STKLVL /RESET STACK LEVEL + DCA X16 + JMS IFEND /LOOK FOR END OF LOGICAL IF + JMS I (ASFEND /END OF A.S.F. DEFINITION ? +DEBUG, JMP I QNEXT /OVERLAYED IF NO /N SWITCH + JMS I QOPCDE /OUTPUT LDX NNNN,0 + LDX + TAD LINENO /THIS IS THE CURRENT ISN + JMS I QONUMBR + TAD COMMA + JMS I QOCHAR + TAD Q260 + JMS I QOCHAR + JMS I QCRLF + JMP I QNEXT +IFEND, 0 /OUTPUT IF END LABEL IF + TAD IFLABL /WAS THIS END OF LOG IF + SNA + JMP I IFEND /OUTPUT DEBUG STUFF + JMS I QLABEL /OUPTUT THE LABEL + JMS I QGENSF /ALL LOGICAL IFS MUST + /END IN FMODE + DCA WHATAC /CAN'T DEPEND ON + /AC HERE + JMS I QXRTBL /OR XR'S EITHER + DCA IFLABL /KILL THE SWITCH + JMP I IFEND +OPCOD, 0 /TAB OPCODE + DCA WHATAC /AC HAS JUST BEEN + /MODIFIED + JMS I QOTAB + TAD I OPCOD + ISZ OPCOD + JMS I QOUTSYM + JMP I OPCOD +DIV, JMS I QSAVACT /IF SECOND OPERAND IN AC, SAVE IT + JMS I QCODE /DIVIDE + DIVTBL-6;0 + CLA CMA /WERE BOTH VARS INTEGER? + TAD TYPE1 + SZA CLA + JMP I QNEXT /NO + JMS I QGENCOD + A0FN-1 /ALN 0;FNORM + JMP I QNEXT +LIFBGN, DCA RELCD /ENTER HERE IF LAST OPCODE NOT A RELATIONAL + JMS I QGARG /ENTER HERE FROM RELATIONAL OPTIMIZER + JMP NOTLOG + TAD TYPE1 /MUST BE LOGICAL + TAD (-5 + SZA CLA + JMP NOTLOG + TAD ARG1 /IS IT IN AC ? + SNA CLA + JMP .+3 + JMS I QGENCOD + GI-1 + JMS I QINWORD /IS IT IF(...)GOTO XX ? + DCA TEMP2 + TAD TEMP2 + TAD (XPUSH-XGOTO + SNA CLA + JMP IFGOTO /YES, TREAT AS SPECIAL CASE + TAD GLABEL /SET IF LABEL + DCA IFLABL + TAD RELCD + CIA + TAD Q5 /GENERATE THE OPPOSITE JUMP + JMS RELJMP /AROUND THE TARGET OF THE IF + TAD GLABEL + JMS I QOLABEL + ISZ GLABEL /INCREMENT LABEL GENERATOR + JMS I QCRLF + JMP I QNEXTM2 +IFGOTO, TAD RELCD + JMS RELJMP /GENERATE TRUE RELATIONAL JUMP IF "IF()GOTO" + JMS I QINWORD /GET THE LABEL + CDF 10 + JMS I QOSNUM + JMS I QCRLF + JMP I QNEXT +NOTLOG, JMS I QTTYMSG + 1411 + +RELJMP, 0 + CLL RAL + TAD (JNE + DCA .+2 + JMS I QOPCDE + 0 + JMP I RELJMP + +FMUL, TEXT 'FMUL' +FDIV, TEXT 'FDIV' +CAC, TEXT '#CAC' +LITRL, TEXT '#LIT+' +TEMPN, TEXT '#TMP' + PAGE + / DO LOOP COMPILER + +DOBEGN, JMS I QSAVACT /FOR EXPR IN LOOP PARAMS + TAD X16 /SET NEW STACK LEVEL + DCA STKLVL + JMS I QGARGS /GET LIMIT AND STEP + JMP DPERR /ERROR IN DO PARMS + JMS DOPARM /DO PARAMETER STUF FOR LIMIT + ARG1 + JMS DOPARM + ARG2 /AND THEN FOR STEP + TAD ARG1 /REPLACE ALTERRED STACK + /ENTRIES + DCA I X16 + ISZ X16 /REST OF ARG1 OK + TAD GLABEL /SAVE LOOP LABEL + DCA I X16 + TAD ARG2 + DCA I X16 + ISZ X16 + ISZ X16 + JMS I QCRLF /CRLF BEFORE LABL + TAD GLABEL + JMS I QLABEL /OUPTUT LOOP LABEL + ISZ GLABEL /INCR LABEL GENERATOR + DCA WHATAC /FORGET AC AND + JMS I QXRTBL /XR'S AT DO BEGIN + JMP I QNEXT +DOSTOR, JMS I QGARGS /LOOK AT INDEX AND + JMP DPERR /INITIAL VALUE + CLL CMA RTL /MUST BE INTEGER OR + TAD TYPE1 /REAL (L=1 AC=-3) + SZL CLA /SKIP IF >2 + CLL CMA RTL /L=1 AC=-3 + TAD TYPE2 + SZL CLA /L=0 IS BAD + JMP I (STORE+2 /DO STORE IF OK +DPERR, JMS I QTTYMSG /ERROR IN LIMITS + 0420 /DP +DOFINI, JMS I QXRTBL /DON'T OPTIMIZE XR USAGE + /IN SUCCESSIVE IMPLIED DO LOOPS + TAD IOSTMT /INSIDE IO STMT ? + SNA CLA + JMS IFEND /IF NOT, END IF FIRST + JMS I QINWORD /GET THE INDEX + DCA ARG1 + TAD ARG1 /GET THE TYPE WORD ADR + IAC + DCA TYPE1 + CDF 10 + TAD I TYPE1 + CDF + AND Q17 + DCA TYPE1 /TYPE OF INDEX VAR + TAD QM6 + TAD STKLVL /BACK UP THE STACK + DCA X16 + TAD X16 /RESET THE STACK LEVEL + DCA STKLVL + TAD I X16 /GET THE FINAL VALUE + DCA DOARG + ISZ X16 + TAD I X16 /GET THE LOOP LABEL + DCA DARG + TAD I X16 /GET THE STEP + DCA ARG2 + TAD I X16 /WHICH DO FIN CODE ? + CLL CML RAL + TAD TYPE1 + TAD QM6 + SNA CLA + TAD (DOFIN1-DOFIN0 /INDEX=I, STEP=R + TAD (DOFIN0-1 /ALL OTHER CASES + DCA .+2 + JMS I QGENCOD /DO FINISH CODE + 0 + JMS I QOPCOD /SUBTRACT UPPER LIMIT + FSUB + JMS I QOADDR + DOARG + JMS I QOPCDE /NOW THE JLT %%LOOP + JLE + TAD DARG /OUTPUT LABEL + JMS I QOLABEL + JMS I QCRLF + TAD STKLVL /FIX X16 INCASE MULTIPLE DO ENDER + DCA X16 + JMP I QNEXT +DOARG, +DOPARM, 0 /SUBR FOR DO PARAMETERS + TAD I DOPARM + ISZ DOPARM /GET THE PARM POINTER + DCA DARG + CLL CML RTL /GET ADDR OF TYPE WORD + TAD DARG + DCA TYPE + CLL CMA RTL /CHECK TYPE + TAD I TYPE + SMA CLA + JMP DPERR /NOT I OR R + TAD I DARG + SNA + JMP STRTMP /ARG ALREADY IN AC + TAD QM63 /IS IT ARRAY REF? + SPA CLA + JMP SVLIMT /YES, SAVE LIMIT + TAD I DARG /REGET SYM ADDR + DCA X10 /ADR OF TYPE WORD + CDF 10 + TAD I X10 /MAYBE ITS A LIT? + CDF + AND Q40 + SZA CLA + JMP I DOPARM /YES, ITS LITERAL + /WE'RE ALWAYS IN F MODE HERE + /SINCE THE LAST THING + /WAS A DO STORE +SVLIMT, JMS I QOPCOD /OTHERWISE LOAD IT + FLDA + JMS I QOADDR +DARG, 0 +STRTMP, TAD DOTEMP /SET ARG TO NEXT DO TEMP + DCA I DARG + JMS I QOPCOD /GENERATE STORE + FSTA + ISZ DOTEMP /BUMP DO TEMP + TAD DARG + DCA .+2 + JMS I QOADDR /DO TEMP ADDRESS FIELD + 0 + JMP I DOPARM + PAGE + / SUBSCRIPT REFERENCE COMPILER + +ARGS, JMS I QINWORD /COMPILE ARGUMENT LIST + CMA + DCA NARGS /NUMBER OF ARGS + TAD NARGS /GET ADDRESS OF SUBSCRIPTED VAR + CLL RAL + TAD NARGS /ENTRY ON THE STACK + TAD X16 + DCA X15 + TAD X15 /SAVE POINTER TO START + /OF THIS ENTRY + DCA X14 /FOR POSSIBLE FUTURE USE + ISZ NARGS /NOW ITS THE 2'S COMPLEMENT + NOP + TAD I X15 /FETCH SS VARIABLE + DCA BASE1 + TAD I X15 /ITS TYPE + DCA TYPE1 + TAD BASE1 /STORE BASE WORD + DCA I X15 + TAD BASE1 /GET ADDR OF TYPE WORD + IAC + DCA TEMP + CDF 10 /GET TYPE WORD + CLL CML RTR /TEST DIM BIT + AND I TEMP + SNA CLA + JMP TRYCAL /SOME KIND OF CALL + TAD BASE1 /NOW GET ADDRESS OF DIM INFO + JMS I QGETSS + DCA ARG1 /RETURNS WITH FIELD SET + TAD I ARG1 /CORRECT NUMBER OF DIMENSIONS? + TAD NARGS + CDF + SZA CLA + JMP DIMERR /NO + ISZ ARG1 /SKIP TOTAL SIZE + ISZ ARG1 /SKIP MAGIC NUMBER + ISZ ARG1 /AND ASSOCIATED LITERAL + DCA XRNUM /START WITH XR 1 + TAD (-10 /SEVEN XRS + DCA XRCNT /COUNT FOR SEARCH + DCA FREEXR /ZERO FREE XR INDICATOR +XRCHEK, CDF + ISZ XRCNT /ANY MORE XR EXPRS TO TEST ? + SKP /YES, GO CHECK THEM + JMP COMPSS /NO, MUST COMPILE + /XR ERPRESSION + ISZ XRNUM /BUMP XR NUMBER + TAD XRNUM + CLL RTL /TIMES 16 + CLL RTL + TAD (XRBUFR-1 /PLUS BASE (-1) + DCA X13 + TAD I X13 /LOOK AT THE + SPA /INDICATOR + JMP .+3 /-1=USED BY THIS STMT + SZA CLA /IF ZERO GO TO + /MTXR (EVENTUALLY) + TAD FREEXR /ANY FREE BEFORE THIS ONE ? + SZA CLA + JMP NOTMT /YES, ALREADY FOUND ONE + TAD XRNUM /THIS WILL BE + DCA FREEXR /THE XR WE USE + JMP XRCHEK /GO LOOK AT NEXT +NOTMT, TAD X13 /SAVE FLAG ADDRESS + DCA XRFLAG /IN CASE WE NEED IT LATER + TAD I X13 /POINTER TO THE DIM INFO + DCA TEMP2 + CDF 10 + TAD I TEMP2 /SAME NUMBER OF DIMS ? + TAD NARGS + SZA CLA + JMP XRCHEK /NO, THIS XR WONT DO + TAD NARGS /SET COUNTER + DCA DCNT + TAD ARG1 /POINTER TO DIM FACTORS + DCA X12 + ISZ TEMP2 /SKIP THREE WORDS + ISZ TEMP2 + ISZ TEMP2 +DCHEK, ISZ DCNT /ANY MORE ? + SKP + JMP SSCHEK /DIMS OK, CHECK SS + ISZ TEMP2 /GET TO NEXT DIM + TAD I TEMP2 /ARE THEY EQUAL ? + CIA + TAD I X12 + SZA CLA + JMP XRCHEK /NO, GO TRY NEXT ONE + JMP DCHEK +SSCHEK, TAD NARGS /COUNT AGAIN + CDF + DCA DCNT + CLL CMA RAL /-2 + TAD X16 /ADDR OF START OF TOP + /SS ON STACK + JMP .+3 +SSC2, CLL CMA RTL /-3 + TAD XTMP /BACK UP TO NEXT LOWER SS + DCA XTMP /LINK IS ALWAYS ZERO HERE + TAD I XTMP /GET NEXT SS (WORKING + /RIGHT TO LEFT) + TAD (-61 /IS IT A VAR OR LITERAL? + SNL CLA + JMP XRCHEK /WE'RE JUST + /LOOKING FOR AN EMPTY + TAD I XTMP /RE GET SS POINTER + CIA + TAD I X13 /ARE THEY THE SAME ? + SZA CLA + JMP XRCHEK /NO + ISZ DCNT + JMP SSC2 /KEEP CHECKING + TAD XRNUM /THEY MATCH, STICK IN + /THE XR NUMBER + TAD (51 + DCA I X14 + CLL CML RTL + TAD X14 /PURGE SS FROM STACK + DCA X16 + CLA CMA /SET FLAG TO + /'USED BY THIS STMT' + DCA I XRFLAG + JMP I QNEXT +DCNT, 0 +XRFLAG, 0 +XTMP, 0 + PAGE + / SUBSCRIPT REFERENCE COMPILER + +COMPSS, TAD FREEXR /GET XR EXPR AREA + CLL RTL /BY MULTIPLYING + /THE NUMBER + CLL RTL /BY 16 + TAD (XRBUFR /AND ADDING THE + /BASE ADDRESS + DCA XREPTR /THIS IS IT + CLA CMA /SET USED BY THIS + /STMT FLAG + DCA I XREPTR + ISZ XREPTR + CLL CMA RTL /STORE THE DIB POINTER + TAD ARG1 + DCA I XREPTR + TAD NARGS /GET ADDR OF POINTER TO LAST + CMA /DIMENSION FACTOR + TAD ARG1 + DCA ARG1 /SINCE WE USE THEM IN + /REVERSE ORDER + JMS I QSAVEAC /STORE AC IF NEEDED + /FOLLOWING INSTRUCTION REMOVED FOR OPTOMIZATION +/ JMS I QGENSF /ALL SUBSCRIPTS AR I OR R + TAD (FLDA /LOAD FIRST SS + SKP +CSSLUP, TAD (FADD /ADD ALL SUBSEQUENT ONES + DCA OPC + CLL CMA RTL /BACK UP STACK BY ONE ENTRY + TAD X16 + DCA X16 + TAD X16 /GET A WORKING POINTER + DCA X15 + TAD I X15 /GET THE NEXT SUBSCRIPT + DCA ARG2 + CLL CMA RAL /MUST BE INTEGER + TAD I X15 + SMA CLA + JMP DIMERR + TAD I X15 + DCA BASE2 + TAD ARG2 /STORE THE SS INTO THE + /XR EXPR + ISZ XREPTR /INCREMENT FIRST + DCA I XREPTR + TAD ARG2 /IS ARG2 THE AC (ONLY + /POSSIBLE IF + SNA CLA /ITS THE RIGHTMOST + /SUBSCRIPT) + JMP NLODSS /YES, DON'T LOAD IT + JMS I QOPCOD /OUTPUT LOAD OR ADD +OPC, 0 /THIS LOCATION TELLS + /THE STORY + JMS I QOADDR /FOLLOWED BY THE OPERAND + ARG2 /POINTED TO BY ARG2 +NLODSS, ISZ NARGS /ANY MORE SUBSCRIPTS ? + JMP MORESS /YES, GO COMPILE THEM + TAD FREEXR /ANY FREE INDEX REG? + SZA CLA + JMP ASGNXR /YES, GO USE IT + TAD (61 /ITS A SPECIAL POINTER ENTRY + DCA I X14 + ISZ X14 + TAD TMPCNT /SAVE TEMP NUMBER + DCA I X14 /BEFORE WE BLOW X14 + JMS I (GENPTR /GENERATE POINTER TO THE ARG + JMS I QGENCOD /BACK TO FMODE + SF-1 + JMS I (ACSTOR /GENERATE STORE AC + JMP I QNEXT +DIMERR, JMS I QTTYMSG /SS NOT OF CORRECT NUMBER + 2323 +XRCNT, 0 +TRYCAL, TAD ASFSWT /ASF DEFINITION + SMA SZA CLA + JMP DEFASF /YES, GO OUTPUT PROLOG + TAD I TEMP /IS IT A FUNCTION OR AN ARG? + CDF + AND (1420 + SNA + JMP DIMERR /NO, SOME KIND OF ERROR + AND Q20 + DCA ACSWIT /SAVE THE AC SWITCH + JMP FUNCAL /STANDARD FUNCTION CALL +MORESS, JMS I QGENSF /MUST USE SINGLE PRECISION FOR MULTIPLY + JMS I QOPCOD /MULTIPLY BY DIM FACTOR + FMUL + CDF 10 + TAD I ARG1 /PICK UP FACTOR ADDRESS + CDF + DCA ARG2 + CLA CMA + TAD ARG1 /MOVE BACK ONE + DCA ARG1 + JMS I QOADDR /OUTPUT MULTIPLY ADDRESS + ARG2 + JMP CSSLUP /LOOP ON NEXT SS +ASGNXR, JMS I QOPCDE /OUTPUT ATX N + ATX + TAD FREEXR /GET NUMBER OF FREE XR + TAD Q260 + JMS I QOCHAR + JMS I QCRLF + TAD FREEXR + TAD (51 /COMPUTE PROPER NUMBER + DCA I X14 /PUT IT INTO TOP OF STACK + JMP I QNEXT +XREPTR, 0 + / RANDOM TEXT +OTAB, 0 + TAD (211 + JMS I QOCHAR + JMP I OTAB +FCLA, TEXT 'FCLA' +STARTD, TEXT 'STARTD' +TEMPN2, TEXT '#TMPX' +CSUB, TEXT '#CSB' +CDIV, TEXT '#CDV' + PAGE + / GENERAL CALL GENERATOR + +GENCAL, 0 /GENERATE A CALL; ALL ARGS ON STACK + /X15 POINTS TO START OF STACK INFO + /NARGS IS NEG NUMBER OF ARGS + /FUNCTION NAME IS FIRST ON STACK + TAD I GENCAL /GET FUN NAME SWITCH + DCA FNSWIT + TAD X15 /NEW STACK VALUE + DCA X16 + TAD X15 /WORKING POINTER + DCA ARG2 + TAD NARGS /WORKING COUNTER + SNA + JMP OUTJSR /NO ARGS, PUT JSR + DCA TYPE2 +CHKPTR, ISZ ARG2 /MOVE TO NUMBER + TAD ARG2 + IAC /ADDR OF TYPE WORD + DCA BASE2 + TAD I BASE2 /GET TYPE + DCA TYPE1 /TYPE OF ARG FOR GENPTR + ISZ BASE2 /POINT TO BASE WORD + TAD I BASE2 + DCA BASE1 /FOR GENPTR + TAD I ARG2 /GET ARG NUMBER + CLL + TAD (-52 /IS IT INDEXED ? + SNL + JMP NOTINX /NO, ITS A TEMP + TAD (52-61 /IS IT INDIRECT ? + SZL + JMP INXR /NO, ITS IN AN XR + SNA + JMP INTMP /POINTER IN A TEMP + TAD (62 /GET TO TYPE WORD + DCA GCTEMP + CDF 10 + TAD I GCTEMP /IS IT AN ARG + CDF + AND (1020 /ARG OR EXTERNAL ? + SNA + JMP NOTINX+1 /NEITHER + AND Q20 + SZA CLA + JMP ARGARG /ARG SQUARED + JMP EXTARG /EXTERNAL ARG +NOTINX, CLA + ISZ ARG2 /BUMP POINTER + ISZ ARG2 + ISZ TYPE2 /INCR COUNT + JMP CHKPTR +OUTJSR, TAD JSRLBL /DOES IT GET A LABEL ? + SNA + JMP .+3 /NO + JMS I QLABEL /OUPTUT THE LABEL+COMMA + DCA JSRLBL /KILL SWITCH + TAD X16 /ADDR OF POINTER TO FUN NAME + DCA TEMP +FNSWIT, 0 /REAARANGED** + JMP I (IOFUN /IO FUNCTION CALL + JMS I QOPCDE /OUTPUT THE JSR + JSR + TAD I TEMP /NOW THE SUBR NAME + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + TAD NARGS /ANY ARGS ? + SNA CLA + JMP I GENCAL /NO, END OF CALL + JMS I QOPCDE /JUMP AROUND THE ARGS + JA + TAD Q256 + JMS I QOCHAR /. + TAD PLUS + JMS I QOCHAR /+ + CLL CLA CMA RAL /-2 + TAD NARGS /-N-2 + CLL CMA RAL /2*N+2 + JMS I QONUMBR +IOONLY, JMS I QCRLF + TAD X16 /WORKING POINTER + DCA X15 +PTRLST, TAD I X15 /GET NEXT ARG + SZA + JMP SARG /SIMPLE ARG + CLL CML RTL + TAD X15 /ADDR OF GENERATED + /LABEL NUMBER + DCA TEMP + TAD I TEMP /OUTPUT #GXXXX (THE + /GENERATED LABEL) + JMS I QLABEL /OUPTUT THE LABEL + JMS I QGENCOD + JADP2-1 /GENERATE A DUMMY JA + JMP BARGLP +SARG, DCA ARG2 /STORE THE ARG NUMBER + JMS I QOPCOD /OUTPUT JA ARG + JA + JMS I QOADDR /NOW ADDRESS FIELD + ARG2 +BARGLP, ISZ X15 /BUMP POINTER + ISZ X15 + ISZ NARGS /BUMP COUNT + JMP PTRLST + JMP I GENCAL +INTMP, TAD I BASE2 /GET TEMP NUMBER + DCA ARG1 /THAT PTR IS STORED IN + JMS I QGENCOD /PICK UP POINTER + LDASTD-1 +STRPTR, JMS I QOPCDE /NOW STORE THE POINTER + FSTA + TAD GLABEL /OUTPUT THE LABEL + JMS I QOLABEL + JMS I QCRLF + TAD GLABEL /SAVE THE LABEL NUMBER + DCA I BASE2 + DCA I ARG2 /ZERO ARG NUMBER + ISZ GLABEL /INCREMENT LABEL NUMBER + JMS I QGENCOD /BACK TO F MODE + SF-1 + JMP NOTINX /CONTINUE LOOP +NLABEL, 0 + JMS I QOLABEL + TAD COMMA + JMS I QOCHAR + JMP I NLABEL + PAGE + / GENERATE SUBROUTINE CALL + +FUNCAL, JMS I QSAVEAC /SAVE NEXT TO LAST IF NEEDED + JMS I QSAVACT /SAVE LAST IF NEEDED + JMS I QGENSF /ALL CALLS DONE IN F MODE + DCA I X14 /RESULT RETURNED IN AC + TAD ACSWIT /IS THE SUBR AN ARG ? + SNA CLA + JMP MAKCAL /NO, ITS EASIER + JMS I QOPCOD /GET THE JSR TO THE SUBR + FLDA + JMS I QOADDR + BASE1 /BY GETTING THE VALUE + /OF THE ARG + JMS I QGENCOD /STARTD + SD-1 + JMS I QOPCDE /STORE IT AHEAD + FSTA + TAD GLABEL /INTO THE JSR + ISZ GLABEL + DCA JSRLBL /SET THE SWITCH + TAD JSRLBL + JMS I QOLABEL + JMS I QCRLF + JMS I QGENCOD /STARTF + SF-1 +MAKCAL, ISZ BASE1 /MOVE TO TYPE WORD + CDF 10 + TAD I BASE1 /GET TYPE OF FUNCTION + CDF + JMS I QSKPIRL /WHAT MODE WILL WE LEAVE IN? + DCA FMODE /PROBABLY E + JMS I QGENCAL /GO GENERATE THE CALL + SKP + 0 /THIS IS A FREE LOCATION + JMP I QNEXT +ARGARG, JMS I QOPCDE /%FLDA + FLDA + TAD I ARG2 /POINTER + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + JMS I QGENCOD /%SD + SD-1 + CDF 10 + CLL CML RTR /IS IT AN ARRAY ? + AND I GCTEMP + CDF + SNA CLA + JMP STRPTR /GO STORE THE POINTER + TAD I ARG2 /GET THE LITERAL NUMBER + JMS I QGETSS + TAD Q3 + DCA GCTEMP + TAD I GCTEMP + DCA OLABEL /SAVE IT + CDF + JMS I QOPCDE /%FADD LITERAL + FADD + TAD QLITRL + JMS I QOUTSYM + TAD OLABEL /XXXX + JMS I QONUMBR + JMS I QCRLF + JMP STRPTR /GO STORE THE POINTER +INXR, TAD (270 /MAKE AN ASCII CHAR + DCA XR + JMS I QOPCDE /XTA + XTA + TAD XR + JMS I QOCHAR /N + JMS I QCRLF + TAD BASE1 /FIND ADDR OF MAGIC + /NUMBER LITERAL + JMS I QGETSS + CDF + TAD Q3 + DCA ARG1 + JMS I (GENPTR /GENERATE THE POINTER + JMP STRPTR /GO STORE THE POINTER +EXTARG, TAD I ARG2 /MAKE AN ENTRY IN THE EXT + CDF 10 /LITERAL LIST + DCA I X17 + TAD DOTEMP /USE DO TEMPS FOR THIS + DCA I X17 + CDF + TAD DOTEMP /SINCE OADDR CAN HANDLE THEM + DCA I ARG2 + ISZ DOTEMP /BUMP COUNT + ISZ ELCNT /ALSO EXT LIT COUNT + JMP NOTINX /BACK TO PROCESSING ARGS + / UTILITY ROUTINES +OLABEL, 0 /OUTPUT #GXXXX FOR GEN'D LABELS + DCA TEMP + TAD (243 + JMS I QOCHAR + TAD (307 + JMS I QOCHAR + TAD TEMP + JMS I QONUMBR + JMP I OLABEL +OPCODE, 0 /TAD OPCODE TAB + DCA WHATAC /THIS INSTRUCTION ZAPS AC + JMS I QOTAB + TAD I OPCODE + ISZ OPCODE + JMS I QOUTSYM + JMS I QOTAB + JMP I OPCODE +M1C2, TEXT '-1,2' +GENSTE, 0 /GENERATE STARTE IF IN + /F MODE + TAD FMODE /LOOK AT THE SWITCH + SNA CLA + JMP I GENSTE /ALREADY IN E MODE + DCA FMODE /CLEAR THE SWITCH + JMS I QOPCOD /GENERATE THE STARTE + STARTE + JMS I QCRLF /CAN'T USE GENCOD FOR THAT + JMP I GENSTE +D0, TEXT '0' +DOTMPN, TEXT '#DOTMP' + PAGE + / OPCODES AND OTHER TEXT + +XBASE, TEXT '#BASE' +XBASP3, TEXT '#BASE+3' +DP3C0, TEXT '.+3,0' +JXN, TEXT 'JXN' +ALN, TEXT 'ALN' +ATX, TEXT 'ATX' +XTA, TEXT 'XTA' +LDX, TEXT 'LDX' +XREW, TEXT '#REW' +XENDF, TEXT '#ENDF' +XBAK, TEXT '#BAK' +XEXIT, TEXT '#EXIT' +XRTN, TEXT '#RTN' + JNE, TEXT 'JNE' + TEXT 'JGE' + TEXT 'JLE' + TEXT 'JGT' +JLT, TEXT 'JLT' /MUST BE IN THIS ORDER!! + TEXT 'JEQ' +JA, TEXT 'JA' + +JSR, TEXT 'JSR' +JSA, TEXT 'JSA' /MUST BE IN THIS ORDER! +TRAP3, TEXT 'TRAP3' + / POINTER GENERATOR +GENPTR, 0 /GENERATE A POINTER + JMS I QOPCOD /MULTIPLY BY 3. OR 6. + FMUL + TAD TYPE1 /D OR C ? + JMS I QSKPIRL /SKIP ON I, R, OR L + TAD Q6M3 + TAD (THREE + DCA TEMP /POINTER TO CORRECT LITERAL + JMS I QOADDR + TEMP + JMS I QGENCOD /ALN 0; STARTD + A0SD-1 + JMS I QOPCDE /FADD THE BASE LITERAL + FADD + ISZ BASE1 /GET ADDR OF TYPE WORD + CDF 10 + TAD I BASE1 /GET TYPE WORD + AND Q20 + SNA CLA + JMP NIARG /NOT AN ARG + CMA + TAD BASE1 + JMS I QOUTNAM /IF AN ARG, THE LITERAL + /IS THE ARG + JMP OSF +NIARG, CDF + TAD QLITRL /OTHERWISE ITS IN THE + /LITERAL BLOCK + JMS I QOUTSYM + CDF 10 + TAD I ARG1 /LITERAL NUMBER + CDF + JMS I QONUMBR +OSF, JMS I QCRLF + JMP I GENPTR + / MORE RANDOM CODE GENERATORS +STOP, JMS I QGENCOD /CALL EXIT + STPCOD-1 + JMP I QNEXT +FORMAT, JMS I QINWORD /NUMBER OF WORDS OF TEXT + CMA + DCA TEMP + JMS I QOPCDE /JA AROUND THE STUFF + JA + TAD Q256 + JMS I QOCHAR /. + TAD PLUS + JMS I QOCHAR + CLL CMA RAL /.+2+NWORDS + TAD TEMP + CMA + JMP .+3 +FMTLUP, JMS I QOTAB /TA + JMS I QINWORD /GET NEXT WORD + JMS I QONUMBR /OUTPUT IT + JMS I QCRLF + ISZ TEMP + JMP FMTLUP + JMP I QNEXT + +DFRTTM, 0 /ROUTINE TO DELETE "SYS:FORTRN.TM" + CLA IAC + CIF 10 + JMS I Q200 + 4 + FTRNTM + 0 + NOP + JMP I DFRTTM + +EQUDOT, TEXT '=.' +XPAUSE, TEXT '#PAUSE' + PAGE + /REWIND, ENDFILE, BACKSPACE + +REWIND, TAD (XREW-XENDF +ENDFIL, TAD (XENDF-XBAK +BAKSPC, TAD (XBAK + DCA REBSUB + JMS I QUCODE + AIFTBL-1 /GET UNIT INTO FAC + JMS I QGENSF /FORCE F MODE + CLA STL RTL + JMS I (OJSR +REBSUB, 0 + JMP I QNEXT + / DATA STATEMENT STUFF +DATAST, TAD X16 /SAVE STACK + DCA DSTACK + TAD DATASW /MULTIPLE DATA STMT ? + SZA CLA + JMP FIXDAT-2 /YES, DON'T OUTPUT LABEL + ISZ DATASW /SET DATA SWITCH + JMS I QOTAB /DEFINE ORIGIN SYMBOL + TAD GLABEL + JMS I QOLABEL + TAD (EQUDOT /#GXXXX=. + JMS I QOUTSYM + JMS I QCRLF + CLA CMA /SET VAR TO NONE LEFT + DCA NUMELM +FIXDAT, TAD QXRBUFR /USE XR BUFFER FOR DATA BUFFER + DCA DATPTR + CMA + DCA RCOUNT /SET REPETITION COUNT TO 1 + JMP I QNEXT +DREPTC, JMS I QINWORD /GET REPETITION COUNT + CIA + DCA RCOUNT + JMP I QNEXT +DATELM, JMS I QINWORD /GET SIZE OF ELEMENT + CIA + DCA TEMP + JMS I QINWORD /GET ELEMENT + DCA I DATPTR + ISZ DATPTR /INTO DATA BUFFER + ISZ TEMP + JMP .-4 + JMP I QNEXT +ENDELM, TAD QXRBUFR /SETUP POINTER + DCA TEMP +MORELM, ISZ NUMELM /ANY MORE FOR THIS VAR? + JMP SAMVAR /YES + TAD DSTACK /CHECK FOR MISMATCH + CIA + TAD X16 + SNA CLA + JMP DLERR /OOOPS + ISZ DSTACK /GET TO NEXT VAR + JMS I QOPCDE /%ORG VAR + ORG + TAD I DSTACK /GET VAR + DCA TEMP2 + TAD TEMP2 + ISZ DSTACK /MOVE TO THE DISPLACEMENT + CDF 10 /OUTPUT VAR + JMS I QOUTNAM + CMA + DCA NUMELM /ASSUME UNDIMENSIONED + CDF 10 + ISZ TEMP2 /MOVE TO TYPE WORD + TAD I TEMP2 /GET TYPE + JMS I QSKPIRL /SKIP ON I R L + CLL CMA RTL /YES + TAD (-3 + DCA ELMSIZ /NUMBER OF WORDS PER ELEMENT + CLL CML RTR + AND I TEMP2 + CDF + SNA CLA + JMP GOTSIZ /NOT DIMENSIONED + CLA IAC /IF DISP = 7777 , WHOLE ARRAY + TAD I DSTACK /LOOK AT DISPLACEMENT + SZA CLA + JMP GOTSIZ+1 /ONLY ONE ELEMENT OF THE ARRAY + CMA + TAD TEMP2 /GET TOTAL SIZE + JMS I QGETSS + IAC + DCA TEMP2 + TAD I TEMP2 + CIA /THIS IS THE NUMBER OF ELEMENTS + DCA NUMELM + CDF +GOTSIZ, DCA I DSTACK /ZERO DISPLACEMENT + TAD PLUS /OUTPUT +XXXX + JMS I QOCHAR + TAD ELMSIZ /MULTIPLY DISP BY 3 OR 6 + CIA + DCA MQ + TAD I DSTACK /GET DISP + JMS I QMUL12 + JMS I QNUMBRO /OUTPUT THE ORG ALTERATION + JMS I QCRLF + ISZ DSTACK /MOVE TO NEXT ENTRY +SAMVAR, TAD ELMSIZ /GET SET TO PICK UP AN ELEMENT + DCA NARGS + JMS I QOTAB + JMP .+3 /SKIP ; FIRST TIME +ELMLUP, TAD (273 /SEMICOLON + JMS I QOCHAR + TAD I TEMP /GET A WORD FROM THE BUFFER + ISZ TEMP + JMS I QONUMBR + ISZ NARGS /ONE DATA LIST ELEMENT MUST FILL + JMP ELMLUP /ONE VARIABLE LIST ELEMENT + JMS I QCRLF /I.E. ONE ARRAY ELEMENT + TAD DATPTR /IS THIS DATA ELEMENT EXHAUSTED? + CIA CLL + TAD TEMP + SNL CLA + JMP MORELM /MORE LEFT + ISZ RCOUNT /REPEAT ? + JMP ENDELM /YES + JMP FIXDAT /NO, BACK FOR MORE DATA +DLERR, JMS I QTTYMSG /DATA LIST ERROR + 0414 + ELMSIZ=ARG1 + NUMELM=TYPE1 + DSTACK=BASE1 + DATPTR=ARG2 + RCOUNT=TYPE2 + PAGE + / END STATEMENT PROCESSING + +END, TAD FUNCTN /WHAT WAS IT ? + SZA CLA + JMP .+3 /SUBR, RETURN + TAD (STPCOD-1 /MAIN PROG, CALL EXIT + DCA .+2 + JMS I QGENCOD + RTNCOD-1 + TAD DOTEMP /ANY DO TEMPS ? + TAD M7000 + SPA SNA + JMP .+3 /NO + JMS OTMPS /OUTPUT THEM +XDOTMP, DOTMPN + CLA + TAD TMPMAX /ANY EXTRA TEMPS ? + TAD (-TMPBLK + SPA SNA + JMP .+4 + IAC /OUTPUT THEM + 1 + JMS OTMPS + TEMPN2 + CLA + TAD ELCNT /ANY EXTERNAL LITERALS? + SNA + JMP END2 /NO + CIA + DCA ELCNT + TAD EXTLIT /PICK UP THE POINTER + DCA X17 +ELLOOP, CDF 10 + TAD I X17 /GET SYMBOL NAME + DCA TEMP + TAD I X17 /AND DO TEMP NUMBER + CDF + TAD (-7000 /MINUS BASE + DCA TEMP2 + JMS I QOPCDE /ORIGIN + ORG + TAD XDOTMP /OUTPUT #DOTMP + JMS I QOUTSYM + TAD PLUS /+ + JMS I QOCHAR + TAD TEMP2 /DISP + CLL CML RAL /*2+1 + TAD TEMP2 /*3+1 + JMS I QONUMBR + JMS I QCRLF + JMS I QOPCDE /NOW OUTPUT JSR NAME + JSR + TAD TEMP + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + ISZ ELCNT + JMP ELLOOP +END2, TAD (232 /^Z + JMS I QOCHAR + JMS I (OUDUMP /DUMP BUFFER + CIF 10 + JMS I (7700 /GET USR + 10 + CIF 10 + CLA IAC + JMS I Q200 /CLOSE OUTPUT FILE + 4 + F1LNAM +FILSIZ, 0 + JMP OUERR /BADDDDIE + TAD FILSIZ /FIX INPUT LIST + CLL RTL + RTL + JMP FINAL +ERMSG, 0 /PRINT ERROR MESSAGE ON THE TTY + DCA TEMP /SAVE THE CODE + TAD QM4 /BACK UP THE ERROR + TAD ERRPTR /POINTER + DCA X10 + CDF 10 + DCA I X10 /ZERO END OF LIST + TAD TEMP /NOW STICK IN THE CODE + DCA I X10 + TAD X10 /SAVE THE NEW POINTER + DCA ERRPTR + TAD LINENO /NOW THE LINE NUMBER + DCA I X10 + CDF + TAD TEMP /PRINT ERROR CODE + JMS I QTTYP2C + JMS I QTTYP2C /NOW SOME SPACES + TAD QTTYOUT /FUDGE THE OUTPUT + /ROUTINE POINTER + DCA QOCHAR /SO THAT ONUMBR GOES TO + /THE TTY + TAD LINENO /PRINT THE LINE NUMBER + JMS I QONUMBR + TAD (OCHAR /FIXUP OUTPUT POINTER + DCA QOCHAR + JMS I QTTCRLF + JMS I QGENCOD /TRAP IF ERROR EXECUTED + ERCODE-1 + JMP I ERMSG +M7000, +OTMPS, -7000 /OUTPUT TEMP BLOCK + DCA TEMP /SAVE SIZE + TAD I OTMPS + ISZ OTMPS + JMS I QOUTSYM /OUTPUT NAME + TAD COMMA + JMS I QOCHAR + JMS I QOPCDE /ORG + ORG + TAD Q256 /. + JMS I QOCHAR + TAD PLUS + JMS I QOCHAR + TAD TEMP + CLL RAL + TAD TEMP /SIZE TIMES THREE + JMS I QONUMBR + JMS I QCRLF + JMP I OTMPS + PAGE + / CHAIN TO RALF +/ PASS2O VERSION 4A PT 16-MAY-77 +/CHANGES FOR OS/8 V3D AND OS/78 BY P.T. +/FIXED THE Q OPTION +/PATCH LEVEL IS IN LOCATION 26131 + IFZERO OVERLY < /ANOTHER SCORE FOR PAL8 + *OVRLAY + NOPUNCH> + IFNZRO OVERLY < /TO TAKE THE LEAD + FIELD 2 + ENPUNCH + *OVRLAY> /LATE IN THE FINAL QUARTER +GORALF, TAD FILDEV /GET SIZE AND DEVICE WORD + DCA I (7617 /PUT IT AWAY + ISZ (7617 /BUMP POINTER + TAD FILBLK /GET ORIGIN OF FIE + DCA I (7617 /STORE IT + ISZ (7617 + DCA I (7617 /ZERO END OF LIST + TAD I RALFSV + CDF 0 + SPA CLA /WAS /A SPECIFIED? + JMP I (7605 /YES - GET OUT + CLA IAC +CHNLKP, CIF 10 + JMS I Q200 + 2 /LOOKUP RALF.SV + RALFNM +RALFSV, 7643 + JMP I (7605 + TAD (6 /** + DCA CHNLKP+2 + JMP CHNLKP +RALFNM, 2201;1406;0000;2326 /RALF.SV +PASS3N, 2001;2323;6300;2326 /PASS3.SV + +ADD, JMS I QCODE /GENERATE CODE FOR ADD + ADDTBL-6;0 + JMP I QNEXT + / EXP OPERATOR +ETYPE, 0 +EXP, JMS I QSAVACT /SAVE AC IF ITS SECOND ARG + JMS I QGARGS /GET THE TWO ARGS + JMP I (OTERR /TYPE/OPERATOR ERROR + TAD TYPE1 /GET PLACE IN TABLE + CLL RTL + TAD TYPE1 /TYPE1 TIMES TEN + TAD TYPE2 /** + CLL RAL + TAD (EXPTBL-15 /POINTER TO ENTRY MINUS ONE + DCA X10 + CDF 10 + TAD I X10 /GET RESULTING TYPE + SNA + JMP I (OTERR /BAD IF THIS WORD IS ZERO + DCA ETYPE /SAVE THE TYPE + TAD I X10 /GET THE SUBR NAME + CDF + DCA I (ESUBR+2 /PUT IT INTO ITS PLACE + TAD TYPE1 /GET INTO CORRECT MODE + JMS SETMOD + TAD ARG1 /IS ARG 1 ALREADY IN THE AC + SNA CLA + JMP .+5 /YES, SKIP THE LOAD + JMS I QOPCOD /OTHERWISE LOAD IT + FLDA + JMS I QOADDR + ARG1 + JMS I QOINS /FSTA #BASE + FSTA;XBASE + TAD TYPE2 /SET MODE FOR ARG 2 + JMS SETMOD + JMS I QOPCOD /NOW LOAD IT + FLDA + JMS I QOADDR + ARG2 + JMS I QOINS /EXTERN FOR THE SUBR + EXTERN;ESUBR + JMS I QOINS /JSA TO THE SUBR + JSA;ESUBR + DCA I X16 /RESULT IS THE AC + TAD ETYPE /WITH THIS AS THE TYPE + DCA I X16 + DCA I X16 + TAD ETYPE /SET FMODE CORRECTLY + JMS I QSKPIRL + SKP + CLA IAC /RETURNED IN F MODE + DCA FMODE + JMP I QNEXT +SETMOD, /SET MODE TO CORRESPOND + /TO THE ARG +VOVER, VERSON /VERSION NUMBER FOR OVERLAY + JMS I QSKPIRL /SKIP IF WE WANT F MODE + JMP .+3 /SET TO E MODE + JMS I QGENSF /SET TO F MODE + JMP I SETMOD + JMS I QGENSE + JMP I SETMOD +FINAL, CIA + IAC + DCA FILDEV /SAVE RALF INPUT SPEC + CMA + DCA I X7746 /DON'T SAVE CORE ARROUND CHAIN + JMS I (DFRTTM /DELETE FORTRN.TM + CDF 10 + TAD I Q7605 /IS THERE A LISTING FILE? + SNA CLA + JMP GORALF /NO, JUST CHAIN TO RALF + CIF 10 + CDF + CLA IAC + JMS I Q200 /FIND PASS 3 + 2 + PASS3N +PAS3SV, 0 + JMP I Q7605 + TAD PAS3SV-1 /MOVE BLOCK TO CHAIN COMMAND + IAC /SKIP OVER CORE CONTROL BLOCK + DCA X7746 + JMS I DEVH /READ IN PASS 3 + NPPAS3 +SPASS3, 400 +X7746, 7746 + JMP I Q7605 + JMP I SPASS3 /GO DO PASS 3 + PAGE + / I/O OPEN AND CLOSE + +STRTIO, 0 /ROUTINE FOR STARTING IO STMT + ISZ IOSTMT /SET IOSTMT SWITCH + /(INCASE OF IMPLIED LOOPS) + JMS I QSAVEAC /SAVE AC + JMS I QSAVACT /IF NECESSARY + TAD I STRTIO /GET NUMBER OF ARGS + DCA NARGS /SAVE IT + ISZ STRTIO /MOVE TOHE NME + TAD NARGS /BACKUP STACK BY THIS MUCH + TAD NARGS /THREE OR SIX + TAD NARGS + TAD X16 + DCA X15 + TAD X15 + DCA TEMP /FUNCTION NAME GOES HERE + JMS I QOPCDE /EXTERN FOR SUBR + EXTERN + TAD I STRTIO /GET SUBROUTINE NAME + JMS I QOUTSYM /OUTPUT IT + JMS I QCRLF + TAD I STRTIO /PUT NAME + DCA I TEMP /ONTO STACK + JMS I QGENSF /ALL CALLS IN F MODE + JMS I QGENCAL /GENERATE THE CALL + NOP + JMP I QNEXT /NOTHING FOR R CLOSE +FMTRD1, IAC /START FORMATTED READ + DCA INPUT /SET INPUT = 1 + DCA BINARY /AND BINARY = 0 + JMS STRTIO /GO MAKE THE CALL + -2;XREADO +FMTWR1, DCA INPUT /SET SWITCHES + DCA BINARY + JMS STRTIO + -2;XWRITO +BINRD1, CLA IAC + DCA BINARY + CLA IAC + DCA INPUT + JMS STRTIO + -1;XRUO +BINWR1, DCA INPUT + CLA IAC + DCA BINARY + JMS STRTIO + -1;XWUO +WCLOSE, CLA STL RTL /TRAP3 HERE TOO** + JMS OJSR /OUTPUT TRAP3 #WUC + XWUC + DCA IOSTMT /KILL IO SWITCH + JMP I QNEXT +OJSR, 0 /OUTPUT EXTERN THEN JSR OR TRAP3 + CLL RAL /AC ON ENTRY IS 0 (JSR), 1 (JSA) OR 2 (TRAP3). + TAD (JSR + DCA OJSROP + JMS I QOPCDE /FIRST EXTERN + EXTERN + TAD I OJSR + JMS I QOUTSYM + JMS I QCRLF + JMS I QOPCDE /THEN JSR +OJSROP, 0 + TAD I OJSR + ISZ OJSR + JMS I QOUTSYM + JMS I QCRLF + JMP I OJSR + +XWUC, TEXT '#RENDO' /** +XREADO, TEXT '#READO' +XWRITO, TEXT '#WRITO' +XRUO, TEXT '#RUO' +XWUO, TEXT '#WUO' +RDRTNE, TEXT /#RSVO/ +RDDRTN, TEXT /#RFDV/ +FTRNTM, 0617;2224;2216;2415 /FORTRN.TM + DNA, JMS I QCODE /AND CODE + ANDTBL-6;0 + JMP I QNEXT +PURGE, JMS I QGARG /LOOK AT THE TOP OF STACK + JMP I (IOTYPE /BAD TYPE + TAD ARG1 /IT MUST BE A SCALAR REFNCE + CLL + TAD QM63 + SNL CLA + JMP I (IOTYPE /BAD TYPE + JMP I QNEXT +PAUZE, JMS I QUCODE /GET ARG INTO FAC + AIFTBL-1 + JMS I QGENCOD /OUTPUT JSR + PAZCOD-1 + JMP I QNEXT + PAGE + /DIRECT ACCESS I/O + +DARD1, CLA IAC /SET SWITCHES + DCA INPUT + CLA IAC + DCA BINARY /SAME AS UNFORMATTED + JMS I (STRTIO /GENERATE CALL + -2;XRDAO +DAWR1, DCA INPUT /SAME AS UNFORMATTED WRITE OPEN + CLA IAC + DCA BINARY + JMS I (STRTIO /CALL + -2;XWDAO +DEFFIL, TAD XDFARG /FAKE A CALL + DCA I (STRTIO /TO SKIP THE ISZ IOSTMT + JMP I (STRTIO+2 +XDFARG, .+1 + -4;XDEF +XDEF, TEXT '#DEF' +XRDAO, TEXT '#RDAO' +XWDAO, TEXT '#WDAO' + / RANDOM UNFITTING STUFF +RETURN, JMS I QGENCOD /JA #RTN + RTNCOD-1 + JMP I QNEXT +GENSTF, 0 /GENERATE STARTF IF IN E MODE + TAD FMODE /LOOK AT THE SWITCH + SZA CLA + JMP I GENSTF /ALREADY THERE + ISZ FMODE /SET SWITCH + JMS I QOPCOD /OUTPUT STARTF + STARTF + JMS I QCRLF + JMP I GENSTF /RETURN +NOT, JMS I QUCODE /.NOT. + NOTTBL-1 + JMP I (RELGM1 +SUB, JMS I QCODE /SUBTRACT + SUBTBL-6;0 + JMP I QNEXT +MUL, JMS I QCODE /MULTIPLY + MULTBL-6;0 + JMP I QNEXT +ASFDEF, CLA IAC /SET SWITCH FOR ASF PROLOG + DCA ASFSWT + JMP I QNEXT +OINS, 0 /OUTPUT TAB OPCODE TAB + /ADDRESS CRLF + DCA WHATAC /ZAPS AC + JMS I QOTAB + TAD I OINS /GET OPCODE + ISZ OINS + JMS I QOUTSYM + JMS I QOTAB + TAD I OINS /GET ADDRESS + SZA + JMS I QOUTSYM + JMS I QCRLF /END LINE + ISZ OINS + JMP I OINS + / CODE GENERATOR FOR STORE +STORE, JMS I QGARGS /GET ARGS FOR STORE + JMP I (OTERR + TAD ARG1 /KILL ANY XR + /EXPRS. INVOLVING + JMS I QCHKXR /THE VARIABLE BEING STORED + TAD ARG2 /IS SECOND ARG IN AC ? + SNA CLA + TAD Q5 /YES, ADD 5 TO TYPE2 + TAD TYPE2 + DCA TYPE2 + TAD TYPE1 /TYPE1 TIMES TEN + CLL RTL + TAD TYPE1 + CLL RAL + TAD TYPE2 /PLUS TYPE2 + TAD (STRTBL-13 /PLUS TABLE BASE + DCA SSKEL /GIVES ENTRY ADDRESS + CDF 10 + TAD I SSKEL /POINTER TO SKELETON + DCA SSKEL + JMS I QGENCOD /GENERATE CODE +SSKEL, 0 + TAD ASFSWT /IS THIS END OF ASF ? + SZA CLA + JMP I QNEXT /YES, DON'T DO A STORE + TAD TYPE1 /MODE IS THE SAME + JMS I QSKPIRL /AS THE VARIABLE STORED IN + SKP + CLA IAC + DCA FMODE + JMS I QOPCOD /OUTPUT STORE + FSTA + JMS I QOADDR /ADDRESS FIELD + ARG1 + TAD ARG1 /REMEMBER THE AC + CIA + DCA WHATAC /(REMEMBER THE + TAD BASE1 /ALAMO ?) + CIA /(WOULD YOU + DCA WHATBS /BELIEVE THE MAINE ???) + ISZ ARG1 /GO TO TYPE WORD + CDF 10 + CLL /IF ARG1 IS + TAD ARG1 /A SS'D REFNCE + TAD QM63 /DON'T + SZL CLA /BOTHER CHECKING + TAD I ARG1 /LOOK AT SOME BITS + CDF + AND (3400 /DIM,EXT, OR ASF ? + SNA CLA + JMP I QNEXT + JMS I QTTYMSG /ATTEMPT TO STORE IN + 1720 /EXTERNAL OR ASF +FLDAP, TEXT 'FLDA%' + PAGE + /ARITHEMTIC STATEMENT FUNCTIONS (BLAH!) + +DEFASF, CDF /A.S.F. PROLOG + TAD FMODE /SAVE CPU MODE + DCA ASFMOD /SINCE WE JUMP ARROUND + TAD X14 /SET STACK POINTER + TAD (3 /SO THAT ASF NAME STAYS + DCA X16 + CLA CMA /SET ASF SWITCH + DCA ASFSWT + TAD TMPMAX /USE UNIQUE TEMPS + IAC + DCA TMPCNT /FOR ALL ASF'S + JMS I QXRTBL /AND FORGET XR'S + JMS I QOPCDE /JA AROUND + JA + TAD GLABEL /SAVE ARROUND LABEL + DCA ASFSKP + ISZ GLABEL /BUMP LABEL GENERATOR + TAD ASFSKP /PUT LABEL AS ADDRESS OF JA + JMS I QOLABEL + JMS I QCRLF + TAD GLABEL /FUNCTIONS XR'S O HERE + JMS I QLABEL /OUPTUT THE LABEL + JMS I QOINS /#GXXXX, ORG .+10 + ORG;DP8 + TAD BASE1 /NOW OUTPUT FUNCTION NAME + CDF 10 + JMS I QOUTNAM + TAD COMMA /AS TAG + JMS I QOCHAR /OF START OF FUNCTION + JMS I QOPCDE /SETX + XSET + TAD GLABEL /TO THE GENERATED LABEL + ISZ GLABEL + JMS I QOLABEL + JMS I QCRLF + JMS I QOINS /LDX 0,1 + LDX;ZEROC1 + JMS I QGENCOD /STARTD + SD-1 /JUST LIKE A SUBROUTINE + /ISN'T IT ? + JMS I QOINS /FLDA #BASE + FLDA;XBASE /GET RETURN JUMP + JMS I QOPCDE /STORE IT AHEAD + FSTA + TAD GLABEL /USING GENERATED LABEL + JMS I QOLABEL + JMS I QCRLF +ASFARG, JMS I QOINS /FLDA% #BASE,1+ + FLDAP;XBAC1P /GET ARG POINTER + JMS I QOINS /FSTA #BASE+3 + FSTA;XBASP3 /SAVE IT + TAD I X15 /GET PARAMETER + DCA ARG2 + TAD I X15 + DCA TYPE2 + ISZ X15 + TAD TYPE2 /IS IT SINGLE OR DOUBLE? + JMS I QSKPIRL + JMP ASFASE /DOUBLE + JMS I QGENCOD /STARTF + SF-1 + CLA IAC +ARGSV, DCA FMODE /SET FMODE APPROPRIATELY + JMS I QOINS /FLDA% #BASE+3 + FLDAP;XBASP3 /GET THE VALUE + JMS I QOPCOD + FSTA /AND SAVE IT + JMS I QOADDR + ARG2 + ISZ NARGS /ANY MORE ARGS ? + SKP + JMP I QNEXT /NO, END OF ASF PROLOG + JMS I QGENCOD /STARTD + SD-1 + JMP ASFARG /NEXT ARG +ASFASE, JMS I QGENCOD /STARTE + SE-1 + JMP ARGSV +ASFEND, 0 /HANDLE END OF A.S.F. + TAD ASFSWT /IS THIS END OF ASF ? + SNA CLA + JMP PTCH /V3C NO + DCA ASFSWT /CLEAR SWITCH + JMS I QOINS /RESET XR'S + XSET;ZXR + TAD GLABEL /OUTPUT SPACE FOR RETURN ADDR + ISZ GLABEL + JMS I QLABEL /OUPTUT THE LABEL + JMS I QOINS /ORG .+2 + ORG;DOTP2 + TAD ASFSKP /OUTPUT SKIP ARROUND LABEL + JMS I QLABEL /OUPTUT THE LABEL + JMS I QCRLF + TAD ASFMOD /RESET MODE SWITCH + DCA FMODE + TAD TMPMAX /UNIQUE TEMPS + IAC + DCA TEM /V3C MUST BE USED + JMS I QXRTBL /AND XR'S LOST +PTCH, TAD TEM /V3C + DCA TMPCNT /V3C + JMP I ASFEND /RETURN +ASFMOD, 0 +ASFSKP, 0 +IOFUN, JMS I QOPCDE /CALLED BY TRAP3,NOT JSR** + TRAP3 + TAD I TEMP + JMS I QOUTSYM /OUTPUT THE IO FUNCTION NAME + JMP I (IOONLY /DO SOME OTHER STUFF +ESUBR, TEXT '#EXPXX' /THIS WILL BE THE CORRECT NAME + PAGE + / I/O LIST ELEMENT + +IOLMNT, JMS I QGARG /GET THE ARG + JMP IOTYPE /TYPE ERROR + DCA IOLOOP /CLEAR LOOP SWITCH + CLL STA RTL /-3 + TAD TYPE1 + DCA TYPE1 /TYPE1 = 0 IF COMPLEX, 1 IF D.P. + TAD ARG1 /ADDR OF TYPE WD + CLL IAC + DCA ARG2 + TAD ARG1 /LOOK AT ARG + TAD QM63 + SNL CLA + JMP NOLOOP /NOT ARRAY OUTPUT + CDF 10 + CLL CML RTR /IS IT DIMENSIONED ? + AND I ARG2 + CDF + SNA CLA + JMP NOLOOP /NO, NO LOOP + ISZ IOLOOP /SET SWITCH + TAD ARG1 /GET TO SS + JMS I QGETSS + IAC /TOTAL SIZE WORD + DCA BASE1 + TAD I ARG2 /IS THIS ARRAY AN ARG ? + AND Q20 + DCA ARGIO /SET SWITCH + TAD I BASE1 /IS IT VARIABLY DIMENSIONED ? + SNA + JMP I (VDAIO /YES, MUST COMPUTE SIZE + DCA BASE2 /SAVE SIZE + CDF + JMS I QOPCDE /PUT SIZE IN XR 1 + LDX + TAD Q255 + JMS I QOCHAR /- + TAD BASE2 + JMS I QONUMBR + TAD COMMA + JMS I QOCHAR + TAD (261 + JMS I QOCHAR + JMS I QCRLF + TAD ARGIO /IS IT AN ARG ? + SZA CLA + JMP I (ARGIOA /YES +OLLABL, TAD GLABEL /OUTPUT LABEL + JMS I QOLABEL + DCA I (XRBUFR+20 /KILL XR1 ENTRY + TAD COMMA + JMS I QOCHAR +NOLOOP, TAD INPUT /INPUT OR OUTPUT ? + SNA CLA + JMP OUTV /OUTPUT + JMS FIXCAL /SET PTR FOR OJSR** + JMS I (DUMSUB /NOW THE STORE + FSTA + TAD ARG1 /KILL ASSOCIATED + JMS I QCHKXR /XR EXPRESSIONS +CDSFLP, TAD TYPE1 /IS IT C OR D ? + CLL RAR + SZA CLA + JMP ENDLUP /NO, NO STARTE + JMS I QGENCOD + SF-1 +ENDLUP, TAD IOLOOP /IS THERE A LOOP ? + SNA CLA + JMP I QNEXT /NO, DO NEXT LIST ELEMENT + JMS I QOPCDE /YES, OUTPUT JXN + JXN + TAD GLABEL + ISZ GLABEL /OUTPUT LABEL + JMS I QLABEL /OUPTUT THE LABEL + TAD (261 + JMS I QOCHAR + TAD PLUS /OUTPUT PLUS (FOR + /INCREMENT DUMMY) + JMS I QOCHAR + JMS I QCRLF + JMP I QNEXT /DO NEXT LIST ELEMENT +OUTV, TAD TYPE1 /D OR C ? + CLL RAR + SZA CLA + JMP .+3 /NO, NO STARTF NECCESSARY + JMS I QGENCOD + SE-1 + JMS I (DUMSUB /OUTPUT FLDA + FLDA + JMS FIXCAL + JMP CDSFLP /THEN STARTF AND JXN IF ANY +FIXCAL, 6401 + TAD TYPE1 /IF VARIABLE IS COMPLEX, + CIA /OR IF VARIABLE IS DOUBLE AND + SZA /I/O IS BINARY, + TAD BINARY /GENERATE A JSR #RFDV + SNA CLA /ELSE GENERATE A TRAP3 #RSVO + JMP BINDIO + CLA STL RTL /SET PTR + JMS I (OJSR /NOW GO DO IT + RDRTNE /HERE'S THE NAME + JMP I FIXCAL +BINDIO, JMS I (OJSR + RDDRTN + JMP I FIXCAL + +IOTYPE, JMS I QTTYMSG /IO TYPE ERROR + 1124 +DEFLBL, JMS I QCRLF /CRLF BEFORE LABL + JMS I QGENSF /ENTER F MODE BEFORE ALL LABELS + JMS I QINWORD /GET THE LABEL + CDF 10 + JMS I QOSNUM /OUTPUT IT + TAD COMMA + JMS I QOCHAR + JMS I QXRTBL /KILL XR TABLE + DCA WHATAC /AND AC AT LABEL + JMP I QNEXT + PAGE + / I/O LIST ELEMENT + +VDAIO, CLL CMA RAL /GET ADDR OF NUMBER OF DIMS + TAD BASE1 + DCA X10 + TAD I X10 /GET DIM COUNT + CIA + DCA NARGS + ISZ X10 /SKIP SIZE + ISZ X10 /AND MAGIC NUMBER + ISZ X10 /AND LITERAL NUMBER + TAD (FLDA /LOAD FIRST DIM + SKP +GSIZLP, TAD (FMUL /MULTIPLY THE REST + DCA OPCIO + CDF 10 + TAD I X10 /GET THE NEXT DIMENSION + DCA TYPE2 + CDF + JMS I QOPCOD /OUTPUT OPCODE +OPCIO, 0 + JMS I QOADDR /NOW THE DIMENSION + TYPE2 + ISZ NARGS + JMP GSIZLP /KEEP GOING + JMS I QOPCOD /NEGATE THE FAC + FNEG + JMS I QCRLF + JMS I QGENCOD /PUT THE COUNT INTO XR1 + ATX1-1 +ARGIOA, JMS I QGENCOD /PUT -1 INTO XR 2 + LXM1C2-1 + JMS I QOPCDE /LOAD THE ARG POINTER - + FLDA /CONST + DCA I (XRBUFR+40 /KILL XR 2 ENTRY + TAD ARG1 + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + JMS I QOPCDE /NOW ADD THE MAGIC NUMBER + FADD + TAD QLITRL /OUTPUT #LIT+XXXX + JMS I QOUTSYM + CDF 10 + ISZ BASE1 + ISZ BASE1 + TAD I BASE1 + CDF + JMS I QONUMBR + JMS I QCRLF + JMS I QOPCDE + FSTA /NOW STORE IN #BASE+3 + TAD (XBASP3 + JMS I QOUTSYM + JMS I QCRLF + JMS I QGENCOD /STARTF + SF-1 + JMP I (OLLABL /NOW THE INSIDE OF THE LOOP +DUMSUB, 0 /OUTPUT FLDA OR FSTA + /WITH SE IF NEEDED + TAD I DUMSUB /GET THE OPCODE + DCA LDASTA + ISZ DUMSUB + TAD TYPE1 /MUST WE SE ? + CLL RAR /TYPE1 IS 0 IF C, 1 IF D + SNA CLA + TAD Q3 /MULTIPLIER IS 6 + TAD Q3 /OR 3 + DCA MQ + JMS I QOPCOD /FLDA OR FSTA +LDASTA, 0 + TAD IOLOOP /IS IT A LOOP ? + SNA CLA + JMP EZVAR /NO + TAD ARGIO /IS IT AN ARG ? + SZA CLA + JMP IBASP3 /YES, INDIRECT THROUGH #BASE+3 + JMS I QOTAB + TAD ARG1 + CDF 10 /OUTPUT NAME + JMS I QOUTNAM + TAD (255 /- + JMS I QOCHAR + TAD BASE2 /NEGATIVE OF SIZE + CIA + JMS I QMUL12 /TIMES 6 OR 3 + JMS I QNUMBRO + TAD COMMA /COMMA SEVEN + JMS I QOCHAR + TAD (261 + JMS I QOCHAR + JMS I QCRLF + JMP I DUMSUB /RETURN +EZVAR, JMS I QOADDR /ITS A SCALAR + ARG1 + JMP I DUMSUB +IBASP3, TAD (245 /INDIRECT THROUGH #BASE+3 + JMS I QOCHAR + JMS I QOTAB + TAD (XBPC2P /FLDA% #BASE+3,2+ + JMS I QOUTSYM + JMS I QCRLF + JMP I DUMSUB +XBPC2P, TEXT '#BASE+3,2+' +OR, JMS I QCODE + ORTABL-6;0 + JMP I (RELGEN +XOR, JMS I QCODE + EQVTBL-6;0 + JMP I (RELGEN +DOTP2, TEXT '.+2' +ZXR, TEXT '#XR' + PAGE + / ASSIGNED GOTO AND ASSIGN + +AGOTO, JMS GTSTUF /LOOK AT THE ASSIGNED VAR + JMS I QGENCOD /GENERATE A JAC + AGTCOD-1 + JMP I QNEXT +ASSIGN, JMS I QGARG /GET THE ASSIGN VAR + JMP GTTYPE + CLL CMA RTL /MUST BE I OR R + TAD TYPE1 + SMA CLA + JMP GTTYPE /GOTO TYPE ERROR + JMS I QGENCOD /GENERATE THE ASSIGN CODE + ASNCOD-1 + JMS I (JAGEN + JMS I QGENCOD /NOW STORE IT + ASTOR-1 + JMP I QNEXT + / OPTIMIZER SUBROUTINES +CHEKXR, 0 /KILL XR EXPRS + CIA /ASSOCIATED WITH THIS VAR + DCA KILVAR /SINCE IT HAS + /JUST BEEN CHANGED + TAD (-7 /LOOK AT XR 1 THRU 7 + DCA TEMP /COUNT + TAD (XRBUFR+20 /POINTER + DCA TEMP2 +KILLUP, TAD I TEMP2 /GET NEXT XR + /EXPR. INDICATOR + SNA CLA + JMP EOKL /NOTHING HERE + TAD TEMP2 /GET POINTER + DCA X13 /INTO AN XR + TAD I X13 /GET ADDR OF DIB + DCA DIMPTR /SAVE IT + CDF 10 /FIELD OF SYMBOL TABLE + TAD I DIMPTR /GET NUMBER OF + /DIMENSIONS + CMA /COMPLIMENTED + DCA NARGS /SAVE IT + CDF /BACK TO FIELD OF XRBUFR +CHKKIL, ISZ NARGS /CHECK 1 LESS + /THAN THE NUMBER + SKP /OF DIMENSIONS + JMP EOKL + TAD I X13 /LOOK AT NEXT + /ELEMENT OF EXPR + TAD KILVAR /IS IT THE VAR + /JUST CHANGED ? + SNA CLA + DCA I TEMP2 /YES, KILL THIS EXPRESSION + JMP CHKKIL /LOOP +EOKL, TAD TEMP2 /DO NEXT XR + TAD Q20 + DCA TEMP2 /BUMP POINTER BY 16 + ISZ TEMP + JMP KILLUP + JMP I CHEKXR /RETURN +KILVAR, +XRTABL, 0 /CLEAR OR RESET + /XR TABLE FLAGS + DCA TYPE /0=CLEAR 1=RESET + TAD (-7 /DO XR1 THRU 7 + DCA TEMP /COUNT + TAD (XRBUFR+20 /POINTER + DCA TEMP2 +XRTLUP, TAD I TEMP2 /GET INDICATOR + SNA CLA + JMP .+3 /DON'T CHANGE IF ZERO + TAD TYPE /OTHERWISE SET TO + DCA I TEMP2 /'USED BY + /PREVIOUS STMT' + TAD TEMP2 /GET TO NEXT ONE + TAD Q20 + DCA TEMP2 /BUMPING BY 16 + ISZ TEMP + JMP XRTLUP /LOOP + JMP I XRTABL /DONE +LOADA, 0 /GENERATE AN FLDA + TAD I LOADA /IF NECESSARY + DCA LODARG /GET ARG POINTER + ISZ LOADA /BUMP RETURN + TAD I LODARG /DOES AC MATCH ? + TAD WHATAC + SZA CLA + JMP DOLOAD /NO, MUST LOAD + TAD LODARG /GET ADDRESS + IAC /OF BASE + DCA ARG /IN CASE SS'D + TAD I ARG /DOES BASE MATCH? + TAD WHATBS + SNA CLA + JMP I LOADA /OK, DON'T LOAD +DOLOAD, JMS I QOPCOD /GENERATE FLDA + FLDA + JMS I QOADDR /ADDRESS +LODARG, 0 + JMP I LOADA + PAGE + / INTER PASS EQUATES + BLNKCN=21 + ALIST=23 + INTLST=60 + FPLIST=56 + DPLIST=57 + CMPLST=61 + HOLIST=55 + SNLIST=62 + ONEI=63 + THREE=70 + SIX=75 + TRUE=102 + / START PASS 2 (INTER PASS COMMUNICATION) + IFNZRO OVERLY < + FIELD 0 + NOPUNCH + *OVRLAY> + IFZERO OVERLY < + FIELD 0 + ENPUNCH + *OVRLAY> +START2, JMP I Q7605 /RETURN BUT DON'T SAVE CORE + TAD I X10 /PICK UP NEXT FROM PASS 1 + DCA X17 + TAD X17 /SAVE POINTER TO + /EXTERNAL LITERALS + DCA EXTLIT + TAD I X10 /PASS ONE STACK LEVEL + DCA X11 + TAD I X10 /TEMP FILE START + DCA INBLOK + TAD I X10 /AND SIZE + CMA + DCA INRCNT + TAD I X10 /START OF PASS2O.SV + DCA PASS2O + TAD I X10 /START OF OUTPUT FILE + DCA FILBLK /SAVE IT FOR CHAINING TO RALF + TAD FILBLK + DCA OBLOCK + TAD I X10 + DCA OSIZE /ALSO MAX SIZE + TAD I X10 /PICK UP PROG NAME + DCA PROGNM + TAD I X10 + DCA ARGLST /AND ARG LIST ADDR + TAD I X10 /AND + /FUNCTION/SUBROUTINE/MAIN SWITCH + DCA FUNCTN + TAD I X10 /GET DP HARDWARE SWITCH + DCA DPUSED + TAD I X10 /CHECK FOR CROSSED VERSIONS + TAD VERS + SZA CLA + JMP VERROR /VERSION ERROR + STA STL /V3C +DCLOOP, TAD X11 /V3C THIS ADD CLEARS THE LINK + DCA X11 /V3C + TAD X11 + TAD (-STACK1 + SNL CLA + JMP PSN /GO DO STMT NUMBERS + TAD I X11 /GET DO LOOP ENDING STMT NUMBER + IAC + DCA X10 + CDF 10 + TAD (0416 /DN DO END MISSING + JMS NPRNT /GO PRINT THE MESSAGE + /AND THE NUMBER + CDF + CLL CMA RTL + JMP DCLOOP /V3C BACK UP 2 +PSN, TAD (SNLIST /PROCESS STMT NUMBERS + CDF 10 +SNCLUP, DCA ENTRY /SAVE NEW ENTRY ADDR + TAD I ENTRY /GET ADDR OF NEXT ENTRY + SNA + JMP SNDONE /NO MORE STMT NUMBERS + IAC + DCA TEMP /ADDR OF TYPE WORD + TAD I TEMP /WAS STMT NUMBER DEFINED? + SPA CLA + JMP SNDEFN /YES + TAD TEMP + DCA X10 + TAD (2523 /PRINT US MESSAGE + JMS NPRNT +SNDEFN, TAD (0110 /SET TYPE WORD + DCA I TEMP + TAD I ENTRY /PROCEED + JMP SNCLUP +SNDONE, CDF +FIXELP, JMS I (TYPRTN + NEGSLV /FIX UP NEGATIVE EQUIVALENCE OFFSETS + CLL CML RTL /CHECK FOR BLOCK DATA + TAD FUNCTN /(FUNCTN=-2) + SNA CLA + JMP BDSTUF /IT IS + JMS I (TYPRTN /DO IMPLICIT TYPING + IMPLCT + JMS I (TYPRTN /REMOVE SUB ARGS FROM LIST + SUBARG + JMS I (TYPRTN /EXTERNALS + EXTRNL + JMP I (PROLG1 /MORE PROLOG +BDSTUF, TAD I (BDSWIT /SET UP SWITCH + DCA I (PROLG2 + TAD (END2 /ALTER END CODE + CDF 10 + DCA I (XEND + CDF 0 + DCA NODBUG /NO ISN'S + JMP I (HOLDUN /DO SOME STUFF +SUBARG, 0 /REMOVE ARGS FROM ST + TAD I TYPE + AND Q20 /CHECK ARG BIT + SNA CLA + JMP I SUBARG + JMS UNHOOK + JMP TFUDGE + +UNHOOK, 0 + TAD I ENTRY + DCA I OENTRY + TAD BUCKET + DCA I ENTRY + JMP I UNHOOK + +VERROR, TAD (2605 /PRINT VE (VERSION ERROR) + JMS I QTTYP2C + JMS I QTTCRLF + JMP I Q7605 + PAGE + / GENERATE ARGUMENT STORAGE + +PROLG1, JMS I (INS2 / %JA #ST + JA;XST + JMS I (INS /#XR, %ORG .+10 + XXR;ORG;DP8 + JMS I QOPCDE / %TEXT #NAMEXX# + TEXTX + TAD PLUS + JMS I QOCHAR + CDF 10 + TAD PROGNM + JMS I QOUTNAM + JMS I (FILL /FILL WITH BLANKS + TAD PLUS + JMS I QOCHAR + ISZ PROGNM + JMS I QCRLF + JMS I (INS /#RET, %SETX #XR + XRET;SETX;XXR + JMS I (INS2 / %SETB #BASE + SETB;XBASE + JMS I (INS2 / %JA .+3 + JA +XDP3, DP3 + JMS I (INS /#BASE, %ORG .+6 + XBASE;ORG;DP6 + TAD ARGLST /ANY ARGS ? + SNA + JMP NOARGS /NO, SKIP THIS STUFF + DCA X10 /SAVE POINTER TO ARG LIST + CDF 10 /HOW MANY ? + TAD I ARGLST + CIA + DCA NARGS /THIS MANY + DCA TEMP2 /ARRAY ARG COUNTER +ARGLP1, JMS PLSUB1 /OUTPUT DEFS FOR ARRAY + /ARGS FIRST + SNA CLA /SINCE THEY MUST BE + /INDIRECTABLY + JMP NOARAY /REFERENCABLE + ISZ TEMP2 +NOARAY, ISZ NARGS + JMP ARGLP1 /PROCESS ENTIRE ARG LIST + CDF 10 + TAD I ARGLST /GO THRU ARGS AGAIN + CIA CLL + DCA NARGS + TAD ARGLST + DCA X10 + TAD TEMP2 /HOW MANY ARRAY ARGS ? + TAD QM6 + SNA + JMP NISA /NO INDIRECT LOCS LEFT + /FOR SCALARS + DCA TEMP2 + SZL CLA + JMP TOOMNY /TOO MANY ARRAY ARGS (>6) +ARGLP2, JMS PLSUB1 /NOW OUTPUT AS MANY INDIRECT + SZA CLA /SCALAR ARGS AS POSSIBLE + JMP NOSCLR /TO REDUCE THE PROLOG + ISZ TEMP2 /ROOM FOR ANY MORE + SKP + JMP NISA2 /NO, THE REST MUST MOVE VALUES +NOSCLR, ISZ NARGS /LOOP SOME MORE + JMP ARGLP2 + JMS I (PLSUB2 /OUTPUT SOME TRACEBACK STUFF + JMP I (MORE /GENERATE SCALAR, + /LITERAL AND TEMP STORAGE +NISA2, JMS I (PLSUB2 + JMP NDLP3 /OUTPUT TRACEBACK + /STUFF,THEN REST +NISA, JMS I (PLSUB2 /GET PAST THE TRACEBACK STUFF +ARGLP3, TAD XM3 /GENERATE ORG .+6 FOR D OR C + DCA XNOP + JMS PLSUB1 /OUTPUT REMAINING + /SCALAR ARG SPACE + SZA CLA + JMP NDLP3 + CDF 10 + TAD I TEMP /TURN OFF SUBARG BIT + AND (7757 /(THATS THE + /SECOND TIME I FIXED THIS) + + DCA I TEMP +NDLP3, ISZ NARGS + JMP ARGLP3 + CDF + JMP I (MORE /GENERATE SCALAR, + /LITERAL AND TEMP STORAGE + +NOARGS, JMS I (PLSUB2 /NO ARGS, OUTPUT TRACEBACK STUFF + JMP I (MORE /GENERATE SCALAR, + /LITERAL AND TEMP STORAGE +PLSUB1, 0 + CDF + TAD I PLSUB1 /GET THE SKIP + DCA PLSKIP + ISZ PLSUB1 + CDF 10 + TAD I X10 /GET THE NEXT ARG + IAC + DCA TEMP /TYP WORD ADDR + CLL CML RTR /2000=DIM BIT + AND I TEMP +PLSKIP, 0 /ARRAYS OR SCALARS ? + JMP I PLSUB1 + ISZ PLSUB1 + CLA CMA + TAD TEMP /DEFINE THIS VAR + JMS I QOUTNAM + TAD COMMA + JMS I QOCHAR + CDF 10 + TAD I TEMP /LOOK AT THE TYPE + CDF + JMS I QSKPIRL /SKIP IF NOT C OR D +XNOP, NOP /THIS IS CHANGED LATER (MAYBE) + TAD XDP3 /.+3 OR .+6 + DCA .+3 + JMS I (INS2 /ORG FOR THE VALUE + ORG;0 + JMP I PLSUB1 +TOOMNY, TAD P0F1 /TOO MANY ARRAY ARGS + JMP I P0F2 +XM3, CLL CML RTL + PAGE + / SCALARS, LITERALS & TEMPS + +HOLLIT, +MORE, JMS I (TYPRTN /OUTPUT SCALARS + SCALAR + TAD (TEMPS /OUTPUT FIRST FIVE TEMPS + JMS I (OUTVAR + TAD (LITRL2 + JMS I QOUTSYM + TAD COMMA /OUTPUT %LITRL, + JMS I QOCHAR + JMS I (DOLIST + INTLST +O141, 0141;-3 /OUTPUT INTEGER LITERALS + JMS I (DOLIST + FPLIST + 0142;-3 /OUTPUT FP LITERALS + JMS I (DOLIST + DPLIST + 0144;-6 /DOUBLE LITERALS + JMS I (DOLIST + CMPLST + 0143;-6 /COMPLEX LITERALS + JMS I (TYPRTN /OUTPUT DIMENSION FACTORS + DFLIT + JMS I (ADFLIT /OUTPUT ARG DIM FACTOR LITERALS + TAD (HOLIST /OUTPUT HOLLERITH LITERALS + DCA ENTRY +HOLLUP, CDF 10 + TAD I ENTRY + SNA + JMP HOLDUN + DCA ENTRY /SAVE NEW ENTYR + TAD ENTRY + DCA X10 + TAD O141 /SET TYPE INFO + DCA I X10 + TAD LITNUM + DCA I X10 /SAVE LIT DISP + CLL CMA RTL /SET UP COUNTER + DCA HOLLIT /BY THREES +HOLOOP, CDF 10 /OUTPUT LITERAL AS OCTALS + TAD I X10 + CDF + SNA + JMP HOFILL /FILL OUT REST + DCA ARG + TAD ARG + AND (77 /IS THIS LAST WORD? + SZA CLA + JMP .+4 /NO + TAD ARG /YES, STICK IN + TAD Q40 /BLANK + JMP HOFILL+1 /AND OUTPUT IT + TAD ARG /OUTPUT CHAR PAIR + JMS ONUM + ISZ HOLLIT + JMP HOLOOP + JMP HOLOOP-2 +HOFILL, TAD (4040 /FILL WITH BLANKS + JMS ONUM + ISZ HOLLIT + JMP HOFILL + JMP HOLLUP /DO NEXT HOLLERITH LITERAL +HOLDUN, CDF + JMS I (TYPRTN /DO ARRAYS + ARRAYS + JMS I (TYPRTN /REMOVE COMMON VARS FROM S.T. + COMVAR + JMS I QOTAB + TAD (XLBLE /#LBL=. + JMS I QOUTSYM + JMS I QCRLF + CDF 10 /LOOK AT THE BLANK COMMON LIST + TAD I (ONEI+2 /MAKE TRUE=INTEGER ONE + DCA I (TRUE+2 + TAD I (BLNKCN+1 + CDF + SNA + JMP NOBC /NO BLANK COMMON + DCA TYPE /POINTER TO VARIABLE LIST + JMS I QOPCOD + COMMON + JMS I QCRLF + CDF 10 +BCLOOP, TAD TYPE /PROCESS THIS HUNK OF + /BLANK COMMON + DCA X10 + TAD I X10 + SNA + JMP NXTBC /EMPTY HUNK + CIA /SIZE OF HUNK + DCA TEMP + TAD I X10 /OUTPUT HUNK + JMS I (OUTVAR + CDF 10 + ISZ TEMP + JMP .-4 +NXTBC, TAD I TYPE /ADDR OF NEXT HUNK + SNA + JMP NOBC /THAT WAS THE LAST HUNK + DCA TYPE + JMP BCLOOP /DO NEXT HUNK +NOBC, CDF + JMS I (TYPRTN /DO NAMED COMMONS + COMNAM + JMS I (TYPRTN /NOW EQUIVALENCES + EQUIVS + JMS INS2 + ORG;XLBL /%ORG #LBL + JMP I (PROLG2 /COMPLETE PROLOG + PAGE + / ARGUMENT PICKUP GENERATOR + +PROLG2, TAD FUNCTN /SECOND PART OF PROLOG + SZA CLA + JMP DORETN /NOT A MAIN PROG + JMS I (INS /#ST, BASE #BASE + XST;BASE;XBASE + JMS I (INS2 / SETB #BASE + SETB;XBASE + JMS I (INS2 / SETX #XR + SETX;XXR +BDSWIT, JMP I (FINIST /GO GET OVERLAY +DORETN, JMS I (INS /#RTN, BASE #BASE + XRTN;BASE;XBASE + TAD ARGLST /ANY ARGS ? + SNA + JMP JAGOBK /NO + DCA X10 /POINTER TO THE LIST + CDF 10 + TAD I ARGLST /NUMBER OF ARGS + CIA + DCA NARGS + DCA TEMP2 /ZERO ARG COUNTER + CDF + TAD NARGS /WILL WE RESTORE ANY ? + TAD (6 + SMA CLA + JMP JAGOBK /NO + JMS I (INS2 / FLDA #ARGS + FLDA;XARGS + JMS I (INS2 / FSTA #BASE + FSTA;XBASE +RSLOOP, CDF 10 + TAD I X10 /GET NEXT ARG + IAC + DCA TEMP /ADDR OF TYPE WORD + ISZ TEMP2 /INCR COUNT + TAD I TEMP /IS IT A VALUE TRANSMISSION ? + AND Q20 + CDF + SZA CLA + JMP NOREST /NO, DON'T RESTORE IT + JMS I QOPCDE / %LDX XXXX,1 + LDX + TAD TEMP2 + JMS I QONUMBR + TAD (C1 + JMS I QOUTSYM + JMS I QCRLF + JMS I QGENCOD /STARTD + SD-1 + JMS I (INS2 /GET POINTER TO ARG + FLDAI;XBASC1 + JMS I (INS2 /AND SAVE IN #BASE+3 + FSTA;XBASP3 + JMS STFORE /INTO CORRECT MODE + JMS I QOPCDE /FLDA VAR + FLDA + CMA + TAD TEMP + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + JMS I (INS2 / FSTA% #BASE+3 + FSTAI;XBASP3 +NOREST, ISZ NARGS + JMP RSLOOP + JMS I QGENCOD /MAKE SURE WE'RE IN F MODE +QSFM1, SF-1 +JAGOBK, TAD FUNCTN /WHAT WAS THIS ? + SPA CLA + JMP NOFVAL /NOT A FUNCTION + CDF 10 /GET TYPE + TAD I PROGNM + AND Q17 + TAD (FVAL-1 /PLUS TABLE ADDRESS + DCA GVSKEL /GIVES POINTER TO + /SKELETON ADDRESS + TAD I GVSKEL /GET SKELETON ADDRESS + DCA GVSKEL + JMS I QGENCOD /PICK UP FUNCTION VALUE +GVSKEL, 0 +NOFVAL, JMS I (INS2 / JA #GOBAK + JA;XGOBAK + JMS I (INS /#ST, %STARTD + XST;STARTD;0 + JMS I QOTAB + TAD (210 / %FLDA' 10 + JMS I QONUMBR + JMS I QCRLF + JMS I (INS2 / %FSTA #GOBAK,0 + FSTA;XGOBC0 + JMP I (MORPLG + +STFORE, 0 /START F OR E + CDF 10 + TAD I TEMP /GET TYPE + CDF + JMS I QSKPIRL /SKIP ON I R OR L + TAD (SE-SF /SE + TAD QSFM1 /SF + DCA .+2 + JMS I QGENCOD + 0 + JMP I STFORE /DON'T FORGET TO + /RETURN DUMMY +XARGS, TEXT '#ARGS' + PAGE + / ENTRY AND EXIT CODE + +MORPLG, JMS I QOTAB + TAD Q200 / FLDA' 0 + JMS I QONUMBR + JMS I QCRLF + JMS I (INS2 / %SETX #XR + SETX;XXR + JMS I (INS2 / %SETB #BASE + SETB;XBASE + TAD ARGLST /ANY ARGS ? + SNA + JMP I (ENDPLG /NO, JUST STARTF + DCA ARG /SAVE POINTER TO THEM + JMS I (INS2 / %LDX 0,1 + LDX;ZC1 + JMS I (INS2 / %FSTA #BASE + FSTA;XBASE + JMS I (INS2 / %FSTA #ARGS + FSTA;XARGS + CDF 10 + TAD I ARGLST /NUMBER OF ARGS + CIA + DCA NARGS +GALOOP, CDF + JMS I (INS2 / %FLDA I #BASE,1+ + FLDAI;XBAC1P + DCA TYPE /CLEAR THE SD SWITCH + CDF 10 + ISZ ARG /GET TO NEXT ARG + TAD I ARG /LOOK AT ITS TYPE WORD + IAC + DCA TEMP + CLL CML RTR + AND I TEMP /WAS IT DIMENSIONED ? + SNA CLA + JMP I (TSTABT /NO, SEE IF ITS VALUE + CMA + TAD TEMP /GET ADDR OF DIM INFO + JMS I QGETSS + IAC /ADDR OF SIZE + DCA TEMP2 + TAD I TEMP2 + ISZ TEMP2 + ISZ TEMP2 + SNA CLA + JMP OUFSTA+1 /IT HAS A VARIABLE DIMENSION + TAD I TEMP2 /GET MAGIC NUMBER LIT DISP + DCA TEMP2 + CDF + JMS I QOPCDE / %FSUB #LIT+XXXX + FSUB + TAD QLITRL + JMS I QOUTSYM + TAD TEMP2 + JMS I QONUMBR + JMS I QCRLF + CDF 10 +OUFSTA, DCA I ARG /IT ISN'T VARIABLY DIMENSIONED + CDF + JMS I QOPCDE / %FSTA ARGN + FSTA + CDF 10 + CMA + TAD TEMP + JMS I QOUTNAM + JMS I QCRLF + ISZ NARGS + SKP + JMP I (ENDPLG /END OF PROLOG + TAD TYPE /DID WE LEAVE D MODE + SNA CLA + JMP GALOOP /NO + JMS I QGENCOD /YES, OUTPUT AN %SD + SD-1 + JMP GALOOP +FINIST, CDF 10 + TAD FUNCTN /WAS THIS A FUNCTION ? + SPA SNA CLA + JMP .+4 /NO, SKIP THIS + TAD I PROGNM /YES, TURN OFF EXT BIT + AND (6777 /ALLOWING STORING IN FUN NAME + DCA I PROGNM + TAD (2200 /CHECK /N /Q + AND I (7644 + CDF + SNA CLA +NODBUG, DCA I (DEBUG /IF NOT SET, PUT ISN'S + CDF 10 /INTO CODE + TAD I (7644 /IS /Q SET ? + CDF + AND (0200 + SZA CLA + ISZ I (OPTMYZ /MAKE A CLA IAC FROM A CLA +GFNAME, CDF 10 + TAD I FNAME /MOVE FILE NAME + CDF + DCA I NAMEF /INTO PAGE + ISZ FNAME + ISZ NAMEF + ISZ NFCNT + JMP GFNAME + JMP I (RDOVLY /GO WHERE ? + /CALIFORNIA OF COURSE!!!! +FNAME, 7601 +NAMEF, F1LNAM +NFCNT, -4 + +ONUM, 0 + ISZ LITNUM /BUMP LITERAL COUNTER + DCA ARG + JMS I QOTAB + TAD ARG + JMS I QONUMBR + JMS I QCRLF + JMP I ONUM + PAGE + / ENTRY AND EXIT CODE + +TSTABT, TAD I TEMP /VALUE TRANSMISSION ? + AND Q20 + SZA CLA + JMP I (OUFSTA /NO + CDF + JMS I (INS2 / %FSTA #BASE+3 + FSTA;XBASP3 + JMS I (STFORE /ENTER CORRECT MODE + JMS I (INS2 / %FLDA% #BASE+3 + FLDAI;XBASP3 + ISZ TYPE /SET SWITCH + JMP I (OUFSTA-1 +ENDPLG, JMS I QGENCOD /%SF + SF-1 + TAD ARGLST /ANY VARIABLY + /DIMENSIONED ARRAYS ? + SNA + JMP I (FINIST /NO ARGS AT ALL + DCA X10 + CDF 10 + TAD I ARGLST /NUMBER OF ARGS + CIA + DCA NSARGS +VDIMLP, CDF 10 + TAD I X10 /GET NEXT ARG + SNA + JMP NDVDIM /NOT A VARIABLY + /DIMENSIONED ARRAY + DCA VDTEMP + TAD VDTEMP /GET ADDR OF DIMENSION INFO + JMS I QGETSS + DCA VDTMP2 + TAD I VDTMP2 /NUMBER OF DIMENSIONS + CIA + DCA NARGS + ISZ VDTMP2 /MOVE TO MAGIC NUMBER LITERAL + ISZ VDTMP2 + ISZ VDTMP2 + TAD I VDTMP2 /GET IT + CDF + DCA MNL /SAVE MAGIC NUMBER LITERAL + TAD (FLDA /JUST LOAD FIRST DIM + DCA MNOPC + TAD NARGS /GET ADDRESS + CIA /OF THE LAST + TAD VDTMP2 /DIMENSION + DCA VDTMP2 /FOR THE SIZE GETTER + JMP CMPMN3 /SKIP MULTIPLY FIRST TIME +CMPMN1, TAD (FMUL /NEXT TIME USE A MULTIPLY + DCA MNOPC + JMS I QOPCOD /NEXT SUBSCRIPT (ALWAYS (1.0) + FADD + JMS I QOADDR /NOW ADDRESS + (ONEI +CMPMN3, ISZ NARGS /ANY MORE SS ? + JMP CMPMN2 /YES + ISZ VDTEMP /GET TO TYPE + CDF 10 + TAD I VDTEMP + CDF + JMS I QSKPIRL /SKIP ON I R L + TAD Q6M3 /YES + TAD (THREE + JMS LDAMUL /3.02 + JMS I (INS2 /ALN 0 + ALN;D0 + JMS I QOPCDE + FSTA + TAD QLITRL /SAVE IN THE MAGIC + /NUMBER LITERAL + JMS I QOUTSYM + CLA CMA + TAD MNL + JMS I QONUMBR + JMS I QCRLF + JMS I (INS2 /FNEG + FNEG;0 + JMS I (INS2 /ENTER D MODE + STARTD;0 + JMS I QOPCDE + FADDM /NOW MODIFY THE POINTER + CMA + TAD VDTEMP + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + JMS I (INS2 /RETURN TO F MODE + STARTF;0 +NDVDIM, ISZ NSARGS /ANY MORE ARGS TO CHECK? + JMP VDIMLP /YES + CDF + JMP I (FINIST +CMPMN2, CLA CMA /BACK UP THE POINTER + TAD VDTMP2 /BY ONE + DCA VDTMP2 + CDF 10 + TAD I VDTMP2 /GET IT + CDF + JMS LDAMUL /3.02 + JMP CMPMN1 /LOOP +VDTEMP, 0 +VDTMP2, 0 +NSARGS, 0 +MNL, 0 +DP12, TEXT '.+14' +LDAMUL, 0 /3.02 + DCA MNADR + JMS I QOPCOD +MNOPC, 0 + JMS I QOADDR + MNADR + JMP I LDAMUL +MNADR, 0 + PAGE +/ RANDOM PROLOG STUFF + +ARRAYS, 0 /OUTPUT ARRAYS + TAD I TYPE + AND (6220 /IS IT AN ARRAY + SNA + JMP I ARRAYS + AND (4220 /NOT COMMON, EQUIV OR ARG + SZA CLA + JMP I ARRAYS + JMS I (UNHOOK /REMOVE FROM BUCKET + TAD ENTRY /OUTPUT VARIABLE + JMS I (OUTVAR + JMP TFUDGE-1 +FILL, 0 /FILL SUB NAME WITH BLANKS + CLL CML RTL + TAD PROGNM /PROGNM+2 + CIA /-PROGNM-2 + TAD I XNAMP /1,2,3 + TAD QM4 /-3,-2,-1 + DCA TEMP + JMP .+5 + TAD (240 /TWO BLANKS FOR EACH WORD + JMS I QOCHAR + TAD (240 + JMS I QOCHAR + ISZ TEMP /MORE ? + JMP .-5 /YES + JMP I FILL +XNAMP, NAMPTR +NPRNT, 0 + JMS I QTTYP2C + JMS I QTTYP2C + TAD I X10 /NOW NUMBER + JMS I QTTYP2C + TAD I X10 + JMS I QTTYP2C + TAD I X10 + JMS I QTTYP2C + JMS I QTTCRLF + JMP I NPRNT + /ROUTINE TO FIX UP NEGATIVE EQUIVALENCE OFFSETS + +NEGSLV, 0 + TAD I TYPE + AND Q200 + SNA CLA /IS VARIABLE A SLAVE? + JMP I NEGSLV /NO + TAD TYPE + DCA X10 + TAD I X10 /GET POINTER TO EQUIV BLOCK + DCA X10 + CLA IAC + TAD I X10 /GET POINTER TO MASTER + DCA OLDM /TYPE WORD + TAD I X10 /OFFSET FROM MASTER + CMA STL + TAD I X10 /SUBTRACT FROM SLAVE OFFSET + DCA SFUDGE /SAVE IN CASE WE NEED IT + TAD I OLDM /IF MASTER IS IN COMMON FORGET THE NEXT TEST: + SZL SPA CLA /IF MASTER OFFSET < SLAVE OFFSET THEN + JMP I NEGSLV /SLAVE WILL ORIGIN BEFORE MASTER - + TAD I TYPE /THEREFORE THE SLAVE MUST BECOME THE MASTER + AND (7577 /UNSLAVE THE SLAVE + DCA I TYPE + ISZ TYPE + TAD I TYPE + DCA TYPE1 /TYPE1 POINTS TO EQUIV BLOCK + CLA IAC + TAD TYPE1 + DCA X10 /USE AUTO-XR TO CLEAR OFFSETS + TAD ENTRY + DCA NEWM + TAD I OLDM /GET OLD MASTER'S TYPE WD + TAD Q200 + DCA I OLDM /MAKE IT A SLAVE + ISZ OLDM + TAD I TYPE1 /GET POINTER TO SLAVE DIMENSION BLOCK + DCA I TYPE /PUT IT IN SYMTAB AS BEFITTING A NEW MASTER + TAD I OLDM /GET OLD MASTERS DIM PTR + DCA I TYPE1 /PUT IT IN EQUIV BLOCK AS BEFITTING A NEW SLAVE + TAD TYPE1 /NOW ASSOCIATE THE EQUIV BLOCK + DCA I OLDM /WITH THE NEW SLAVE + DCA I X10 /AND MAKE BOTH OFFSETS 0 + DCA I X10 /("FIXSLV" WILL ADJUST IT - NOTE THE "MASTER" + CDF 0 /WD OF THE BLOCK STILL POINTS TO THE OLD MASTER) + JMS I (TYPRTN /** RECURSIVE CALL ** - ACTUALLY WE DON'T CARE + FIXSLV /SINCE WE AREN'T RETURNING ANYWAY + JMP I (FIXELP /TRY AGAIN FROM SCRATCH + /ROUTINE TO ADJUST ALL SLAVES OF THE OLD MASTER +/TO BE SLAVES OF THE NEW MASTER + +FIXSLV, 0 /THROUGHOUT + TAD I TYPE + AND Q200 + SNA CLA /IS IT A SLAVE? + JMP I FIXSLV /NO + ISZ TYPE + CLA IAC + TAD I TYPE + DCA TYPE /TYPE NOW POINTS TO THE EQUIV BLOCK + CLA IAC + TAD I TYPE /GET PTR TO THIS SLAVES MASTER (+1) + CMA + TAD OLDM /COMPARE MASTERS + SZA CLA + JMP I FIXSLV /NOT UNDER SAME MASTER - LEAVE + TAD NEWM + DCA I TYPE /"MEET THE NEW BOSS..... + ISZ TYPE / SAME AS THE OLD BOSS...." + TAD I TYPE / (THE WHO) + + TAD SFUDGE /ADD IN THE DIFFERENCE BETWEEN OLD AND NEW + IAC /MASTERS TO THE MASTER OFFSET + DCA I TYPE + JMP I FIXSLV /THE SLAVE IS NOW -- A SLAVE! + +OLDM, 0 +NEWM, 0 +SFUDGE, 0 + PAGE + / ENTRY AND EXIT CODE + +PLSUB2, 0 /DUMB SUBR FOR PROLOG + CDF + JMS INS2 / %ORG #BASE+30 + ORG;XBAP30 + JMS INS2 / %FNOP + FNOP;0 + JMS INS2 / %JA #RET + JA;XRET + JMS INS2 / FNOP + FNOP;0 + JMS INS /#GOBAK,ORG .+2 + XGOBAK;DBLZRO;0 /**TO INSURE IT'S 0 + TAD DPUSED /WAS DOUBLE PRECISSION USED ? + SNA CLA + JMP NDPUSD /NO, NO NEED FOR TEMP + JMS INS + XDPTMP;ORG;DP12 /#DPT, ORG .+12 + JMS INS2 + DPCHK;0 +NDPUSD, TAD FUNCTN /FUNCTION OR SUBR ? + SNA + JMP I PLSUB2 /ITS #MAIN, NO #VAL OR #ARGS + SPA CLA + JMP .+5 /ITS A SUBROUTINE, NO #VAL + JMS INS /#VAL, %ORG .+6 + XVAL;ORG;DP6 + JMS INS /#ARGS, %ORG .+3 + XARGS;ORG;DP3 + JMP I PLSUB2 +INS2, 0 / %OPCOD ADDR + TAD INS2 /COMMONIZE RETURNS + DCA INS + JMP INS3 +INS, 0 /TAG, %OPCOD ADDR + TAD I INS /GET TAG FIELD + ISZ INS + JMS I QOUTSYM /OUTPUT IT + TAD COMMA + JMS I QOCHAR +INS3, JMS I QOTAB + TAD I INS /GET OPCODE + ISZ INS + JMS I QOUTSYM + TAD I INS /GET ADDR + SNA CLA + JMP .+4 /NO ADDRESS + JMS I QOTAB + TAD I INS + JMS I QOUTSYM + ISZ INS + JMS I QCRLF + JMP I INS +SECT, TEXT 'SECT' +XRET, TEXT '#RET' +XXR, TEXT '#XR' +XGOBAK, TEXT '#GOBAK' +XST, TEXT '#ST' +XGOBC0, TEXT '#GOBAK,0' +XBAP30, TEXT '#BASE+30' +FNOP, TEXT 'FNOP' +SETX, TEXT 'SETX' +SETB, TEXT 'SETB' +TEXTX, TEXT 'TEXT' +XBASC1, TEXT '#BASE,1' +DP3, TEXT '.+3' +DP6, TEXT '.+6' +ZC1, TEXT '0,1' +FLDAI, TEXT 'FLDA%' +FSTAI, TEXT 'FSTA%' +XLBLE, TEXT '#LBL=.' +C1, TEXT ',1' +XLBL, TEXT '#LBL' /STACK-5 CAN'T BE 0 +DBLZRO, TEXT '0;0' + PAGE + / SYMBOL TABLE PROCESSING ROUTINES + +IMPLCT, 0 /DO IMPLICIT TYPING + TAD I TYPE + AND O100 /WAS IT EXPLICITLY TYPED + SZA CLA + JMP I IMPLCT /YES + TAD BUCKET /IS IT INTEGER ? + TAD M317 + CLL + TAD M006 + SNL CLA + ISZ I TYPE /TYPE IT REAL + ISZ I TYPE /TYP IT INTEGER + JMP I IMPLCT +O100, +DFLIT, 100 /GENERATE FACTORS FOR CALLS + CLL CML RTR /DIMENSIONED ? + AND I TYPE + SNA CLA + JMP I DFLIT /NO + TAD I TYPE + DCA TEMP /SET PROPER WDS/ENTRY FOR VMC + TAD ENTRY /GET ADDR OF MAGIC NUMBER + JMS I QGETSS + TAD (2 + DCA TYPE + TAD I ENTRY /SAVE LINK + DCA DFTEMP + TAD BUCKET /FIX NAME + DCA I ENTRY + TAD I TYPE /GET MAGIC NUMBER + DCA TEMP2 + ISZ TYPE + CDF + JMS I (ONUM /OUTPUT A ZERO WORD + JMS I QOPCDE + JA + TAD ENTRY /OUTPUT VAR MINUS CONST + JMS I (VMC + JMS I QCRLF /END LITERAL + CDF 10 + TAD LITNUM /SAVE NUMBER IN DIM INFO + DCA I TYPE + ISZ LITNUM /THEN BY 2 MORE + ISZ LITNUM + TAD DFTEMP /RESTORE ENTRY + DCA I ENTRY + JMP I DFLIT +M006, +DFTEMP, +EXTRNL, 6 /DO EXTERNALS + TAD I TYPE + AND O1000 /IS IT EXT ? + SNA CLA + JMP I EXTRNL + JMS I (UNHOOK /REMOVE THIS SYMBOL + TAD PROGNM /IS IT THE PROG NAME ? + CIA + TAD ENTRY + SZA CLA + JMP .+5 /NO, OUTPUT EXTERN + TAD FUNCTN /IS IT A MAIN PROG ? + SNA CLA + JMP TFUDGE-1 /YES, NO SECT + TAD (SECT-EXTERN /NOT MAIN, OUTPUT SECT + TAD XTRN + DCA M317 + CDF + JMS I QOPCDE +M317, -317 + TAD ENTRY /NOW VAR NAME + CDF 10 + JMS I QOUTNAM + JMS I QCRLF + JMP TFUDGE-1 +O1000, +EQUIVS, 1000 /OUTPUT EQUIVALENCES + TAD I TYPE + AND Q200 /IS THIS A SLAVE ? + SNA CLA + JMP I EQUIVS /NO + JMS I (UNHOOK /UNHOOK THE ENTRY + TAD I TYPE /SAVE THE TYPE WORD + DCA TYPE1 + ISZ TYPE /POINT TO EQUIVALENCE BLOCK + TAD I TYPE + DCA X10 + CDF + JMS I QOPCDE /OUTPUT ORG + ORG + CDF 10 + TAD I X10 /MASTER NAME + DCA X11 /SAVE IT + TAD X11 + JMS I QOUTNAM /OUTPUT IT + TAD PLUS /+ + JMS I QOCHAR + CDF 10 + TAD I X11 /MASTER SS + JMS SUBRX + TAD Q255 /MINUS + JMS I QOCHAR + CDF 10 + TAD TYPE1 /SLAVE SS + JMS SUBRX + JMS I QCRLF /EOL + CDF 10 + TAD ENTRY /NOW OUTPUT SLAVE + JMS I (OUTVAR + JMP TFUDGE-1 +XTRN, +SUBRX, EXTERN + JMS I QSKPIRL /SIZE OF THING + TAD Q3 + TAD Q3 /TIMES 3 OR 6 + DCA MQ + TAD I X10 + CDF + JMS I QMUL12 /MAKE THE PRODUCT + JMS I QNUMBRO /OUT WITH IT + JMP I SUBRX +DPCHK, TEXT 'DPCHK' +FADDM, TEXT 'FADDM' + PAGE + / SYMBOL TABLE PROCESSING ROUTINES + +BASE, TEXT 'BASE' +OUTVAR, 0 /ALLOCATE STORAGE FOR A VARIABLE + DCA VARADR + RDF /GET FIELD OF VAR + TAD X6201 + DCA OVFLD1 + TAD OVFLD1 + DCA OVFLD2 + TAD VARADR /OUTPUT NAME, + JMS I QOUTNAM + TAD COMMA + JMS I QOCHAR + JMS I QOPCDE /OUTPUT ORG + ORG + ISZ VARADR /POINT TO TYPE WROD +OVFLD1, 0 + TAD I VARADR /GET TYPE +X6201, CDF + JMS I QSKPIRL + TAD Q3 /PER ENTRY + TAD Q3 /INTEGER, REAL, AND + /LOGICAL 3WORDS + DCA MQ + DCA AC +OVFLD2, 0 + CLL CML RTR /CHECK DIM BIT + AND I VARADR + SNA CLA + JMP PLSDOT /NOT DIMENSIONED + TAD I VARADR /LOOK AT TYPE + ISZ VARADR /MOVE TO EQ DIM POINTER + AND Q200 /EQUIVALENCED ? + SNA CLA + JMP .+3 /NO + TAD I VARADR /YES, SKIP EQUIV INFO + DCA VARADR + TAD I VARADR /ADDRESS OF DIM INFO + IAC + DCA VARADR /ADDRESS OF SIZE + TAD I VARADR /GET TOTAL SIZE + CDF + JMS I QMUL12 +PLSDOT, CDF + TAD Q256 + JMS I QOCHAR + TAD PLUS + JMS I QOCHAR + JMS I QNUMBRO + JMS I QCRLF + JMP I OUTVAR +SCALAR, 0 /OUTPUT SCALARS + TAD I TYPE /IS IT A SCALAR ? + AND (7630 /COM, DIM, EXT, ASF, + /EQV, ARG, COMMONNAME + SZA CLA + JMP I SCALAR /NO + JMS I (UNHOOK /DELETE THIS FROM THE LIST + TAD ENTRY /OUTPUT THIS VARIABLE + JMS OUTVAR + JMP TFUDGE-1 +VARADR, +DOLIST, 0 /PROCESS A LITERAL LIST + TAD I DOLIST /GET LIST START + DCA ENTRY + ISZ DOLIST + TAD I DOLIST + DCA TYPE /GET TYPE BITS + ISZ DOLIST + TAD I DOLIST + ISZ DOLIST + DCA LSIZE /GET LITERAL SIZE + CDF 10 +DLLOOP, TAD I ENTRY /GET NEXT ENTRY + SNA + JMP DLRETN /NO MORE + DCA ENTRY + TAD ENTRY + DCA X10 /ADDRESS OF TYPE WORD + TAD TYPE /PUT IN TYPE + DCA I X10 + TAD X10 /SAVE THIS ADDR + DCA X11 + TAD LSIZE /SIZE OF LITERAL + DCA TEMP +LITLUP, CDF + JMS I QOTAB + CDF 10 + TAD I X10 + CDF + JMS I QONUMBR + JMS I QCRLF + ISZ TEMP + JMP LITLUP + CDF 10 + TAD LITNUM /SAVE LITERAL NUMBER + DCA I X11 + TAD LSIZE /INCREMENT LITERAL NUMBER + CIA + TAD LITNUM + DCA LITNUM + JMP DLLOOP +DLRETN, CDF + JMP I DOLIST +TEMPS, 243;2000;TMPSIZ;2415;2000 +TMPSIZ, 1;TMPBLK+1 +LSIZE, +COMVAR, 0 /REMOVE COMMON VARS FROM ST + TAD I TYPE + AND (4400 /ALSO ASF NAMES + SNA CLA + JMP I COMVAR + JMS I (UNHOOK + JMP TFUDGE-1 +LITRL2, TEXT '#LIT' +COMMON, TEXT 'COMMON' + PAGE + / SYMBOL TABLE PROCESSING ROUTINES + +TYPRTN, 0 /PROCESS ENTIRE SYMBOL TABLE + TAD I TYPRTN /GET ROUTINE ADDRESS + DCA ROUTNE + ISZ TYPRTN + TAD O301 /START WITH 'A' + DCA BUCKET + TAD M32 /BUCKET COUNT + DCA BCNT +TYPLP2, TAD BUCKET /GET START OF NEXT LIST + TAD ALM301 +TYPLUP, DCA OENTRY /SAVE OLD ENTRY ADDRESS + CDF 10 +TFUDGE, TAD I OENTRY /GET ADDR OF NEXT ENTRY + SNA + JMP EOL /0 MEANS END OF LIST + DCA ENTRY + IAC + TAD ENTRY /ADDR OF TYPE WORD + DCA TYPE + JMS I ROUTNE /CALL ROUTINE + TAD I OENTRY /CONTINUE DOWN THE LIST + JMP TYPLUP +EOL, ISZ BUCKET /DO NEXT LETTER + ISZ BCNT + JMP TYPLP2 + CDF + JMP I TYPRTN /END OF PASS + BCNT=ARG1 +COMNAM, 0 /OUTPUT A COMMON BLOCK + TAD I TYPE /IS THIS A COMMON BLOCK NAME + TAD M111 + SZA CLA + JMP I COMNAM /NO + CDF + JMS I QOPCDE + COMMON + CDF 10 + JMS I (UNHOOK /REMOVE THE COMMON + /BLOCK FROM S.T. + TAD ENTRY + JMS I QOUTNAM /OUTPUT NAME + JMS I QCRLF + ISZ TYPE /GET TO COMMON STUFF POINTER +CNLOOP, CDF 10 + TAD I TYPE /GET ADDR OF NEXT HUNK + /OF COMMON + SNA + JMP TFUDGE /END OF IT + DCA TYPE + TAD TYPE /GET A WORKING POINTER + DCA X10 + TAD I X10 /GET COUNT + SNA + JMP CNLOOP /NONE IN THIS HUNK + CIA + DCA TEMP2 + TAD I X10 /GET VARIABLE ADDRESS + JMS I (OUTVAR /OUTPUT IT + CDF 10 + ISZ TEMP2 + JMP .-4 /DO NEXT ONE FROM THIS HUNK + JMP CNLOOP /DO NEXT HUNK +O301, 301 +M32, -32 +ALM301, ALIST-301 +M111, -111 +ROUTNE, +ADFLIT, 0 /OUTPUT ARG DF LITS + TAD ARGLST /ANY ARGS + SNA + JMP I ADFLIT + DCA X10 + CDF 10 + TAD I ARGLST /NUMBER OF ARGS + CIA + DCA NARGS +ADFLUP, CDF 10 + TAD I X10 /GET ARG ADDR + IAC + DCA TEMP /TYPE WORD ADDR + TAD I TEMP /GET TYPE INFO + DCA TEMP2 + CLL CML RTR + AND I TEMP /DIMENSIONED ? + SNA CLA + JMP NDADFL /NO + ISZ TEMP /ADDR OF DIM INFO + CLL CML RTL + TAD I TEMP /ADDR OF MAGIC NUMBER + DCA TEMP + TAD I TEMP /MAGIC NUMBER + DCA MQ /PREPARE TO MULTIPLY + ISZ TEMP /ADDR OF LITERAL GOES HERE + TAD LITNUM /STICK IN THE ADDRESS + IAC + DCA I TEMP + CDF + JMS I (ONUM /OUTPUT A ZERO + TAD TEMP2 /LOOK AT TYPE + JMS I QSKPIRL /SKIP ON I R L + TAD (3 /DOUBLE OR COMPLEX + TAD (3 + JMS I QMUL12 + TAD AC /OUTPUT 2 WORD LITERAL + JMS I (ONUM + TAD MQ + JMS I (ONUM +NDADFL, ISZ NARGS + JMP ADFLUP + JMP I ADFLIT +RDOVLY, JMS I (7607 /READ IN OVERLAY + NPOVLY + OVRLAY +PASS2O, 0 + JMP I (INERR + TAD I (VOVER /CHECK VERSION OF OVERLAY + TAD VERS + SZA CLA + JMP I (VERROR /ERROR, MIXED VERSIONS + JMP I (EOSTMT /START PASS2 PROPER + PAGE + FIELD 1 + *5000 + 0 /THIS IS THE START OF + /THE ERROR MESSAGE LIST + /WHICH WORKS BACKWARDS + /OS/8 F4 COMPILER CODE SKELETONS + + MAC=-6 + NEGSGN=-5 + FLDAA2=-4 + FLDAA1=-3 + ENTERE=-2 + ENTERF=-1 +CGTCOD, ATX;DD1;STARTD;0;FLDA;DP2C1;STARTF;0 +AGTCOD, JAC;0;0 +ASNCOD, ENTERF;FLDA;DP3C0;JA;DP4;0 +ERCODE, EXTERN;XUE;TRAP3;XUE;0 +A0FN, EXTERN;XFIX;JSA;XFIX;0 +A0SD, ALN;D0 +SD, STARTD;0;0 +SE, STARTE;0;0 +SF, STARTF;0;0 +MPTR0, ENTERF;FLDAA1;FSTA;XBASE;0 +MPTR3, ENTERF;FLDAA2;FSTA;XBASP3;0 +JADP2, JA;DOT;0 +DOFIN0, ENTERF;FLDAA1;FADD;-2 +ASTOR, FSTA;-1;0 +DOFIN1, ENTERF;FLDAA1;FADD;-2;MAC+A0FN;FSTA;-1;0 +LDASTD, FLDAA1;STARTD;0;0 + /CHALK UP ONE FOR PAL8 +ATX1, ATX;DD1;0 +LXM1C2, LDX;M1C2;STARTD;0;0 +FVAL, FVI-1;FVI-1;FVC-1;FVD-1;FVI-1 +FVI, FLDA;XVAL;0 +FVC, STARTE;0;FLDA;XVAL;MAC+PCAC;0 +FVD, STARTE;0;FLDA;XVAL;0 +RTNCOD, RTNX+MAC;JA;XRTN;0 +PAZCOD, ENTERF;EXTERN;XPAUSE;JSR;XPAUSE;0 +STPCOD, RTNX+MAC;EXTERN;XEXIT;JSR;XEXIT;0 +GIRL1, ENTERF;FLDAA1;ENTERE;0 +GIRL2, ENTERF;FLDAA2;ENTERE;0 +SEGCAC, +GCAC, ENTERE;EXTERN;CAC;FLDA;CAC;0 +PCAC, EXTERN;CAC;FSTA;CAC;0 +GC1C2, ENTERE;FLDAA1;EXTERN;CAC;FSTA;CAC;FLDAA2;0 +GC1, ENTERE;FLDAA1;0 +GC2, ENTERE;FLDAA2;0 +JSACEQ, EXTERN;CEQ;JSA;CEQ;NEGSGN;0 +JSACNG, EXTERN;CNEG;JSA;CNEG;0 +JSACAD, EXTERN;CADD;JSA;CADD;0 +JSACSB, EXTERN;CSUB;JSA;CSUB;0 +JSACML, EXTERN;CMUL;JSA;CMUL;0 +JSACDV, EXTERN;CDIV;JSA;CDIV;0 + / ADD, SUBTRACT, MULTIPLY, AND DIVIDE SKELETONS +ADDTBL, AS-1;AS+2;AS+4 + AX-1;AX+2;AX+5 + AS-1;AD-1;AS+4 + ASC-1;ASC+2;ASC+3 + ASD-1;ASD+7;ASD+10 + ACS-1;ACS+4;ACS+6 + ADS-1;ADS+3;ADS+7 + 0 + FNEG;0 +AS, FADD;-1;0 + ENTERF;FLDAA1 + FADD;-2;0 + JSACNG+MAC +AX, GC1+MAC;JSACAD+MAC;0 + GC1C2+MAC;JSACAD+MAC;0 + GC2+MAC;JSACAD+MAC;0 +AD, ENTERE;FLDAA1;FADD;-2;0 + JSACNG+MAC +ASC, GIRL1+MAC;JSACAD+MAC;0 + GIRL1+MAC + ENTERE;PCAC+MAC;GC2+MAC;JSACAD+MAC;0 + FNEG;0 +ASD, FSTA;XDPTMP;ENTERF;FLDAA1;ENTERE;FADD;XDPTMP;0 + GIRL1+MAC + ENTERE;FADD;-2;0 + JSACNG+MAC +ACS, ENTERE;PCAC+MAC;GC1+MAC;JSACAD+MAC;0 + GC1+MAC;PCAC+MAC + GIRL2+MAC;JSACAD+MAC;0 + FNEG;0 +ADS, ENTERE;FADD;-1;0 + GIRL2+MAC;FADD;-1;0 + FSTA;XDPTMP;GIRL2+MAC;FADD;XDPTMP;0 +SUBTBL, AS-3;SS-1;SS+1 + AX-2;SX-1;SX+2 + AS-3;SDBL-1;SS+1 + ASC-2;SSX-1;SSX + ASD-3;SSD-1;SSD + ACS-2;SCS-1;SCS+1 + ADS-3;SDS-1;SDS5-1 + 0 +SS, ENTERF;FLDAA1 + FSUB;-2;0 +SX, GC1C2+MAC;JSACSB+MAC;0 + GC2+MAC;JSACSB+MAC;0 +SDBL, ENTERE;FLDAA1;FSUB;-2;0 +SSX, GIRL1+MAC + ENTERE;PCAC+MAC;GC2+MAC;JSACSB+MAC;0 +SSD, GIRL1+MAC + ENTERE;FSUB;-2;0 +SCS, GC1+MAC;PCAC+MAC + GIRL2+MAC;JSACSB+MAC;0 +SDS, GIRL2+MAC;FNEG;0;FADD;-1;0 +SDS5, FSTA;XDPTMP;GIRL2+MAC;FNEG;0;FADD;XDPTMP;0 +MULTBL, M1-1;M1+3-1;M1+5-1 + M4-1;M4+3-1;M4+6-1 + M1-1;M7-1;M7+2-1 + M8-1;M8+3-1;M8+4-1 + M11-1;M11+6-1;M11+7-1 + M14-1;M14+5-1;M14+7-1 + M18+1-1;M18-1;M18+5-1 + 0 +M1, FMUL;-1;0 + ENTERF;FLDAA1 + FMUL;-2;0 +M4, GC1+MAC;JSACML+MAC;0 + GC1C2+MAC;JSACML+MAC;0 + GC2+MAC;JSACML+MAC;0 +M7, ENTERE;FLDAA1;FMUL;-2;0 +M8, GIRL1+MAC;JSACML+MAC;0 + GIRL1+MAC + ENTERE;PCAC+MAC;GC2+MAC;JSACML+MAC;0 +M11, FSTA;XDPTMP;GIRL1+MAC;FMUL;XDPTMP;0 + GIRL1+MAC + ENTERE;FMUL;-2;0 +M14, ENTERE;PCAC+MAC;GC1+MAC;JSACML+MAC;0 + GC1+MAC;PCAC+MAC + GIRL2+MAC;JSACML+MAC;0 +M18, GIRL2+MAC + ENTERE;FMUL;-1;0 + FSTA;XDPTMP;GIRL2+MAC;FMUL;XDPTMP;0 +DIVTBL, 1;D2-1;D2+2-1 + 1;D5-1;D5+3-1 + 1;D7-1;D7+2-1 + 1;D9-1;D10-1 + 1;D12-1;D13-1 + 1;D14-1;D15-1 + 1;D16-1;D17-1 + 0 +D2, ENTERF;FLDAA1 + FDIV;-2;0 +D5, GC1C2+MAC;JSACDV+MAC;0 + GC2+MAC;JSACDV+MAC;0 +D7, ENTERE;FLDAA1;FDIV;-2;0 +D9, GIRL1+MAC +D10, ENTERE;PCAC+MAC;GC2+MAC;JSACDV+MAC;0 +D12, GIRL1+MAC +D13, ENTERE;FDIV;-2;0 +D14, GC1+MAC;PCAC+MAC +D15, GIRL2+MAC;JSACDV+MAC;0 +D16, GIRL2+MAC;FSTA;XDPTMP;FLDAA1;FDIV;XDPTMP;0 +D17, FSTA;XDPP6;GIRL2+MAC;FSTA;XDPTMP;FLDA;XDPP6;FDIV;XDPTMP;0 + / RELATIONALS AND LOGICALS SKELETON TABLES +EQTABL, EQ1-1;EQ2-1;EQ3-1 + EQ4-1;EQ5-1;EQ6-1 + EQ1-1;EQ7-1;EQ3-1 + EQ8-1;EQ9-1;EQ10-1 + EQ11-1;EQ12-1;EQ13-1 + EQ14-1;EQ15-1;EQ16-1 + EQ17-1;EQ18-1;EQ19-1 + EQ1-1;EQ2-1;EQ3-1 +EQ1, FSUB;-1;0 +EQ2, ENTERF;FLDAA1 +EQ3, FSUB;-2;0 +EQ4, GC1+MAC;JSACEQ+MAC;0 +EQ5, GC1C2+MAC;JSACEQ+MAC;0 +EQ6, GC2+MAC;JSACEQ+MAC;0 +EQ7, ENTERE;MAC+EQ2+1;0 +EQ8, GIRL1+MAC;JSACEQ+MAC;0 +EQ9, GIRL1+MAC +EQ10, ENTERE;PCAC+MAC;GC2+MAC;JSACEQ+MAC;0 +EQ11, MAC+ASD-2;0 +EQ12, GIRL1+MAC +EQ13, MAC+SSD+1;0 +EQ15, GIRL2+MAC +EQ14, ENTERE;PCAC+MAC;GC1+MAC;JSACEQ+MAC;0 +EQ16, GIRL2+MAC;JSACEQ+MAC;0 +EQ18, GIRL2+MAC +EQ17, MAC+ADS-2;0 +EQ19, MAC+SDS5;0 + LETABL, LE1-1;LE2-1;LE3-1 + 0;0;0 + LE1-1;LE4-1;LE3-1 + 0;0;0 + LE11-1;LE12-1;LE13-1 + 0;0;0 + LE17-1;LE18-1;LE19-1 + 0 +LE1, FSUB;-1;NEGSGN;0 +LE2, ENTERF;FLDAA1 +LE3, FSUB;-2;0 +LE4, ENTERE;MAC+LE2+1;0 +LE11, MAC+ASD-2;0 +LE12, GIRL1+MAC +LE13, MAC+SSD+1;0 +LE18, GIRL2+MAC +LE17, MAC+ADS-2;0 +LE19, MAC+SDS5;0 + ANDTBL, 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + M1-1;M1+3-1;M1+5-1 +ORTABL, 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + AS-1;AS+2;AS+4 + EQVTBL, 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + 0;0;0 + EQ1-1;EQ2-1;EQ3-1 + /CONVERSION-FOR-STORE-OPERATOR SKELETONS +STRTBL, SIIM-1;SIRM-1;SICM-1;SIDM-1;SIIM-1 + SIIA-1;SIRA-1;SICA-1;SIDA-1;SIIA-1 + SIIM-1;SIIM-1;SRCM-1;SRDM-1;SIIM-1 + SIIA-1;SIIA-1;SRCA-1;SRDA-1;SIIA-1 + SCIM-1;SCIM-1;SCCM-1;SCDM-1;SCIM-1 + SCIA-1;SCIA-1;SCCA-1;SCDA-1;SCIA-1 + SDIM-1;SDIM-1;SDCM-1;SDDM-1;SDIM-1 + SDIA-1;SDIA-1;SDCA-1;SDDA-1;SDIA-1 + SLIM-1;SLIM-1;SLCM-1;SLDM-1;SIIM-1 + SLIA-1;SLIA-1;SLCA-1;SLDA-1;SIIA-1 +SIIM, ENTERF;FLDAA2 +SIIA, 0 +SIRM, ENTERF;FLDAA2 +SIRA, A0FN+MAC;0 +SICM, GC2+MAC;PCAC+MAC +SICA, ENTERF;GCAC+1+MAC;A0FN+MAC;0 +SRCM, GC2+MAC;PCAC+MAC +SRCA, ENTERF;GCAC+1+MAC;0 + SCCM=GC2 +SCIM, ENTERF;FLDAA2 +SCIA, ENTERE;0 + SCCA=GCAC +SLIM, ENTERF;FLDAA2 +SLIA, JSA;LTRNE;0 +SLCM, GC2+MAC;ENTERF;SLIA+MAC;0 +SLCA, ENTERF;GCAC+1+MAC;SLIA+MAC;0 +SIDM, ENTERE;FLDAA2 +SIDA, ENTERF;SIRA+MAC;0 +SRDM, ENTERE;FLDAA2 +SRDA, ENTERF;0 +SCDM, ENTERE;FLDAA2 +SCDA, FSTA;TEMPN;ENTERF;FLDA;TEMPN;ENTERE;0 +SDIM, ENTERF;FLDAA2 +SDIA, ENTERE;0 +SDCM, ENTERE;FLDAA2;PCAC+MAC +SDCA, ENTERF;GCAC+1+MAC;ENTERE;0 +SDDM, ENTERE;FLDAA2 +SDDA, 0 +SLDM, ENTERE;FLDAA2 +SLDA, JSA;LTRNE;0 + / UNARY MINUS AND .NOT. SKELETONS +NEGTBL, NIM-1;NIM-1;NCM-1;NDM-1;0 + NIA-1;NIA-1;NCA-1;NIA-1;0 +NIM, ENTERF;FLDAA1 +NIA, FNEG;0;0 +NCM, GC1+MAC;PCAC+MAC;JSACNG+MAC;0 + NCA=JSACNG +NDM, ENTERE;NIM+1+MAC;0 +NOTTBL, 0;0;0;0;NOTM-1 + 0;0;0;0;NOTA-1 +NOTM, ENTERF;FLDAA1 +NOTA, 0 + / ARITHMETIC IF SKELETONS +AIFTBL, GI-1;GI-1;GC-1;GD-1;GI-1 /V3C + GI+1;GI+1;GC+1;GD+1;GI+1 /V3C +GI, ENTERF;FLDAA1;0 +GC, GC1+MAC;0 +GD, ENTERE;FLDAA1;0 + /OPERATOR DISPATCH TABLE + +XPUSH, PUSH + ADD + SUB + MUL + DIV + EXP + NOT + NEG + GE + GT + LE + LT + DNA + OR + EQ + NE + XOR + EQV + PAUZE + DPUSH + BINRD1 + FMTRD1 + WCLOSE /** + DARD1 + BINWR1 + FMTWR1 + WCLOSE + DAWR1 + DEFFIL + ASFDEF + ARGS + EOSTMT + ERROR + RETURN + REWIND + STORE +XEND, END + DEFLBL + DOFINI + ARTHIF +XLOGIF, LIFBGN + DOBEGN + ENDFIL + STOP + ASSIGN + BAKSPC + FORMAT +XGOTO, GOTO + CGOTO + AGOTO + IOLMNT + DATELM + DREPTC + DATAST + ENDELM + PURGE +XLAST, DOSTOR + / EXPONENTIATION TABLE (NOT A STANDARD SKELETON TABLE) +EXPTBL, 1;1111;2;1122;3;1103;4;1104;0;0 /I**D=D + 2;1111;2;1122;3;1103;4;1104;0;0 /R**D=D + 3;0311;3;0322;3;0303;0;0;0;0 + 4;0411;4;0422;0;0;4;0404;0;0 + 0;0;0;0;0;0;0;0;0 + / TYPE MIXING TABLE +TYPMIX, 1;6;2;6;3;17;4;22;0;0 + 2;6;2;6;3;17;4;22;0;0 + 3;25;3;25;3;11;0;0;0;0 + 4;30;4;30;0;0;4;14;0;0 + 0;0;0;0;0;0;0;0;5;33 +RTNX, ENTERF;EXTERN;LTRNE;0 + $ + diff --git a/sw/f4/FRTSRC/pass3.pa b/sw/f4/FRTSRC/pass3.pa new file mode 100644 index 0000000..62dac35 --- /dev/null +++ b/sw/f4/FRTSRC/pass3.pa @@ -0,0 +1,816 @@ +/3 OS/8 FORTRAN (PASS THREE) +/ +/ VERSION 4A PT 16-MAY-77 +/ +/ OS/8 FORTRAN IV COMPILER-PASS 3 +/ +/ BY: HANK MAURER +/ UPDATED BY: R. LARY + M. HURLEY +/ +/ +/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +VERSON=4 + / PAGE ZERO STUFF + OUDEVH=7000 /PUT OUDEVH AND OUBUF IN DIFFERENT + INDEVH=6400 + INBUF=6000 + OUBUF=5400 /SEGMENTS, STAN KNOWS WHY + X10=10 + X11=11 + X12=12 + NCHARS=20 + CHAR=21 + TEMP=22 + FILDEV=6 + FILBLK=7 + DEV1CE=173 /THROUGH 177 + DEVH=23 + LINENO=24 + SEVCHR=25 /THROUGH 33 + + +/ OS/8 V3C MAINTENANCE RELEASE FIXES: + +/1. EXTENDED RANGE OF PAGE NUMBERS TO 99 +/2 INTERCHANGED CR/LF FOR HASSINGER +/3 CHANGED VERSION NO. TO 305 +/5. ADDED 'I' TO JMP (OFOO3 +/ +/ +/ CHANGES FOR OS/8 V3D AND OS/78 BY P.T. +/ .CHANGED VERSION NUMBER TO 4A +/ .PUT IN NEW DATE ALGORITHM +/ +/ + /START OF PASS 3 + *400 /DON'T LOAD INTO 0-377 +SPASS3, CDF 10 + TAD I (7666 /GET DATE + DCA TEMP + TAD I LSTFIL /COPY FILE NAME + CDF + DCA I FILLST + ISZ LSTFIL + ISZ FILLST + ISZ OFSIZE + JMP SPASS3 + TAD DEV1CE /FETCH HANDLER FOR OUTPUT FILE + CIF 10 + JMS I (200 /USR IS IN CORE + 1 +OH, OUDEVH+1 /TWO PAGE HANDLER IS OK + JMP I (OFOO3 + CIF 10 + TAD DEV1CE /OPEN THE LISTING FILE + JMS I (200 + 3 +OB, DEV1CE+1 +OS, 0 + JMP I (OFOO3 + TAD OB /SAVE BLOCK NUMBER + DCA OBLOCK + TAD OS + DCA OSIZE /AND SIZE OF HOLE + TAD OH /SAVE HANDLER ADDRESS + DCA DEVH + TAD (NUMS-1 /SET UP NUMBER POINTER + DCA I (NUM + TAD TEMP /GET THE DATE--FOR YEAR ROUTINE + SNA + JMP I (PAJE /NO DATE + AND (7 /MASK OUT ALL BUT YEAR OFFSET BITS + DCA YRTEMP /INCREMENT FROM THE BASE YEAR + DCA TEMP1 /HOLDS THE FIRST DIGIT OF THE YEAR + TAD I (7777 /GET THE DATE EXTENSION BITS + AND (600 /MASK TO GET THE EXTENSION BITS + CLL RTR /ROTATE THEM INTO BIT + RTR /POSITIONS 7 AND 8 + TAD (106 /ADD IN 70---OLD BASE YEAR + TAD YRTEMP /ADD IN THE YEAR OFFSET BITS + /TO FIND THE NEW BASE YEAR +CONVYR, CLL /FIND THE YEAR IN DECIMAL + TAD (-12 /KEEP SUBTRACTING 12 + SNL /ALMOST DONE + JMP SECDIG /FIND THE SECOND DIGIT OF THE YEAR + ISZ TEMP1 /FIND THE FIRST DIGIT OF THE YEAR + JMP CONVYR /TRY AGAIN +SECDIG, TAD (72 /GET THE SECOND DIGIT OF THE YEAR + RTL /AND MAKE IT SIXBIT + RTL + RTL + DCA I (YEAR+1 /PUT IT IN THE PRINT LINE + TAD TEMP1 /GET THE FIRST DIGIT + TAD (5560 /MAKE IT SIXBIT + DCA I (YEAR /PRINT IT + TAD TEMP /GET THE DATE--NOW FIND THE MONTH/DAY + CLL RTR + RAR + AND (777 + DCA TEMP +SIMPLE, TAD TEMP /GET THE DAY + AND (37 + TAD (DAYS-1 /THIS IS THE LAZY WAY + DCA NCHARS + TAD I NCHARS + DCA I (DAY + TAD TEMP /GET THE MONTH + CLL RTR + RTR + AND (36 + TAD (MONTHS-3 + DCA X10 + TAD I X10 + DCA I (MONTH + TAD I X10 + DCA I (MONTH+1 + JMP I (PAJE /WE GOT THE DATE +LSTFIL, 7605 +FILLST, DEV1CE +OFSIZE, -5 +YRTEMP, 0 +TEMP1, 0 + PAGE +PAJE, JMP I (PRHDR /PRINT THE FIRST HEADING + CLL CML RTL /INITIALIZE LINE NUMBER + DCA LINENO + DCA TABCNT /** +RDLUPE, TAD (SEVCHR-1 /SEVEN CHAR BUFFER + DCA X10 + TAD (-6 + DCA NCHARS +RDLOOP, JMS I (ICHAR + JMP RDACHO /ECHO & IGNORE SHORT LINES + TAD (-211 /IS IT A TAB ? + SZA CLA + JMP NOTAB /NO + TAD (-2 + DCA TABCNT /SET POINTER TO DO EXTRA SPACES LATER** + TAD (240 + DCA I X10 /DO A TAB + ISZ NCHARS + JMP .-3 + JMP WHAT /GO LOOK AT THE LINE +NOTAB, TAD CHAR + DCA I X10 /SAVE THE CHAR + ISZ NCHARS + JMP RDLOOP +WHAT, TAD SEVCHR /IS IT A COMMNET + TAD (-303 + SNA CLA + JMP NOISN /YES, NO INTERNAL STMT NUMBER + TAD SEVCHR+5 /IS IT A CONTINUATION ? + TAD (-240 + SZA CLA + JMP NOISN /YES, NO ISN + TAD LINENO /NEITHER OF THESE + JMS I (ONUMBR /PRINT ISN + TAD LINENO /2.01/ PUT LINE NUM + 7421 /2.01/ INTO MQ + CLA /2.01/ CLA IF NO EAE + ISZ LINENO /BUMP LINE NUMBER +NOISN, TAD (211 /TAB + JMS I (OCHAR + TAD (SEVCHR-1 /PRINT FIRST SEVEN + DCA X10 + TAD (-6 + DCA NCHARS + TAD I X10 + JMS I (OCHAR + ISZ NCHARS + JMP .-3 + TAD TABCNT /SEE IF A TAB WAS 1ST + SMA CLA /IF YES,NEED 2 MORE SPACES + JMP NOTTAB + DCA TABCNT /WAS A TAB + TAD (240 + JMS I (OCHAR + TAD (240 + JMS I (OCHAR +NOTTAB, JMS I (ICHAR /PRINT REST OF LINE + JMP ENDLIN + JMS I (OCHAR + JMP .-3 +ENDLIN, JMS I (CRLF /END LINE + JMS I (ERRCHK /CHECK ERROR LIST + JMP RDLUPE /DO NEXT LINE +TABCNT, 0 + +HEADER, TEXT ' FORTRAN IV 4AAAA ' + *.-1 +DAY, 4040 +MONTH, 4040;4040 +YEAR, TEXT ' PAGE ' + *.-1 +PAGENO, TEXT 'ONE' + ZBLOCK 7 /V3C ROOM FOR LARGE PAGE NUMBERS +RDACHO, TAD (211 + JMS I (OCHAR + JMP I (RDECHO + PAGE + TEXT " " +LOS, TEXT "ONE " +NUMS,/ 2427;1740;4040 +/ 2410;2205;0540 +/ 0617;2522;4040 +/ 0611;2605;4040 +/ 2311;3040;4040 +/ 2305;2605;1640 +/ 0511;0710;2440 +/ 1611;1605;4040 +/ 2405;1640;4040 +/ 0514;0526;0516 +/ 2427;0514;2605 + TEXT "TWO@@@@@" + TEXT "THREE@@@" + TEXT "FOUR@@@@" + TEXT "FIVE@@@@" + TEXT "SIX@@@@@" + TEXT "SEVEN@@@" + TEXT "EIGHT@@@" + TEXT "NINE@@@@" + TEXT "TEN@@@@@" + TEXT "ELEVEN@@" + TEXT "TWELVE@@" + TEXT "THIRTEEN" + TEXT "FOURTEEN" + TEXT "FIFTEEN@" + TEXT "SIXTEEN@" + TEXT "SEVENTEEN" + TEXT "EIGHTEEN" + TEXT "NINETEEN" +HIS, TEXT " TWENTY " + *.-1 + TEXT " THIRTY " + *.-1 + TEXT " FORTY " + *.-1 + TEXT " FIFTY " + *.-1 + TEXT " SIXTY " + *.-1 + TEXT "SEVENTY " + *.-1 + TEXT " EIGHTY " + *.-1 + TEXT " NINETY " + *.-1 + TEXT "HUNDRED " + *.-1 +DAYS, 4061;4062;4063;4064;4065;4066;4067;4070;4071 + 6160;6161;6162;6163;6164;6165;6166;6167;6170;6171 + 6260;6261;6262;6263;6264;6265;6266;6267;6270;6271 + 6360;6361 +MONTHS, 5512;0116 /-JAN + 5506;0502 /-FEB + 5515;0122 /-MAR + 5501;2022 /-APR + 5515;0131 /-MAY + 5512;2516 /-JUN + 5512;2514 /-JUL + 5501;2507 /-AUG + 5523;0520 /-SEP + 5517;0324 /-OCT + 5516;1726 /-NOV + 5504;0503 /-DEC + IFZERO .&100 + ENDX, TAD (-601 /2.02/ CLEAR END OF BUFFER + DCA LINENO /2.01/ FOR TV: REASONS + TAD X232 /2.01/ OUTPUT ^Z + JMS I (OCHAR /2.01/ + ISZ LINENO /2.01/ + JMP .-3 /2.01/ + CIF 10 /CLOSE THE OUTPUT FILE + TAD DEV1CE + JMS I (200 + 4 + DEV1CE+1 +FILSIZ, 0 + JMP (OFOO3 + CDF 10 /LOOK AT OPTIONS + TAD I X7643 + CDF +M70, SPA CLA + JMP I (7605 //A MEANS DON'T CHAIN TO RALF + CIF CDF 10 + TAD FILDEV /SET UP RALF INPUT LIST + DCA I (7617 /FILE SIZE AND DEVICE CODE + ISZ (7617 + TAD FILBLK /FILE START + DCA I (7617 + ISZ (7617 /ZERO END OF LIST + DCA I (7617 + TAD I X7643 /IS IT /F (FULL LIST) ? + AND (100 + CIF 0 + SZA CLA /** + JMP LISTIT + CIF 10 + TAD I (7644 + AND (20 /LET /T SWITCH THRU ALSO + SNA CLA + DCA I (7605 /NO, INHIBIT RALF LISTING +LISTIT, CIF 10 + CLA IAC + CDF + JMS I (200 /LOOKUP RALF.SV + 2 + RALFNM +X7643, 7643 + JMP (OFOO3 + TAD .-3 + DCA .+4 + CIF 10 /CHAIN TO RALF + JMS I (200 + 6 +X232, 232 +NCNT, 0 +ONUMBR, 0 + DCA TEMP /OUTPUT ISN IN OCTAL + TAD (-4 + DCA NCNT +OLOOP, TAD TEMP + CLL RTL /ANYONE WHO CAN'T FOLLOW THIS + RAL /SHOULDN'T BE A PROGRAMMER + DCA TEMP + TAD TEMP + RAL + AND (7 + TAD (260 + JMS I (OCHAR + ISZ NCNT + JMP OLOOP + JMP I ONUMBR +CONVRT, 0 /CONVERT TO ASCII AND PRINT + AND (77 + SZA + TAD (-40 + SPA + TAD (100 + TAD (240 + JMS I (OCHAR + JMP I CONVRT +LINECT, -1 /EJECT FIRST TIME +CRLF, PAJE+1 + TAD (215 /CR LF + JMS I (OCHAR + TAD (212 + JMS I (OCHAR + ISZ LINECT + JMP I CRLF + TAD (214 + JMS I (OCHAR +PRHDR, TAD M70 /RESET COUNT + DCA LINECT + TAD (HEADER /COPY HEADER OUT + DCA TEMP +OHDR, TAD I TEMP + CLL RTR + CLL RTR + CLL RTR + JMS CONVRT + TAD I TEMP + JMS CONVRT + TAD I TEMP /END YET ? + ISZ TEMP + AND (77 + SZA CLA + JMP OHDR + TAD (215 /V3C SKIP EXTRA LINE AFTER TITLE + JMS I (OCHAR + TAD (212 /V3C + JMS I (OCHAR /FOR CENTRONICS + JMP PUTNUM /GET NEW PAGE NUMBER + / OS/8 FILE INPUT ROUTINES + PAGE +ICHAR, 0 /READ CHAR FROM INPUT FILE + ISZ INJMP /BUMP THREE WAY UNPACK SWITCH + ISZ INCHCT +INJMPP, JMP INJMP + TAD INEOF /DID LAST READ YEILD END OF FILE ? + SNA CLA + JMP INGBUF /NO, DO ANOTHER READ +GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE + JMP I (ENDX /NO FILE TO OPEN +INGBUF, TAD INCTR /BUMP RECORD COUNTER + CLL IAC + SNL + DCA INCTR /RESTORE IF IT HASN'T OVERFLOWED + SZL + ISZ INEOF /SET END OF FILE SWITCH + JMS I INHNDL /DO THE READ +INCALL, 200 +INBUFP, INBUF +INREC, 0 + JMP INERR /HANDLER ERROR +INBREC, ISZ INREC /BUMP RECORD NUMBER + TAD (-601 /SET CHAR COUNT + DCA INCHCT + TAD INJMPP /RESET THREE WAY JUMP SWITCH + DCA INJMP + TAD INBUFP /RESET BUFFER POINTER + DCA INPTR + JMP ICHAR+1 /GO AGAIN +INERR, ISZ INEOF /EITHER EOF OR BADDIE + SMA CLA + JMP INBREC /END OF FILE, DO NEXT FILE + JMP OFOO3 +INJMP, HLT /3 WAY CHARACTER UUPACK SWITCH + JMP ICHAR1 + JMP ICHAR2 +ICHAR3, TAD INJMPP /RESET JUMP SWITCH + DCA INJMP + TAD I INPTR + AND (7400 /COMBINE THE HIGH ORDER BITS + CLL RTR /OF THE TWO WORDS + RTR + TAD INTMP /TO FORM THE THIRD CHAR + RTR + RTR + ISZ INPTR /BUMP WORD POINTER + JMP ICHAR1+1 /DO SOME COMMON STUFF +ICHAR2, TAD I INPTR /SAVE THE HIGH ORDER BITS + AND (7400 + DCA INTMP /FOR THE THIRD CHAR + ISZ INPTR /GO TO THE SECOND WORD +ICHAR1, TAD I INPTR /GET THE LOW 8 BITS + AND (377 /AND I MEAN ONLY 8 !! + DCA CHAR + TAD CHAR + TAD (-232 /IS IT ^Z (END OF FILE) + SNA + JMP GETNEW /YES, LOOK FOR THE NEXT FILE + TAD (232-212 + SNA + JMP ICHAR+1 /IGNORE LINE FEEDS + TAD (212-215 + SNA + JMP I ICHAR /RETURN ON CARRIAGE RETURN + IAC + SNA CLA + JMP ICHAR+1 /IGNORE FORM FEEDS + TAD CHAR + ISZ ICHAR + JMP I ICHAR /RETURN TO THE CALLING WORLD +INTMP, 0 +INFPTR, 7617 /POINTER TO INPUT FILE LIST +INEOF, 1 +INCHCT, +INNEWF, -1 /FETCH HANDLER FOR NEXT FILE + TAD (INDEVH+1 /THIS IS WHERE IT GOES + DCA INHNDL + CDF 10 + TAD I INFPTR /GET NEXT INPUT FILE INFO + CDF + SNA + JMP I INNEWF /NO MORE FILES + CIF 10 + JMS I INCALL /CALL MONITOR + 1 /FETCH HANDLER +INHNDL, 0 /ENTRY ADDR GOES HERE + JMP OFOO3 + CDF 10 + TAD I INFPTR /GET LENGTH + AND (7760 + SZA /A ZERO HERE MEANS >=256 BLOCKS + TAD (17 /PUT IN SOME MORE BITS + CLL CML RTR + RTR + DCA INCTR /STORE LENGTH OF FILE + ISZ INFPTR + TAD I INFPTR /GET STARTING RECORD NUMBER + DCA INREC + ISZ INFPTR + DCA INEOF /CLEAR EOF FLAG + ISZ INNEWF + CDF + JMP I INNEWF +INCTR, 0 +INPTR, 0 +/PUTNUM, TAD (PAGENO-1 /COPY THE NEW NUMBER +/ DCA X10 +/ TAD I NUM +/ ISZ NUM +/ DCA I X10 +/ TAD I NUM +/ ISZ NUM +/ DCA I X10 +/ TAD I NUM +/ ISZ NUM +/ DCA I X10 +/ JMP CRLF+1 +RDECHO, /KEEP LINES WITH L.T. 6 CHARS OUT OF ISN COLUMN + TAD (SEVCHR-1 + DCA X12 +RDECLP, TAD X12 + CIA + TAD X10 + SNA CLA + JMP ENDLIN /ONLY ECHO WHAT YOU READ + TAD I X12 + JMS I (OCHAR + JMP RDECLP + PAGE +OUDUMP, 0 /BUMP THE DUFFER + TAD OSIZE /ANY ROOM LEFT ? + IAC + SNA + JMP OFOO3 + DCA OSIZE /YES, ITS OK + JMS I DEVH /WRITE + 4200 /CONTROL WORD + OUBUF /BUFFER POINTER +OBLOCK, 0 /BLOCK NUMBER + JMP OFOO3 + ISZ OBLOCK /INCREMENT BLOCK NUMBER + ISZ FILSIZ /AND FILE SIZE + TAD OBLOCK-1 /SET BUFFER POINTER + DCA OUPTR + TAD (-200 /SET DOUBLE WORD COUNT + DCA OUWDCT + JMP I OUDUMP +OCHAR, 0 /OUTPUT A CHAR TO THE RALF INPUT FILE + AND (377 + DCA OUTEMP /SAVE CHAR + KSF /^C TEST + JMP NOSTOP + KRB + AND (177 + TAD (-3 + SNA CLA + JMP I (7605 /YES +NOSTOP, ISZ OUJUMP /BUMP 3 WAY SWITCH +OUJUMP, JMP . + JMP CHAR1 + JMP CHAR2 + TAD OUTEMP /HIGH FOUR BITS GO INTO + CLL RTL /THE HIGH ORDER BITS OF THE + RTL /FIRST WORD OF THE TWO WORD PAIR + AND (7400 /SEE NOTE * BELOW + TAD I OUPOLD /COMBINE WITH OTHER BITS + DCA I OUPOLD + TAD OUTEMP /THE OTHER FOUR BITS OF THIS CHAR + CLL RTR /GO INTO THE HIGH ORDER FOUR + RTR /BITS OF THE SECOND WORD OF THE PAIR + RAR + AND (7400 + TAD I OUPTR + DCA I OUPTR + TAD OUJMP /RESET 3 WAY BRANCH + DCA OUJUMP + ISZ OUPTR /BUMP BUFFER POINTER + ISZ OUWDCT /AND DOUBLE WORD COUNTER + JMP I OCHAR /BUFFER NOT FULL + JMS OUDUMP /DUMP IT + JMP I OCHAR +CHAR2, TAD OUPTR /SAVE FIRST WORD POINTER + DCA OUPOLD + ISZ OUPTR /GO TO SECOND WORD +CHAR1, TAD OUTEMP /STORE CHAR 1 OR 2 + DCA I OUPTR + JMP I OCHAR +OUTEMP, 0 +OUPOLD, 0 +OUPTR, OUBUF +OUJMP, JMP OUJUMP +OUWDCT, -200 +OSIZE, 0 +ERRPTR, 5000 +ERRCHK, 0 + CDF 10 + TAD I ERRPTR /ANY ERRORS FOR THIS LINE + CDF + CMA + TAD LINENO + SZA CLA + JMP I ERRCHK /NO + CLL CMA RAL /BACK UP POINTER + TAD ERRPTR + DCA ERRPTR + TAD ERRPTR + IAC + DCA TEMP + CDF 10 + TAD I TEMP /GET CODE + CDF + CIA + DCA TEMP /SAVE NEGATIVE + TAD (ERRLST-1 + DCA X10 +FIND, TAD I X10 /LOOK FOR ERROR MESSAGE + SZA + TAD TEMP + SNA CLA + JMP .+3 + ISZ X10 + JMP FIND /SKIP POINTER WORD + CLA CMA + TAD I X10 + DCA X10 /POINTER TO MESSAGE +PMLOOP, TAD I X10 /GET TWO CHARS + DCA TEMP + TAD TEMP + RTR + RTR + RTR + JMS CONVRT /PRINT FIRST + TAD TEMP + JMS CONVRT /PRINT SECOND + TAD TEMP + AND (77 /END OF MESSAGE ? + SZA CLA + JMP PMLOOP /NO, LOOP + JMS I (CRLF + JMP ERRCHK+1 /SEE IF ANY MORE FOR THIS LINE +RALFNM, FILENAME RALF.SV + PAGE +X304, 304 +X305, 305 +X7605, 7605 +OFOO3, TAD X304 /FATAL ERROR IN PASS 3 + JMS TTY + TAD X305 + JMS TTY + JMP I X7605 +TTY, 0 /PRINT ON TTY + TLS + TSF + JMP .-1 + CLA + JMP I TTY +/ERROR MESSAGES +ERRLST, 0724;GT + 1124;IT + 0504;ED + 2227;RW + 0317;CO + 0530;EX + 2123;QS + 2114;QL + 1106;IF + 0417;DO + 2316;SN + 2404;TD + 0204;BD + 2224;RT + 2204;RD + 2324;ST + 0314;CL + 1517;MO + 1017;HO + 1515;MM + 2323;SS + 1720;OP + 0123;AS + 0401;DA + 0410;DH + 1514;ML + 0405;DE + 0223;BS + 1424;LT + 1105;IE + 2010;PH + 1513;MK + 1724;OT + 2004;PD + 1524;MT + 0726;GV + 1411;LI + 0420;DP + 0414;DL + 0101;AA + 2306;SF + 0406;DF + 1111;II + 0;SYSERR +SYSERR, TEXT 'UNDEFINED ERROR' +II, TEXT 'ILLEGAL USE OF IF' +GT, TEXT 'BAD GOTO STATEMENT' +RW, TEXT 'BAD READ OR WRITE STATEMENT' +CO, TEXT 'ARGS IN COMMON OR VAR IN TWO COMMONS OR SYNTAX BAD' +IT, TEXT 'BAD IO LIST ELEMENT' +EX, TEXT 'BAD EXTERNAL STMT' +QS, TEXT 'SYNTAX ERROR IN EQUIVALENCE' +QL, TEXT 'VARIABLE IS EQUIVALENCED MORE THAN ONCE' +IF, TEXT 'THIS KIND OF STATEMENT NOT LEGAL AFTER LOGICAL IF' +DO, TEXT 'BAD SYNTAX IN DO OR IMPLIED DO' +SN, TEXT 'NOT LEGAL AS SUBROUTINE NAME' +TD, TEXT 'SYNTAX ERROR IN TYPE STATEMENT' +BD, TEXT 'DIMENSIONS TOO BIG, OR SYNTAX ERROR IN DIMENSION LIST' +ED, TEXT 'ILLEGAL AS DO ENDING STATEMENT' +RT, TEXT 'ATTEMPT TO RE-TYPE A VARIABLE' +RD, TEXT 'ATTEMPT TO RE-DIMENSION A VARIABLE' +ST, TEXT 'INTERNAL COMPILER ABORT NUMBER ONE' +CL, TEXT 'ERROR IN COMPLEX LITERAL' +MO, TEXT 'OPERAND EXPECTED, NONE PRESENT' +HO, TEXT 'HOLLERITH COUNT WRONG, OR MISSING QUOTES' +MM, TEXT 'MISMATCHED PARENTHESIS' +SS, TEXT 'SUBSCRIPT OR ARGUMENT LIST ERROR' +OP, TEXT 'ILLEGAL OPERATOR' +AS, TEXT 'ASSIGN ???' +DA, TEXT 'DATA STATEMENT ?' +DH, TEXT 'HOLLERITH COUNT OR QUOTE ERROR IN DATA STATEMENT' +ML, TEXT 'THIS LINE NUMBER IS ALREADY DEFINED' +DE, TEXT "WRONG WAY TO END A DO LOOP" +BS, TEXT 'ILLEGAL IN BLOCK DATA' +LT, TEXT 'LINE TOO BIG' +IE, TEXT 'INPUT FILE ERROR, TAKEN AS END STATEMENT' +PH, TEXT 'THIS FUNCTION / SUBROUTINE STATEMENT IS UNACCEPTABLE' +MK, TEXT 'YOU MISPELED A KEYWURD' +OT, TEXT 'ILLEGAL OPERAND TYPE FOR THIS OPERATOR' +PD, TEXT 'INTERNAL COMPILER ABORT NUMBER TWO' +MT, TEXT "ILLEGAL VARIABLE TYPE MIXING" +GV, TEXT 'VARIABLE IN ASSIGNED OR COMPUTED GOTO MUST BE INTEGER OR REAL' +LI, TEXT 'EXPRESSION IN LOGICAL IF IS NOT TYPED LOGICAL' +DP, TEXT 'DO PARAMETERS MUST BE INTEGER OR REAL' +DL, TEXT "YOUR DATA AND VARIABLE LISTS ARE OF DIFFERENT LENGTHS" +AA, TEXT 'SUBROUTINES MAY ONLY HAVE SIX ARGUMENTS THAT ARE DIMENSIONED' +SF, TEXT 'BAD STATEMENT FUNCTION' +DF, TEXT 'BAD DEFINE FILE' + PAGEN, 1 + +PUTNUM, ISZ PAGEN /BUMP PAGE NUMBER + TAD PAGEN + TAD (-24 /LT 20? + SMA CLA + JMP OVER19 /YES + TAD (-5 /NO + JMS MOVE /MOVE IN NUMBER +NUM, 0 + PAGENO-1 + TAD NUM + TAD (5 + DCA NUM /PT TO NEXT ONE + JMP I (CRLF+1 + +TENS, 0 +ONES, 0 +KNT, 0 + +OVER19, DCA TENS /CONVERT + TAD PAGEN /PAGE NUMBER TO ONES AND TENS +O1, TAD (-12 /DIVIDE BY TEN + SPA + JMP .+3 + ISZ TENS + JMP O1 + TAD (12 + DCA ONES + TAD TENS + CLL RTL + TAD (HIS-10-1 + DCA HIP /POINT TO HIGH PART + TAD ONES + CLL RTL + TAD ONES + TAD (LOS-5-1 + DCA LOP + TAD (-4 + JMS MOVE +HIP, 0 + PAGENO-1 + TAD (-5 + JMS MOVE +LOP, 0 + PAGENO+4-1 + JMP I (CRLF+1 + MOVE, 0 + DCA KNT + TAD I MOVE + DCA X11 + ISZ MOVE + TAD I MOVE + DCA X12 + ISZ MOVE + TAD I X11 + DCA I X12 + ISZ KNT + JMP .-3 + JMP I MOVE + $ + diff --git a/sw/f4/FRTSRC/pause.ra b/sw/f4/FRTSRC/pause.ra new file mode 100644 index 0000000..76419a4 --- /dev/null +++ b/sw/f4/FRTSRC/pause.ra @@ -0,0 +1,43 @@ +/ +/ VERSION 5A 4-26-77 MH +/ + SECT8 #PAUSE /FORTRAN PAUSE HANDLER + EXTERN #WRITO + EXTERN #RSVO + EXTERN #RENDO + BASE 0 + FSTA PNUM /SAVE ARGUMENT + STARTD + FLDA 0 /GET RETURN ADDRESS + FSTA PAURET + STARTF + TRAP3 #WRITO + JA ZERO + JA PAUFMT + FLDA PNUM /PRINT A MESSAGE "PAUSE N" + TRAP3 #RSVO + TRAP3 #RENDO + TRAP4 OPAUSE /DO ACTUAL PAUSE +PAURET, JA . /RETURN + +OPAUSE, 0 + AND% 0 + AND% 0 /WASTE SOME TIME SO THAT THE LAST + AND% 0 /TWO CHARS OF THE MESSAGE WILL PRINT. + AND% 0 + AND% 0 + ISZ ZERO + JMP OPAUSE+1 +DPAUSE, IOF + KSF + JMP .-1 + KRB + CLA + ION + CDF CIF 0 + JMP% OPAUSE + +PNUM, F 0.0 +ZERO, F 0.0 +PAUFMT, TEXT %(' PAUSE'I6/)% + END diff --git a/sw/f4/FRTSRC/real.ra b/sw/f4/FRTSRC/real.ra new file mode 100644 index 0000000..9fed56c --- /dev/null +++ b/sw/f4/FRTSRC/real.ra @@ -0,0 +1,73 @@ +/ +/ R E A L +/ - - - - +/ +/ A I M A G +/ - - - - - +/ +/ C O N J G +/ - - - - - +/ +/ VERSION 5A 4-27-77 PT +/ +/REAL,AIMAG - ENTER IN COMPLEX,EXIT IN REAL +/CONJG - ENTER + EXIT IN COMPLEX +/ + SECT REAL + JA #REAL + DPCHK + TEXT +REAL + +REALXR, SETX XRREAL + SETB BPREAL +BPREAL, F 0.0 +XRREAL, F 0.0 +ARG, F 0.0 + F 0.0 + ORG 10*3+BPREAL + FNOP + JA REALXR + 0 +REALRT, JA . + BASE 0 +#REAL, SETX XRREAL + LDX 0,2 + LDX 1,0 +COMM, STARTD + FLDA 10*3 + FSTA REALRT + FLDA 0 + SETB BPREAL + BASE BPREAL + LDX 1,1 + FSTA BPREAL + FLDA% BPREAL,1 + FSTA BPREAL + STARTE + FLDA% BPREAL /GET ARG + FSTA ARG + JXN REAM,0 + STARTF + FLDA ARG+3 + FNEG + FSTA ARG+3 + STARTE + FLDA ARG + FSTA #CAC + JA REALRT +REAM, STARTF +CON, FLDA ARG,2 + JA REALRT + EXTERN #CAC +/ + ENTRY AIMAG +AIMAG, SETX XRREAL + LDX 1,2 + LDX 1,0 + JA COMM +/ + ENTRY CONJG +CONJG, SETX XRREAL + LDX 0,2 + LDX 0,0 + JA COMM + diff --git a/sw/f4/FRTSRC/realtm.ra b/sw/f4/FRTSRC/realtm.ra new file mode 100644 index 0000000..b721892 --- /dev/null +++ b/sw/f4/FRTSRC/realtm.ra @@ -0,0 +1,284 @@ +/ A-D CLOCKED, BUFFERED SAMPLING ROUTINE +/ +/ VERSION 5A 4-27-77 PT +/ + ADSK=6534 + ADRB=6533 + ADST=6532 + ADLM=6531 + ADLE=6536 + ADCL=6530 + CLZE=6130 + ESF=4 + LINC=6141 + PDP=2 + SAM=100 + CLEN=6134 + FIELD1 SAMPLE + 0 /INTERRUPT TIME AD SAMPLER + IFNSW 8 < + JMS LNCSAM /INITIATE SAMPLE +NEXTCH, ISZ SAMINS /UPDATE SAM INST FOR NEXT CHAN + JMS LNCSAM /SAM AND INITIATE NEXT CHANNEL + > + TAD SAMPTR /SAVE THE OLD SAM BUFFER POINTER + DCA OLDPTR + TAD BUFFLD /AND THE FIELD + DCA OLDFLD + ISZ SAMPTR /BUMP BUFFER POINTER + JMP FLDOK /FIELD IS OK + TAD BUFFLD /BUMP FIELD + TAD L10 + DCA BUFFLD +FLDOK, ISZ SAMCNT /BUMP BUFFER COUNT + JMP BUFFLD /NOT END OF BUFFER + TAD ARRAY+2 /RESET POINTER TO START OF BUFFER + DCA SAMPTR + TAD FLDBUF /RESET BUFFER FIELD + DCA BUFFLD + TAD BUFSIZ /RESET COUNT + DCA SAMCNT +BUFFLD, HLT /GET FIELD OF NEW ADB STOP CODE + TAD% SAMPTR /IS THIS THE SAM STOP CODE ? + TAD M3776 /(ILLEGAL AS A SAMPLE) + SZA CLA + JMP NOERR + ISZ TOOFAS /SET TOO FAST SWITCH +SAMPLD, CDF 10 + DCA% XCLINT+1 /STOP SAMPLING + JMP% SAMPLE +NOERR, CLL CMA RAR /SET ADB STOP CODE + DCA% SAMPTR +OLDFLD, HLT /GET TO FIELD OF SAMPLE + IFSW 8 < + ADRB /READ SAMPLE + > + IFNSW 8 < + TAD SAMTMP /GET PREVIOUSLY READ SAMPLE + > + DCA% OLDPTR /INTO BUFFER + ISZ NPOINT+2 /ANY MORE SAMPLES + SKP /YES + ISZ NPOINT+1 /MORE THAN 7777 ? + SKP /YES + JMP SAMPLD /NO + ISZ NCHANL+1 /ANY MORE CHANNELS TO SAMPLE ? + JMP NEXTCH /YES GO START SAMPLING + TAD CSTART+2 /STARTING CHANNEL + IFSW 8 < + ADLM + > + IFNSW 8 < + DCA SAMINS + JMS LNCSAM /SET CHANNEL TO START + /IN CASE CLOCK INITIATED + > + TAD NCHANL+2 /NUMBER OF CHANNELS + DCA NCHANL+1 /INTO COUNTER + CDF 10 + JMP% SAMPLE + IFSW 8 < +NEXTCH, ADST /SAMPLE NEXT CHANNEL + ADSK /WAIT FOR SAMPLE + JMP .-1 + JMP SAMPLE+1 + > + IFNSW 8 < +LNCSAM, 0 /LINC SAM SUBROUTINE + LINC +SAMINS, SAM 0 /SAMPLE AND SELECT NEXT CHANNEL + PDP + DCA SAMTMP /SAVE IT + JMP% LNCSAM + > +ADSETU, 0 /SET UP ROUTINE + DCA TOOFAS /CLEAR TOO FAST SWITCH + TAD ARRAY+1 /GET FIELD OF BUFFER + AND L7 + CLL RTL + RAL + TAD CDF0 + DCA FLDBUF + TAD FLDBUF + DCA BUFFLD /SAVE IN SAMPLER CODE + TAD ARRAY+2 /SET SAMPLER BUFFER POINTER + IAC + DCA SAMPTR + TAD LENGTH+2 /SIZE OF BUFFER + CLL RAL + TAD LENGTH+2 /TIMES THREE + DCA BUFSIZ /SAVE IT + TAD BUFSIZ /SET INITIAL COUNT + IAC + DCA SAMCNT + TAD NCHANL+2 /SET CHANNEL COUNT + DCA NCHANL+1 + IFSW 8 < + CLA CMA /STOP THE CLOCK + CLZE + CLA + ADCL /CLEAR AD LOGIC JUST IN CASE + TAD L300 /SET AD ENABLE BITS + ADLE + TAD CSTART+2 /STARTING CHANNEL NUMBER + ADLM + > + IFNSW 8 < + CLEN /STOP THE CLOCK + TAD CSTART+2 /SET UP INITIAL SAM INSTRUCTION + TAD L100 + DCA CSTART+2 + TAD CSTART+2 + DCA SAMST /STARTING SAM + TAD SAMST /ALSO INTERRUPT TIME SAM + DCA SAMINS + TAD L100 /SET FAST SAM BIT + IOF /TURN OFF INTERRUPTS IN LINC MODE + LINC /ENTER LINC MODE + ESF +SAMST, SAM 0 /SET INITIAL SAM CHANNEL + PDP + ION + CLA + > + CIF CDF + JMP% ADSETU +BASEX, FNOP +M3776, -3776 +L10, 10 +SAMPTR, +ARRAY, 0;0;0 +LENGTH, 0;0 +BUFSIZ, 0 +SAMCNT, +CSTART, 0 +OLDPTR, 0;0 +SAMTMP, +NCHANL, 0;0;0 +NPOINT, 0;0;0 +FLDBUF, +XCLINT, ADDR #CLINT + IFSW 8 < +L300, 300 + > + IFNSW 8 < +L100, 100 + > +SAMXR, 0;0 +TOOFAS, 0 + ORG 10*3+BASEX + 0 + JA NAME+3 + 0 +SAMRTN, JA . +CDF0, CDF +L7, 7 + SECT REALTM + BASE 0 + STARTD + FLDA 30 /GET RETURN ADDR + FSTA SAMRTN + FLDA 0 /GET ARG POINTER + BASE BASEX + SETB BASEX + SETX SAMXR + FSTA NPOINT /SAVE ARG POINTER + FCLA + EXTERN #CLINT + FSTA #CLINT /STOP ANY SAMPLING NOW! + LDX 1,1 + FLDA% NPOINT,1 /GET BUFFER ADDRESS + FSTA ARRAY + FLDA% NPOINT,1+ /GET ADDR OF LENGTH + FSTA LENGTH + FLDA% NPOINT,1+ /ADDR OFHANNEL START + FSTA CSTART + FLDA% NPOINT,1+ /ADDR OF # CHANNELS + FSTA NCHANL + FLDA% NPOINT,1+ /ADDR OF NUMBER OF POINTS + FSTA NPOINT + FLDA ARRAY /CREATE SETX INS + FADD STXMJA + FSTA BUFSTX + FSTA ADBSTX /AND SAVE IT IN TWO PLACES + STARTF + FLDA% LENGTH /INTEGERIZE AND NEGATE SOME ARGS + FNEG + ALN 0 + FSTA LENGTH + FNORM + ATX 1 /SET BUFFER COUNT + FLDA% CSTART /GET STARTING CHANNEL + ALN 0 + FSTA CSTART + FLDA% NCHANL + FNEG + ALN 0 + FSTA NCHANL + FLDA% NPOINT + FNEG + ALN 0 + FSTA NPOINT + LDX -1,2 /SET UP FOR BUFFER CLEAR + FCLA +CLRBUF, FSTA% ARRAY,2+ + JXN CLRBUF,1+ + TRAP4 ADSETU /SET UP AD STUFF + FLDA LENGTH /RE-GET BUFFER SIZE + FNORM + ATX 1 /BUT NOW ITS TIMES THREE + FLDA STPCOD /STORE STOP CODES + FSTA% ARRAY /INTO FIRST 3 WORD + STARTD + FLDA SAMADR /SET UP SAMPLER INTERRUPT HANDLER + FSTA #CLINT + STARTF + JA SAMRTN /RETURN +NAME, TEXT +RTMADB+ +SAMADR, ADDR SAMPLE +STPCOD, 3776;3777;0 +STXMJA, 1100-1030;0 +L2047, F 2047. +L511, F 511. + ENTRY ADB +ADB, BASE 0 /FETCH SAMPLE FROM BUFFER + STARTD + FLDA 30 /SAVE REUTRN + FSTA SAMRTN + SETB BASEX + SETX SAMXR + BASE BASEX + JXN SPEEDK,2 /CLOCK TOO FAST + FLDA ADBSTX /SAVE OLD SETX + FSTA OLDSTX + FADD L1 /ADD ONE TO IT + FSTA ADBSTX /AND SAVE IT BACK + JXN NORINQ,1+ /END OF BUFFER ? + FLDA BUFSTX /YES, RESTART + FSTA ADBSTX + FLDA LENGTH /RESET COUNT + ATX 1 +NORINQ, STARTF +ADBSTX, SETX 0 /SET XR0 TO NEXT SAMPLE +WAIT, XTA 0 /GET THE NEXT SAMPLE + FSUB L2047 /IS IT THE STOP CODE + JEQ WAIT /YES + XTA 0 /NO, FETCH THE SAMPLE + LDX 3776,0 /SET SAMPLE STOP CODE +OLDSTX, SETX 0 /SET XR0 TO PREVIOUS STOP CODE + LDX 0,0 /NOW ZERO IT + JA SAMRTN /RETURN +SPEEDK, EXTERN #WRITO /USE FORTRAN I/O + TRAP3 #WRITO /TO WRITE A MESSAGE + JA TTYUNT /ON THE TTY + JA MESSAG + EXTERN #RENDO + TRAP3 #RENDO /CLOSE THE RECORD + LDX 0,2 /KILL TOO FAST SWITCH + JA SAMRTN /RETURN FROM ADB +TTYUNT, F 0. +MESSAG, TEXT '(" SAMPLING TOO FAST")' +BUFSTX, SETX 0 +L1, 0;1 + END + diff --git a/sw/f4/FRTSRC/rfcv.ra b/sw/f4/FRTSRC/rfcv.ra new file mode 100644 index 0000000..48c509b --- /dev/null +++ b/sw/f4/FRTSRC/rfcv.ra @@ -0,0 +1,49 @@ +/ +/ VERSION 5A 4/26/77 MH +/ + SECT #RFCV /READ FORMATTED COMPLEX VARIABLE + ENTRY #WFCV + EXTERN #RFSV + EXTERN #WFSV + JA START + DPCHK + TEXT "#CIO " +RETN, FNOP + FNOP + SETB BP + JA .+3 +BP, 0;0;0 +CVAL, 0;0;0;0;0;0 + ORG BP+30 + 0;JA RETN + 0 +GOBAK, JA . +START, BASE 0 + STARTD + 0210 + FSTA GOBAK,0 + STARTF + SETB BP + BASE BP + JSR #RFSV + FSTA CVAL + JSR #RFSV + FSTA CVAL+3 + STARTE + FLDA CVAL + JA GOBAK + BASE 0 +#WFCV, FSTA CVAL,0 + STARTD + 0210 + FSTA GOBAK,0 + SETB BP + BASE BP + STARTF + FLDA CVAL + JSR #WFSV + FLDA CVAL+3 + JSR #WFSV + JA GOBAK + END + diff --git a/sw/f4/FRTSRC/rfdv.ra b/sw/f4/FRTSRC/rfdv.ra new file mode 100644 index 0000000..b864b16 --- /dev/null +++ b/sw/f4/FRTSRC/rfdv.ra @@ -0,0 +1,30 @@ +/DOUBLE PRECISION BINARY AND DIRECT ACCESS I/O +/FOR OS/8 FORTRAN +/ +/ VERSION 5A 4-26-77 MH +/ +/I/O CALLS ARE: +/ TRAP3 #RSVO ALL SINGLE PRECISION I/O +/ TRAP3 #RSVO ALL DOUBLE PRECISION FORMATTED I/O +/ JSR #RFDV DOUBLE PRECISION BINARY + DIRECT ACCESS I/O +/ TREATED AS 2 SINGLE PRECISION FORMATTED JOBS + SECT #RFDV + EXTERN #RSVO + BASE 0 + STARTE + FSTA FTEMP3 /SAVE 6 WDS FOR A WRITE + STARTD + FLDA 0 /RETURN ADDRESS + FSTA RFDVRT /SAVE FOR EXIT + STARTF + FLDA FTEMP3 /PASS 1ST 3 WDS FOR A WRITE + TRAP3 #RSVO /DO THE READ OR WRITE + FSTA FTEMP3 /SAVE 1ST 3 WDS FROM A READ + FLDA FTEMP3+3 /GET 2ND 3 WDS FOR A WRITE + TRAP3 #RSVO /DO THE READ OR WRITE + FSTA FTEMP3+3 /SAVE 2ND 3 WDS FROM A READ + STARTE + FLDA FTEMP3 /GET ALL 6 WORDS FOR A READ +RFDVRT, JA . + +FTEMP3, E 0.0 diff --git a/sw/f4/FRTSRC/rsw.ra b/sw/f4/FRTSRC/rsw.ra new file mode 100644 index 0000000..d824a4f --- /dev/null +++ b/sw/f4/FRTSRC/rsw.ra @@ -0,0 +1,141 @@ +/ +/ VERSION 5A 4-26-77 MH +/ +/THE FOLLOWING IS A SET OF 8 MODE (RALF TYPE) +/ROUTINES THAT ENABLE PDP 12(8) HARDWARE OPTIONS +/THESE ROUTINES ARE CALLABLE AT THE FORTRAN LEVEL +/THE FOLLOWING OPTIONS ARE SUPPORTED: +/ +/ 1 READ A BIT IN THE RIGHT SWITCHES +/ 2 READ A BIT IN THE LEFT SWITCHES +/ 3 READ A SENSE SWITCH +/ 4 READ AN EXTERNAL LEVEL +/ 5 OPEN OR CLOSE A RELAY +/ +/IF THE REQUESTED BIT OR SWITCH IS SET THE +/SUBROUTINE RETURNS WITH THE CALLERS ARG SET TO +/A 1,OTHERWISE IT IS SET TO A 0 +/ +/ + SECT8 RSW + INDEX P17 + BASE 0 + JSA SETUP /CHECK ONE RSW BIT + TRAP4 DORITE /CALL 8 MODE ROUT USER + /ARG IS IN FPP XR3 +CONT, STARTD /ANSWER IS IN XR3 + FLDA% 0,XR2 /GET PTR TO CALLER ANS + FSTA 3 + STARTF + XTA XR3 + FSTA% 3 /GIVE ANS TO CALLER +GOBAK, FLDA 30 /RTN TO CALLER + JAC + ENTRY LSW +LSW, JSA SETUP /READ 1 LSW BIT + TRAP4 DOLEFT /CALL 8MODE ROUT + JA CONT + ENTRY SSW +SSW, STARTD /READ A SENSE SWITCH + FLDA ANSNSI + JA ESSW + ENTRY ROPEN +ROPEN, STARTD /OPEN A RELAY + FLDA ABCLI +ERCLOS, FSTA MASK /PLANT A BCLI OR BSEI IN + /8 MODE ROUTINE + JSA SETUP + TRAP4 RELAY + FLDA 30 + JAC + ENTRY EXTLVL +EXTLVL, STARTD /READ AN EXTERNAL LEVEL + FLDA ANSXL +ESSW, FSTA LSKP /PLANT SXLI OR SNS IN + JSA SETUP /8 MODE ROUTINE + TRAP4 DOSXL + JA CONT + ENTRY RCLOSE +RCLOSE, STARTD /CLOSE A RELAY + FLDA ABSEI + JA ERCLOS +SETUP, 0;0 /GET ARGS AND SETUP RTN + STARTD + SETX P17 + FLDA% 0,XR1 /GET PTR TO 1ST USER ARG + FSTA 3 + STARTF + FLDA% 3 /USER ARG TO FAC + ATX XR3 /PUT IN XR FOR 8 MODE + JA SETUP + DORITE, 0 /READ RIGHT SWITCHES + LAS + DCA MASK + JMS SETBIT /GET REQUESTED BIT + AND MASK /MASK RSW + SZA CLA /IF BIT IS SET,SET XR3=1 + ISZ XR3 + CIF CDF /RTN TO RTS + JMP% DORITE +DOLEFT, 0 /READ LEFT SWITCHES + TAD DOLEFT + DCA DORITE + IOF + 6141 /LINC + 517 /LSW + 2 /PDP + ION + JMP DORITE+2 +DOSXL, 0 /READ SENSE SWITCH + /OR EXTERNAL LEVEL + TAD XR3 /=SSW OR LVL TO DO + AND P17 + TAD LSKP + DCA LSKP + CLL CML /SET LNK=COND MET + IOF + 6141 +LSKP, 0 /=SNS I N OR SXL N + 261 /IF SKP FAILS THEN COND + /IS MET SO ROTATE LNK + /INTO AC(11) (261=ROL I 1) + 2 /PDP + ION + DCA XR3 /SAVE ANSWER + CIF CDF + JMP% DOSXL /RTN TO RTS +RELAY, 0 /OPEN A RELAY + TAD CONT /=6 + JMS SETBIT /GO SET RELAY BIT + DCA MASK+1 + IOF + 6141 + 15 /GET RELAYS +MASK, 0 /BCL I OR BSE I + 0 /SET OR CLR 1 RELAY BIT + 14 /ATR PUT RELAYS BACK + 2 + ION + CLA + CIF CDF + JMP% RELAY +SETBIT, 0 /COME HERE TO POSITION + TAD XR3 /BIT IN AC ACCORDING TO + /C(AC)+XR3 + CMA CLL CML /ROTATE BIT INTO POSITION + DCA XR3 /XR3 MUST=0 UPON EXIT + RAR /ROTATE LINK UNTIL + ISZ XR3 /XR3=0 + JMP .-2 + JMP% SETBIT /RTN WITH AC SET +ABCLI, 1560 /BCL I +ABSEI, 1620 /BSE I +P17, 17 /FPP XR0 +XR1, 1 +XR2, 2 +XR3, 0 +ANSXL, 400 /SXL + 261 /ROL I 1 +ANSNSI, 460 /SNS I + 261 + diff --git a/sw/f4/FRTSRC/rtl.pa b/sw/f4/FRTSRC/rtl.pa new file mode 100644 index 0000000..13c43ea --- /dev/null +++ b/sw/f4/FRTSRC/rtl.pa @@ -0,0 +1,1753 @@ +/FORTRN 4 RTS LOADER +/ +/ VERSION 5A PT 16-MAY-77 +/ +/ +/ +/ +/ +// +/ +/ +/ +/ +/COPYRIGHT (C) 1974, 1975 +/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. +/ +/ +/ +/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A +/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- +/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER +/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE +/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO +/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE +/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. +/ +/ +/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT +/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL +/EQUIPMRNT COROPATION. +/ +/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS +/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. +/ +/ +/ +/ +/ +/ + /FORTRAN 4 RTS LOADER - RL +/WITH DOUBLE PRECSION - MKH +/AND RTS-8 SUPPORT - R. LARY + +/LAST EDITED 5/21/74 +/ +/ CHANGES FOR OS/78 AND OS/8 V3D BY P.T. 5/1/77 +/ .FIXED THE D AND B FORMAT (FPP) BUG +/ .FIXED FIELD OVERFLOW BUG(NO. OF ASTERISKS PRINTED) +/ + +/PAGE 0 LOCATIONS FOR RTS LOADER + +X0= 10 +X1= 11 +X2= 12 +X3= 13 + +HADR= 20 +UNIT= 21 +HCWORD= 22 +MXFLD= 23 +HLDADR= 24 +HGHFLD= 25 +HGHADR= 26 +RLTMP= 27 +HDIFF= 30 +CFLAG= 31 + +/DURING MOST OF THE LOAD OPERATION A SECTION OF FIELD 0 RTS +/IS MOVED UP INTO FIELD 1 AND THE VACATED AREA OF FIELD 0 IS USED +/TO RUN THE COMMAND DECODER AND TO ACCUMULATE DEVICE HANDLERS. + +/*K* THEREFORE, IF THE RTS LOADER IS TO MODIFY ANY CODE BETWEEN +/"F0HBEG" AND "F0HEND" IT MUST MODIFY IT IN FIELD 1 IN THE "F0TO" AREA. + +F0HBEG= 0 +F0HEND= 3000 +F0HSAV= 7000 /400 WORDS WHERE DEVICE HANDLERS ARE TEMPORARILY SAVED + /SO THAT THEY WON'T INITIALIZE THEMSELVES WRONG + /RTS LOADER TABLES + + *2000 + +IONTBL, ZBLOCK 100 /INTERRUPT ENABLE TABLE - LOW BIT ONLY +HCWTBL, ZBLOCK 14 /HANDLER CONTROL WORD - ONE PER PAGE (LOTSA WASTE) +TFTABL, ZBLOCK 45 /TENTATIVE FILE SAVE TABLE +DVTEMP, ZBLOCK 17 /HANDLER ENTRY TABLE SAVE AREA + + *IONTBL+5 /RK8 / RK8E + 1 + *IONTBL+16 /DTA + 1 + *IONTBL+6 /RF08 IN 4 FLAVORS + 1;1;1;1 + *IONTBL+0 /TTY + 2 /FORMS CONTROL ON TTY + *IONTBL+4 /LPT + 2 /FORMS CONTROL ON LPT + *IONTBL+23 + 1 + *IONTBL+25 + 1 + PAGE + /RTS LOADER + +RTSLDR, JMS I (RTINIT + JMS I (RTINIT /INITIALIZE WHETHER CHAINED TO OR NOT + JMP NOCD +LICD, JMS I (200 + 5 + 1404 /.LD DEFAULT EXTENSION +NOCD, JMS I (TSTSWS /TEST /E,/P,/V AND /H SWITCHES + TAD I (7617 + SNA + JMP LICD + AND (17 + JMS I (GETHAN /GET HANDLER TO LOAD WITH + 0 /DON'T PUT IT ANYWHERE + TAD I (7620 + DCA LIBLK + JMS I (SVHND /COPY HANDLER TO AVOID BAD INITIALIZATION + CIF 0 + JMS I HLDADR + 0100 +LHDR, QLHDR +LIBLK, 0 + JMP LDIOER + JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER + CDF 0 + TAD HADR + DCA I (OVHND + TAD HCWORD + DCA I (OVHCDW + TAD (QUSRLV-1 + DCA X0 + AC7776 + TAD I LHDR + SZA CLA /VERIFY LOADER IMAGE INPUT + JMP NOTLI /GOOD THING WE CHECKED! + TAD DPFPP + TAD I (QDPFLG /CHECK IF TRYING TO USE D.P. WITHOUT OPTION + SMA CLA + JMP .+3 + JMS I (RLERR /YES - PRINT WARNING MESSAGE + NODPMS /BUT LET THE FOOL GO ON + /SET UP RTS TABLES FROM LOADER IMAGE + + CDF 0 + TAD (OVLYTB-1 + DCA X1 + TAD (-10 + DCA RLTMP +OVRELP, TAD I X0 + DCA I X1 /MOVE USER OVERLAY INFO INTO SWAP TABLE, + TAD I X0 + DCA I X1 + TAD I X0 + TAD LIBLK /RELOCATING THE BLOCK NUMBERS + DCA I X1 + TAD I X0 + DCA I X1 + ISZ RLTMP + JMP OVRELP + TAD I (QRTSWP + AND (7770 /TURN THE LOADER INITIAL SWAP WORD + DCA I (STSWAP+2 + TAD I (QRTSWP /INTO A DUMMY SWAP WORD AND A JUMP WORD + AND (7 /SO THAT WE CAN HALT BETWEEN + TAD (JA /LOADING AND STARTING USERS PROGRAM. + DCA I (STJUMP + TAD I (QRTSWP+1 + DCA I (STJUMP+1 + TAD I (QHGHAD + DCA HGHFLD + CLA IAC + TAD HGHFLD + CMA + DCA I (FCNT + TAD I (QHGHAD+1 + DCA HGHADR + JMS I (GETFIL /GET USER I/O FILES IF ANY + TAD I (OS8DAT /SALT AWAY OS/8 DATE WORD + DCA I (VDATE-F0HBEG+F0TO + STL CLA + 6141 /TEST IF WE ARE ON A PDP-12 + 0261 /ROL I 1 - PUTS LINK IN AC11 + 0002 /PDP + DCA I (V8OR12+1-F0HBEG+F0TO + JMS I (MOVE + CDF 10 + SPSTRT-1 /MOVE SPECIAL /P START CODE TO LOC 200 + CDF 10 + 200-F0HBEG+F0TO-1 /(RELOCATED 200, THAT IS) + -3 + JMP I (MOVCOR + +DPFPP, 3777 /0 IF D.P. FPP AVAILABLE + NOTLI, JMS I (RLERR + NOLI + JMP LICD + +LDIOER, JMS I (RLERR + LIOEMS + CDF CIF 0 + JMP I (7605 + PAGE + /FIGURE OUT CORE LIMITS AND WRITE OUT PG 17600 + +MOVCOR, TAD I (HTOP + TAD HDIFF /GET BOTTOM OF HANDLER AREA + CIA + CLL /LENGTH OF HANDLER AREA IN AC + TAD HGHADR + SZL /TRICKY CODE - IF (L,AC)=0, AC GETS -1 + STA /IF (L,AC) =0XXXX, AC GETS 0 + SNA CLA /IF (L,AC) =1XXXX, AC GETS 1 + STL STA /THERE OUGHTA BE A SHORTER WAY - + RAL /I'D APPRECIATE HEARING ONE. + TAD HGHFLD /USE MAGIC NUMBER TO ADJUST HGHFLD + CIA /BEFORE WE COMPARE IT TO TOP-OF-CORE + TAD MXFLD + SPA CLA + JMP TOOBIG /ALL THAT WORK FOR NOTHING! + TAD MXFLD + CLL RTL + RAL + TAD (CDF + DCA HCDF /PREPARE TO TRANSFER THE HANDLERS + JMS I (MOVE /BEFORE WE MOVE THE HANDLERS WE SHOULD WRITE + CDF 10 /OUT PAGE 17600 AND THE RTS CLEANUP CODE + TFTABL-1 /SINCE THE HANDLERS MAY OVERLAY THEM. + CDF 10 /SO FIRST MOVE THE TENTATIVE FILE TABLE + 7600-1 /INTO PAGE 17600 WHERE IT'S SAFE. + -45 + CIF 0 + JMS I (7607 + 4210 + 7400 + 37 /SUITABLE SCRATCH BLOCK + JMP SYSERR + TAD HDIFF + TAD (F0HEND /CHANGE HDIFF FROM AN OFFSET + DCA HDIFF /TO THE FIRST LOC ABOVE THE HANDLERS. + /SHUFFLE CORE AROUND AND START UP RTS + +HLOOP, STA + TAD HDIFF /WE HAVE TO MOVE THE HANDLERS IN A COCKEYED + DCA HDIFF /WAY SINCE WE MIGHT BE PARTIALLY SWAPPING + CDF 0 /CORE BETWEEN FIELD 0 (THE HANDLERS) AND + STA /FIELD 1 (WHERE WE SAVED FIELD 0) IN 8K SYSTEMS. + TAD HPTR1 + DCA HPTR1 + STA + TAD HPTR2 + DCA HPTR2 + TAD I HPTR1 +HCDF, HLT /MOVE A HANDLER WORD FROM FIELD 0 + DCA I HDIFF /TO FIELD N + CDF 10 + TAD I HPTR2 /MEANWHILE RESTORE FIELD 0 + CDF 0 + DCA I HPTR1 /FROM FIELD 1 + ISZ HMCT + JMP HLOOP /DO MORE THAN WE HAVE TO - IT CAN'T HURT + CDF CIF 0 + TAD (5606 + DCA I (7605 /SET UP OS/8 RETURN SEQUENCE TO TRAP TO RTS + TAD (PDPXIT + DCA I (7606 /AS RANDOM RESTARTS COULD BE FATAL. + FPICL /RE-INITIALIZE FPP (IF ANY) + FPCOM /CLEAR APT POINTER FIELD BITS (IF FPP) + CLA IAC + 6654 /LOAD PRINTER BUFFER ON ANALEX PRINTER + SZA CLA /IS ANALEX PRESENT? + JMP I (FPSTRT /NO - START UP + DCA I (LPTEST /IF ANALEX TAKE OUT LPT INTERNAL HANDLER +LP6652, 6652 /ALSO CLEAR ALL ANALEX FLAGS + DCA I (LPTSNA + 6662 /CLEAR BUFFER ON ANALEX + TAD (6651 + DCA I (LPTERR /REPLACE LP08 ERROR CODE BY ANALEX + TAD LP6652 /TO AVOID HANGING ON ANALEX POWER OFF. + DCA I (LPTERR+2 + JMP I (FPSTRT + +TOOBIG, JMS I (RLERR + TOOMCH +OS8RTN, CDF CIF 0 + JMP I (7605 + +SYSERR, JMS I (RLERR + SYSMSG + JMP OS8RTN + +HPTR1, F0HEND +HPTR2, F0TO+F0HEND-F0HBEG +HMCT, F0HBEG-F0HEND + /MOVE ROUTINE + +MOVE, 0 /GENERAL MOVE SUBROUTINE + CDF 10 + CLA + TAD MOVE + DCA X2 + TAD I MOVE + DCA FRMFLD + TAD I X2 + DCA X3 + TAD I X2 + DCA TOFLD + TAD I X2 + DCA X1 + TAD I X2 + DCA MVC +FRMFLD, HLT + TAD I X3 +TOFLD, HLT + DCA I X1 + ISZ MVC + JMP FRMFLD + CDF 10 + JMP I X2 +MVC, 0 + +HNDERR, JMS I (RLERR + TOMNYH + JMP OS8RTN + PAGE + /INITIALIZATION + +RTINIT, 0 + ISZ RTINIT /SKIP RETURN + JMS I (BAKTST /SEE IF WE'RE RUNNING IN BACKGROUND UNDER RTS-8 + CIF 0 + JMS I (CORE + DCA MXFLD + CLA IAC + JMS I (GETION /GET ION BIT FOR SYS HANDLER + DCA I (HCWTBL+13 /SAVE IT + SWAB /SET EAE MODE TO B (IF 8/E) + CLA IAC +EAEKIL, SHL /ZERO THIS LOCATION TO INHIBIT EAE + CLA IAC /LOW ORDER BITS 01 + TAD (-2 + SNA CLA /TEST FOR 8/E EAE + JMS I (MOVEAE /YES - SUBSTITUTE PACKAGES + TAD (APT + FPST /START FPP ON "STARTE;FEXIT" + JMP NOFPP /DIDN'T START + JMS I (MOVE + CDF 10 + FPPINT-1 /THE FPP HANDLER AND D.P. I/O PKG IS IN THE + CDF 0 /SAME LOCATIONS IN FIELD 1 AS THE + FPPINT-1 /FPP INTERPRETER IN FIELD 0. + -1000 /COUNT FOR DBL PREC SPACE + FPRST /FPP HAD BETTER BE DONE BY NOW!! + AND (4 /GET D.P. STATUS BIT + SNA CLA + JMP NOFPP /NO DOUBLE PRECISION + DCA I (DPFPP /SET FLAG TO INDICATE D.P. AVAILABLE + CDF 0 + TAD (DFMT + DCA I (DF /ENABLE D FORMAT + TAD (BFMT + DCA I (BF /AND B FORMAT + CDF 10 + NOFPP, JMS I (MOVE +RICDF0, CDF 0 + F0HBEG-1 + CDF 10 + F0TO-1 /MOVE LOWER F0 INTO F1 FOR SAFEKEEPING + F0HBEG-F0HEND + CDF 0 + TAD I (OSJSWD /GET OS/8 STATUS WORD + AND (6374 /FORCE BITS ON INDICATING NON-RESTARTABLE JOB + TAD (1003 /AND DESTRUCTIVE CALLS TO CD AND USR + DCA I (OSJSWD /MEANWHILE FORCING "BATCH SAVED" BIT OFF + TAD I (7612 + TAD (-3 /CHECK FOR IN-CORE TD8E'S + SZA CLA + JMP NOTDSY + TAD MXFLD + CLL RTL + RAL + TAD RICDF0 + DCA TD8EFG /SET TD8E FLAG WHICH IS ALSO CDF + TAD I (7642 + AND (70 + TAD RICDF0 /GET THE FIELD WE'RE COMING FROM + DCA TD8EFL + TAD TD8EFG + IAC + JMS I (TDSET /REDO THE CDF'S IN F0 + JMS I (MOVE +TD8EFL, CDF 20 + 7577 +TD8EFG, 0 + 7577 + -174 /SPARE BATCH PARAMETERS IN TOP FIELD + TAD MXFLD /SET FLAG IN CLEANUP ROUTINE + DCA I (TDEXFG /TO RESTORE TD8E HANDLER TO FIELD 2 +NOTDSY, CDF 10 + TAD MXFLD + TAD (-7 + SNA /32K? + JMP TAKCAR /YES - UNIQUE PROBLEMS + TAD (6 + SNA CLA /8K? + JMP ONLY8K /YES - IGNORE BATCH & TD8E CRAP + JMS I (GBFLG /GET BATCH FLAG + TAD TD8EFG + SNA CLA /IF NO BATCH OR TD8E'S, +ONLY8K, TAD (200 /USE ALL OF THE LAST FIELD. +STOHDF, TAD (-F0HEND-200 + DCA HDIFF /OTHERWISE USE ONLY UP TO 7600 + JMP I RTINIT + TAKCAR, JMS I (GBFLG /GET BATCH FLAG + SNA CLA + JMP NO32KB /NO BATCH - USE UP TO 77400 (TD8E ROM) + TAD (6 /BATCH - USE UP TO 67600 + DCA MXFLD + JMP STOHDF +NO32KB, TAD TD8EFG + SNA CLA /IF IN-CORE TD8E'S + TAD (7600 /LIMIT IS 77600 ELSE 77400 + JMP STOHDF + PAGE + GETHAN, 0 /GET HANDLER SUBROUTINE + AND (17 + DCA UNIT + DCA H1 + TAD UNIT + JMS I (200 + 12 /INQUIRE +H1, 0 + NOP /ERROR RETURN ALWAYS SKIPPED + TAD H1 + SNA + JMP NOTLDD /NOT IN CORE - MUST LOAD + JMS HCWTBA /IN CORE +GHEXIT, TAD I HCWPTR /GET CONTROL WORD FOR HANDLER PAGE + DCA HCWORD + TAD HLDADR + DCA HADR /ASSUME HANDLER PERMENANTLY RESIDENT + TAD (-4 + AND HCWORD + SNA CLA /WERE WE RASH? + JMP RESHAN /NO + TAD HADR + AND (177 + TAD (HPLACE /YES - I APOLOGIZE + DCA HADR +RESHAN, TAD I GETHAN /GET DSRN NUMBER + SNA + JMP I GETHAN /NO DSRN NUMBER + CLL RTL + RAL + TAD I GETHAN + TAD (DSRN-12 + DCA X0 /XR POINTS TO DSRN ENTRY + CDF 0 + TAD HADR + DCA I X0 /SEE PG 0, FLD 0 FOR DSRN FORMAT + TAD HCWORD + TAD CFLAG /THE C BIT REVERSES THE FORMS CTL BIT ON THIS FILE + AND (7773 /KILL ANY OVERFLOW + DCA I X0 + TAD HGHFLD + CLL RTL + RAL + TAD HGHADR + DCA I X0 /SAVE BUFFER ADDRESS, FIELD + TAD HGHADR + DCA I X0 /INITIALIZE WORD POINTER + TAD HGHADR + TAD (400 + SNA + ISZ HGHFLD /BUMP DOUBLEWORD BUFFER ADDRESS + DCA HGHADR + AC7775 + DCA I X0 /INITIALIZE CHAR CTR + CDF 10 + JMP I GETHAN /RETURN + /LOAD A NON-RESIDENT HANDLER + +NOTLDD, JMS GH + CLA IAC + JMS GH /TRY 1-PAGE AND THEN 2-PAGE ASSIGN + HLT /ARRRGHHHH!!! + +GH, 0 + DCA TPFLG + TAD HTOP + TAD (7600 /BUMP HANDLER CEILING DOWN + SNA + JMP I (HNDERR /CAN'T PUT HANDLER IN PAGE 0 + DCA HTOP + TAD TPFLG + TAD HTOP + DCA GHADR + TAD UNIT + JMS I (200 + 1 /FETCH HANDLER +GHADR, 0 + JMP I GH /FAILED! + TAD GHADR /SAVE ACTUAL LOAD ADDRESS + JMS HCWTBA /INDEX INTO HCW TABLE + TAD GHADR + AND (7600 + TAD HDIFF + DCA GHADR /SAVE RELOCATED HANDLER PAGE ADDRESS + TAD MXFLD /PUT ADDR IN BITS 0-3 AND FIELD IN BITS 6-8 + CLL RTL + RAL + TAD GHADR + DCA GHADR + TAD UNIT + JMS I (GETION /ION BIT INTO BIT 11, FORMS CTL BIT INTO BIT 10 + TAD GHADR + DCA I HCWPTR /STORE POINTER FOR THIS PAGE + JMP GHEXIT + HCWTBA, 0 + DCA HLDADR + TAD HLDADR + AND (7600 + CLL RTL + RTL + RTL /GET PAGE NUMBER + TAD (HCWTBL-24 + DCA HCWPTR /SAVE POINTER INTO TABLE + JMP I HCWTBA + +HTOP, F0HEND +HCWPTR, 0 +TPFLG, 0 + +SPSTRT, RELOC 200 / /P STARTUP CODE + SWAB /MAKE SURE EAE IS IN MODE B + JMP I .+1 /EXECUTES AT 200 + FPSTRT /START UP IN FLAG CLEARING CODE + RELOC + PAGE + /ROUTINE TO ACCEPT FILE SPECIFICATIONS + +GETFIL, 0 + CDF 10 + TAD I (OS8SWS-1 + SPA CLA /ALTMODE MEANS NO MORE SPECS + JMP I GETFIL +GETFCD, JMS I (SPMDCD /CALL CD IN SPECIAL MODE + TAD I (7600 + STL CIA + SNA /OUTPUT FILE? + TAD I (7605 + SNA /IN OR OUT FILE? + TAD I (OS8SWS+3 /NEITHER - HOW ABOUT INTERNAL HANDLER? + SNA CLA + JMP GETFIL+1 /NONE OF THE ABOVE + RAR /LINK MAGICALLY TELLS DIRECTION + DCA DIR + DCA DSRNUM + TAD I (OS8SWS+2 + AND (777 /SWITCHES 1-9 + SNA + JMP NONUM + CLL RTL +DNUMLP, ISZ DSRNUM + RAL + SMA + JMP DNUMLP /TRANSLATE SWITCH INTO NUMBER + TAD DIR /** AC IS NEGATIVE ** + SPA CLA + TAD (5 + TAD (7600 + DCA FPTR /POINT TO FILE UNIT + TAD I FPTR + SNA + JMP INTHND /NO FILE - GET HANDLER FROM INTERNAL LIST + JMS I (GETHAN /GET HANDLER - XR10 POINTS INTO DSRN +DSRNUM, 0 /DSRN ENTRY NUMBER + TAD DIR + STL RTL /GENERATE 2 OR 3 (LOOKUP OR ENTER) + DCA LKPNTR + TAD I FPTR /GET UNIT AND REQUESTED BLOCK COUNT (IF ENTER) + ISZ FPTR /BUMP POINTER SO IT POINTS TO THE FILE NAME + DCA FUNIT /SAVE UNIT NUMBER A SEC + TAD I FPTR /WATCH OUT FOR NULL FILE NAMES + SNA CLA /AS THEY WILL FAIL ON LOOKUPS + JMP NONAME /ON OUTPUT-ONLY NON-DIRECTORY DEVICES + JMS I (SVHND /SAVE HANDLER + TAD FUNIT + JMS I (200 +LKPNTR, 0 /LOOKUP OR ENTER +FPTR, 0 /FILE NAME +FUNIT, 0 /GETS LENGTH + JMP FILERR /SOMETHING NOT KOSHER + JMS I (RSTHND /RESTORE VIRGIN COPY OF HANDLER + STDSRN, TAD FPTR + CDF 0 + DCA I X0 /SAVE STARTING BLOCK + DCA I X0 /RELATIVE BLOCK + TAD FUNIT + SNA + IAC /FUDGE NON-DIRECTORY DEVICES VERY LARGE + CIA /TURN NEGATIVE COUNT TO POSITIVE + DCA I X0 /LENGTH + TAD X0 + DCA FPTR /SAVE PTR TO LENGTH WORD + CDF 10 + TAD DIR + SMA CLA /TENTATIVE FILE? + JMP GETFIL+1 + TAD FPTR /YES - STORE POINTER TO LENGTH WORD OF DSRN + DCA I TFPTR /IN TENTATIVE FILE TABLE ENTRY + JMS I (MOVE + CDF 10 + 7600-1 + CDF 10 +TFPTR, TFTABL /SAVE FILE NAME AND UNIT IN + -5 /TENTATIVE FILE TABLE + TAD TFPTR + TAD (6 + DCA TFPTR /BUMP PTR TO NEXT 6-WORD ENTRY + JMP GETFIL+1 + NONUM, JMS I (RLERR + NONMSG + JMP GETFCD +FILERR, JMS I (RLERR + FILMSG + JMP GETFCD + +DIR, 0 + +NONAME, DCA FPTR + DCA FUNIT /ZERO BLOCK # AND LENGTH + JMP STDSRN /USE ENTIRE DEVICE AS FILE + +INTHND, STA + TAD I (OS8SWS+3 + AND (3 /ONLY USE LOW ORDER 2 BITS OF NUMBER + TAD (IHTBL + DCA HADR /SAVE PTR INTO TABLE OF INTL HANDLERS + TAD DSRNUM + CLL RTL + RAL + TAD DSRNUM /MULTIPLY DSRN NUMBER BY 9 + TAD (DSRN-11 /ADD TABLE BASE + DCA DSRNUM + TAD I HADR + CDF 0 + DCA I DSRNUM + ISZ DSRNUM + AC7776 + TAD CFLAG /DEPENDING ON THE C FLAG, + CIA + DCA I DSRNUM /DISABLE OR ENABLE FORMS CONTROL + JMP GETFIL+1 + PAGE + TSTSWS, 0 /ROUTINE TO TEST CD SWITCHES E AND H + TAD I (OS8SWS + AND (20 + CDF 0 + SNA CLA /TEST FOR /H SWITCH + JMP .+3 + TAD (HLT + DCA I (HLTNOP /SET TO HALT BEFORE STARTING PROGRAM + CDF 10 + TAD I (OS8SWS+1 + AND (4 + SNA CLA /TEST FOR /V SWITCH + JMP .+3 /NO + JMS I (RLERR /YES - PRINT VERSION NUMBER MESSAGE + XVERMS + TAD I (OS8SWS + AND (200 + CDF 0 + SZA CLA /TEST FOR /E SWITCH + ISZ I (ERRFLG /MAKE USER ERRORS NON-FATAL + CDF 10 /(USER ERROR = MISSING SUBROUTINE, ETC) + TAD I (OS8SWS+1 + AND (400 + CDF 0 + SNA CLA /TEST FOR /P SWITCH + JMP .+3 /NO, PRAISE BE! + TAD (SKP /GIVE THE DUMMY WHAT HE WANTS + DCA I (HLTNOP + CDF 10 + TAD I (OS8SWS + RTL + SMA CLA + AC0002 + DCA CFLAG /SAVE C FLAG IN PAGE0 + JMP I TSTSWS + +MOVEAE, 0 + TAD (EFFNOR /SUBSTITUTE A POINTER TO THE EAE NORMALIZE + CDF 0 /ROUTINE FOR THE POINTER TO THE NON-EAE + DCA I (NORMX /NORMALIZE ROUTINE + JMS I (MOVE + CDF 10 + FPPKG-1 /THE EAE PKG IS IN THE SAME PAGE IN FIELD 1 + CDF 0 + FPPKG-1 /AS THE NON-EAE PKG IN FIELD 0 + -600 + JMS I (MOVE + CDF 0 /SUBSTITUTE FAST FIX AND FLOAT + EFXFLT-1 + CDF 0 + EAEFIX-1 + -FXFLTC + JMP I MOVEAE + SPMDCD, 0 /SUBR TO DO A SPECIAL MODE COMMAND DECODE + JMS I (MOVE + CDF 10 + OS8DVT-1 + CDF 10 + DVTEMP-1 /MOVE OS/8 DEVICE HANDLER TABLE + -17 /SINCE C.D. CLEARS IT AND WE ARE USING IT + TAD I (HTOP /GET LOWEST HANDLER LOADED + RAL + SZL SPA CLA /DID WE LOAD ANY BELOW 02000? + JMP .+4 /NO + CDF 0 + ISZ I (OSJSWD /YES - MAKE CD CALLS DESTRUCTIVE + ISZ I (OSJSWD + CDF 10 + JMS I (200 + 5 /COMMAND DECODE + 5200 /SPECIAL MODE - WROUGHT WITH PERIL + 0 /DON'T CLEAR TENTATIVE FILES + JMS I (MOVE + CDF 10 + DVTEMP-1 + CDF 10 + OS8DVT-1 + -17 /MOVE DEVICE HANDLER TABLE BACK + JMS TSTSWS /CHECK FOR /E, /H, /P + JMP I SPMDCD + +IHTBL, PTR;PTP;LPT;TTY /INTERNAL HANDLER TABLE + PAGE + GETION, 0 + TAD (OS8DCB-1 + DCA GMADR + TAD I GMADR /GET DCB WORD + CLL RTR + RAR + AND (77 /INDEX INTO TABLE + TAD (IONTBL /WHICH INDICATES IF HANDLER CAN EXECUTE + DCA GMADR /WITH INTERRUPTS ON + TAD I GMADR /ION BIT INTO BIT 11, FORMS CONTROL INTO BIT 10 + JMP I GETION + +GBFLG, 0 + CDF 0 + TAD I (7777 /SPECIAL FLAGS LOC + CDF 10 + RTL + CLA RAL + JMP I GBFLG + +SVHND, 0 /ROUTINE TO SAVE HANDLER IN F1 + JMS GMADR /GET MOVE FROM ADDRESS + JMP I SVHND /NO HANDLER TO MOVE + DCA SVMOVE + JMS I (MOVE + CDF 0 +SVMOVE, 0 + CDF 10 + F0HSAV-1 + -400 + JMP I SVHND + +RSTHND, 0 /ROUTINE TO RESTORE HANDLER FROM F1 + JMS GMADR + JMP I RSTHND /HANDLER IS SYS: + DCA RSTMOV + JMS I (MOVE + CDF 10 + F0HSAV-1 + CDF 0 +RSTMOV, 0 + -400 + JMP I RSTHND + +GMADR, 0 + TAD HLDADR + SPA /CHECK THAT WE'RE NOT TRYING + JMP RESHND /TO SAVE A RESIDENT HANDLER - + AND RESHND /THAT COULD BE TRICKY + TAD (-1 /ECCH + ISZ GMADR + JMP I GMADR +RESHND, 7600 + JMP I GMADR + /RTS LOADER ERROR MESSAGE ROUTINE & MESSAGES + +RLERR, 0 /ERROR MESSAGES ARE IN FIELD 0 + CLA + CDF 10 + TAD I RLERR + CDF 0 + DCA RLTMP +RELP, TAD I RLTMP + RTR + RTR + RTR + AND (77 + JMS LTTY + TAD I RLTMP + AND (77 + JMS LTTY + ISZ RLTMP + JMP RELP +EOMSG, TAD (7515 + JMS LTTY + TAD (7512 + JMS LTTY + ISZ RLERR + CDF 10 + JMP I RLERR /SOME MESSAGES ARE NOT FATAL + +LTTY, 0 + SNA + JMP EOMSG + TAD (240 + SMA + AND (77 /CONVERT SIXBIT TO EIGHTBIT + TAD (240 + TLS + CLA + TSF + JMP .-1 + JMP I LTTY + /ROUTINE TO DETERMINE WHETHER WE ARE RUNNING IN THE +/BACKGROUND UNDER RTS-8, AND MODIFY THE RUN-TIME SYSTEM IF WE ARE. +/RUNS AT INITIALIZATION TIME, BEFORE LOWER FIELD 0 IS MOVED + +BAKTST, 0 + FPICL /FIRST INITIALIZE FPP (IF ANY) + FPCOM /INCLUDING CLEARING EXTENDED APT POINTER + TCF /TEST FOR RTS-8 BACKGROUND BY CLEARING THE + TSF /TTY FLAG AND THEN TESTING IT - IF IT IS + JMP I BAKTST /STILL SET, WE ARE RUNNING UNDER SRT-8. + CDF 0 /MODIFY LIST AND MODIFICATIONS ARE IN FIELD 0 +BAKLP, TAD I BKRPTR /GET POINTER TO BLOCK TO BE MODIFIED + SNA + JMP BAKRTN /ZERO - WE'RE DONE + DCA X0 /STORE IN AUTO-XR + ISZ BKRPTR +BAKWLP, TAD I BKRPTR /GET NEXT WORD TO STORE + ISZ BKRPTR + SNA + JMP BAKLP /ZERO MEANS END OF GROUP + DCA I X0 + JMP BAKWLP +BAKRTN, CDF 10 /RESET DATA FIELD TO 10 + DCA I (EAEKIL /EAE USES SGT WHICH IS NOT EMULATED, SO KILL IT + JMP I BAKTST /AND RETURN + +BKRPTR, BKRLST + PAGE + +F0TO= . + /FLOATING POINT PROCESSOR HANDLER + *FPPINT + +RETURN, JMP FPPRTN /MUST BE AT 0 IN PAGE + +FPGO, 0 /FPP STARTUP ROUTINE - MUST BE AT 1 IN PAGE + CDF 0 + DCA STEFLG + TAD PC + DCA FSAVPC /SAVE OLD PC FOR ONE LEVEL + TAD APT + DCA SAVAPT /OF RE-ENTRANTNESS + TAD I FPGO + DCA PC + TAD APT + AND (7770 + DCA APT /SET UP ADDRESS IN APT +FPREST, TAD (400 /ENABLE FPP INTERRUPTS + FPCOM /LOAD AND STORE ENTIRE APT + CLA /NECESSARY? + TAD STEFLG /0 OR 4000?(STARTF OR STARTE) + SZA + 6567 /A MNEMONIC? + CLA + TAD (APT + IOF + FPST /START UP FPP + JMP .-1 /I HAVE NO IDEA WHY IT DIDN'T START + CLA /NECESSARY? + JMS I (HANG /EXECUTE BACKGROUND + FPUHNG + FPRST /READ FPP STATUS + FPICL /RESET FPP + ION + RTL + SZL /TEST TRAP BIT + JMP TRAP /YUP - GO EXECUTE IT + AND (7400 + SZA /ANY ERRORS? + JMP FPPER + TAD FSAVPC + DCA PC /RESTORE OLD PC + TAD SAVAPT + DCA APT + ISZ FPGO + JMP I FPGO + /FLOATING POINT TRAP PROCESSOR + +TRAP, AC7775 + TAD PC + DCA PC /BACK UP PC TO BEFORE THE TRAP + SZL + STA + TAD APT /INCLUDING THE FIELD BITS + DCA APT + TAD APT /SET UP "FETPC" TO FETCH POSSIBLE TRAP ARGS + JMS I MCDF + DCA I (PCCDF + JMS I (FETPC + DCA T + TAD T /GET TRAP WORD + JMS I MCDF + IAC /MAKE A "CDF CIF N" + IAC + DCA TRPCIF + JMS I (FETPC + DCA ADR /STORE PDP8-CODE ROUTINE ADDRESS + TAD T +TRPCIF, HLT /SET DATA AND INSTRUCTION FIELDS + SMA CLA /TRAP3 OR TRAP4? + JMP I ADR /TRAP3 - GO TO ADR + JMS I ADR /TRAP4 - CALL ADR +FPPRTN, DCA STEFLG + ISZ PC /RESTORE PC FROM BEFORE TRAP + SKP + ISZ APT /INCLUDING FIELD + CDF 0 + JMP FPREST /RESTART FPP + +FPPER, SPA + JMP I (FPPERR /FPHALT - FATAL ERROR + RTL + ISZ FATAL /DIVIDE BY 0 AND OVERFLOW ARE NON-FATAL + SZL + JMP FPDVER +FPOVER, JMS I ERR + SKP +FPDVER, JMS I ERR + TAD . /I ALWAYS WANTED TO INCLUDE ONE OF THESE! + DCA ACX + AC2000 + DCA ACH + JMP FPREST + +FSAVPC, 0 +SAVAPT, 0 +STEFLG, 0 + /RANDOM FPP CODE FOR D.P. I/O +DFSTM2, FSTA+LONG + DFTMP2 + FEXIT + + PAGE + /THIS IS DOUBLE PRECISION FORMATTED OUTPUT. +/ITS A LOT LIKE SINGLE PRECISION,WITHOUT ALL THE G + I STUFF +/AND, OH JOY!, NO PAGE 0 LITERALS. +DNXT, TAD RWFLAG /READ OR WRITE? + SMA CLA + AC4000 /ITS INPUT SO LEAVE IN STARTE MODE + JMS I (GETLMN + JMP .+3 +DFMT, STA +BFMT, DCA EFLG + TAD D + DCA OD /SAVE COUNT OF DIGITS AFTER DEC PT + TAD PFACT + DCA PFACTX + DCA SCALE + JMS I (SKPOUT /DONE? + JMP I (DPIN /ITS INPUT + STA /ITS OUTPUT + DCA I (FFNEG /USE THIS LOCN AS SIGN FLAG + TAD EFLG + CLL RAL + CLL RAL + TAD W /GIVE ROOM FOR EXP FIELD (IF ANY) + CLL /NECESSARY? + DCA I (OW + TAD ACH + SNA + JMP SKPZRO /IF AC 0,SKIP ALOT OF THIS + SMA CLA + JMP DSCLUP + JMS I (DFNEG /AC<0-NEGATE IT + DCA I (FFNEG / 0 <> 7777 +DSCLUP, DCA SCALE + TAD ACX + SMA SZA CLA /AC<1.0? + JMP DGT1 /NO + AC4000 /STARTE + JMS I (FPGO /Y-MULT BY 10. + FMUL10 + STA + TAD SCALE /BUMP POWER OF TEN + JMP DSCLUP +DGT1, JMS I (DSCLDN /NUMBER IS >=1.;NOW DECREASE IT TO (0,1) + AC4000 + JMS I (FPGO /SAVE IT + FSTTMP + TAD (22 + JMS I (OSCALE + AC4000 + JMS I (FPGO + FADTMP + JMS I (DSCLDN + SKPZRO, JMS I (DIGCNT /NO NEED FOR ALL THE G STUFF TO BE + /INCLUDED IN THE SINGLE PREC ROUTINE + /MAKE NOTG ROUTINE A SUBROUTINE + SMA /EQUIV TO OUTNUM IN SINGLE PREC + JMP DASTRS + JMS I (OBLNKS + AC7775 + ISZ I (FFNEG /IF SIGN IS NEG, + JMS I (DIGIT /PRINT A MINUS + CLA + TAD ACX + SNA /ALIGN FAC MANTISSA INTO A + JMS I (DAL1 /FRACTION (.1,1) + IAC + SPA + JMS I (DACSR + CLA + TAD EAC3 + DCA AC1 /MOVE FAC DOWN SO OVERFLOW FROM + TAD EAC2 /MULT BY 10 IN HIGH ORDER WORD + DCA EAC3 + TAD EAC1 + DCA EAC2 + TAD ACL + DCA EAC1 + TAD ACH + DCA ACL + TAD SCALE + SPA SNA /ANY DIGITS TO LEFT OF DEC PT? + JMP I (DPRZRO /N-PRINT A 0 +/JUST AS CHEAP TO DUPLICATE CODE + JMS I (DBLDIG /Y- PRINT THEM + DRDCPT, AC7776 + JMS I (DIGIT /PRINT A DEC PT + TAD SCALE + SMA CLA /NEED LEADING ZEROS? + JMP DNOLZR /NO + TAD SCALE + DCA T +DLZERO, STA CLL + TAD OD /DECREASE D VALUE + SNL + JMP DNOMAC /NO MORE FIELD WIDTH AVAILABLE + DCA OD + JMS I (DIGIT /PRINT A 0 + ISZ T /CONT UNTIL COUNT OR WIDTH RUNS OUT + JMP DLZERO +DNOLZR, TAD OD + SZA + JMS I (DBLDIG /PRINT REMAINING DIGITS +DNOMAC, CLA + TAD EFLG + SZA /IF EFLG IS NOT ZERO IT IS -1, + JMS I (EXPFLD /SO WE WILL PRINT A D INSTEAD OF AN E + JMP I (DNXT + +DASTRS, CLA + TAD W + JMS I (ASTRSK + JMP I (DNXT + PAGE + DBLDIG, 0 /OUTPUT DIGITS + CIA + DCA T +DBDLOP, DCA ACH /0 THE HI WORD FOR OVERFLO + TAD AC1 + DCA AC2 /START TO COPY THE FAC.THIS IS + TAD ACL /EAC3 SHIFTED DOWN 1 WORD + DCA OPL + TAD EAC1 + DCA L1 /ACL + TAD EAC2 + DCA DACSR /EAC1 + TAD EAC3 + DCA DSCLDN /EAC2 + JMS DAL1 + JMS DAL1 + CLL + TAD AC2 + TAD AC1 + DCA AC1 /THIS IS FAC*5 COMING UP + RAL + TAD DSCLDN + TAD EAC3 + DCA EAC3 + RAL + TAD DACSR + TAD EAC2 + DCA EAC2 + RAL + TAD L1 + TAD EAC1 + DCA EAC1 + RAL + TAD OPL + TAD ACL + DCA ACL + RAL + TAD ACH + DCA ACH + JMS DAL1 + TAD ACH + JMS I (DIGIT + ISZ T + JMP DBDLOP + JMP I DBLDIG + DSCLDN, 0 /USED AS A TEMP TOO + TAD ACX + SPA SNA CLA + JMP I DSCLDN /DONE IF FAC<1. + AC4000 + JMS I (FPGO + FDIV10 + ISZ SCALE + 0 /A FREE LOCN! + JMP DSCLDN+1 + +DPRZRO, CLA + JMS I (DIGIT + JMP I (DRDCPT +/6 WORD FAC LEFT SHIFT +DAL1, 0 + TAD AC1 /GET OVERFLO BIT + CLL RAL /SHIFT LEFT + DCA AC1 + TAD EAC3 /CONTINUE WORKING WAY UP THRU MANTISSA + RAL + DCA EAC3 + TAD EAC2 + RAL + DCA EAC2 + TAD EAC1 + RAL + DCA EAC1 + TAD ACL + RAL + DCA ACL + TAD ACH + RAL + DCA ACH + JMP I DAL1 + +DFLTM2, FLDA+LONG + DFTMP2 + FEXIT +DFTMP2, 0;0;0;0;0;0 + /6 WORD FAC RIGHT SHIFT. ENTER WITH COUNT-1 IN AC +/ +DACSR, 0 /USED AS A TEMP BY DBDLOP + DCA AC0 /STORE COUNT +DLOP1, TAD ACH + CLL + SPA /PROPOGATE SIGN + CML + RAR + DCA ACH /SHIFT RIGHT 1,PROPOGATE SIGN + TAD ACL /DO SHIFTING FOR EACH WORD OF MANTISSA + RAR + DCA ACL + TAD EAC1 + RAR + DCA EAC1 + TAD EAC2 + RAR + DCA EAC2 + TAD EAC3 + RAR + DCA EAC3 + ISZ ACX /INCREMENT EXPONENT + NOP + ISZ AC0 /DONE? + JMP DLOP1 /NOPE + RAR /YUP + DCA AC1 /SAVE 1 BIT OF OVERFLOW + JMP I DACSR +L1, 0 + PAGE + /THIS IS DOUBLE PRECISION INPUT (WITH FPP ONLY) +/IT IS A LOT LIKE SINGLE PRECISION INPUT, BUT USES +/ITS OWN FPP ROUTINES. +DPIN, STA + DCA DDPSW /INITIALIZE DEC. PT. SWITCH + STA + DCA DINESW /AND EXPONENT SWITCH + TAD W + CMA + DCA FMTNUM /CHAR COUNT +DINESM, DCA ACX /CLEAR FLOATING AC + DCA ACH + DCA ACL + DCA EAC1 + DCA EAC2 + DCA EAC3 + STA +DINMIN, DCA DFNEG +DINLOP, ISZ FMTNUM + JMP DINGCH /LOOP UNTIL WIDTH EXHAUSTED +DINENM, ISZ I (DFNEG /IS SIGN NEGATIVE? + JMS I (DFNEG /YES-NEGATE + ISZ DINESW /SEEN A D YET? + JMP DFIXUP /YES-THIS IS EXP,NOT NUMBER + TAD PFACTX /NO D- SCALE WITH P FACTOR +DSCLIN, TAD OD /GET SCALING FACTOR + STL + SNA + JMP I (DNXT /NO SCALING NEEDED + SMA + CIA CLL /AC CONTAINS MAGNITUDE,LINK CONTAINS SIGN + DCA OD + RTL + RAL + TAD (FDIV10 + DCA DIGFOP + AC4000 + JMS I (FPGO /MULT OR DIVIDE BY 10 +DIGFOP, 0 + ISZ OD + JMP DIGFOP-2 /MULT OR DIV CORRECT NUMBER OF TIMES + JMP I (DNXT /GET MORE +DIND, ISZ DINESW /IS THERE A 2ND D? + JMP DINER /Y-A NO-NO + ISZ DDPSW /FORCE DEC. PT. SWITCH ON + TAD OD /USE SCALE FACTOR IF SEEN DEC. PT + DCA SCALE /SAVE SCALE FACTOR + ISZ DFNEG + JMS DFNEG /GET SIGN OF NUMBER + AC4000 + JMS I (FPGO /SAVE IT TEMPORARILY + DFSTM2 + JMP DINESM /GO COLLECT EXP + DFIXUP, JMS I (FFIX /IS THIS OK FOR DBL PREC??? + TAD ACI + CIA + TAD SCALE /ADD EXP TO DEC PT SCALE FACTOR + DCA OD + AC4000 + JMS I (FPGO + DFLTM2 /GET NUMBER BACK IN FAC + JMP DSCLIN +DINGCH, JMS I (FMTIN /GET A CHAR + JMS I (CHTYPE /CLASSIFY IT + 1234; DDIGIT + -56; DIDCPT /. + -53; DINLOP /+ + -55; DINMIN /- + -4; DIND /D + -5; DIND /E - BE FORGIVING + -40; DINLOP /BLANK + -54; DINENM /, + 0 +DINER, JMP I (INER + +DIDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER DEC PT + ISZ DDPSW /TEST + SET DEC PT SWITCH + JMP DINER /2 DEC. PT. IS NO GOOD + JMP DINLOP +DDIGIT, TAD CHCH + DCA I (DGT+1 /SAVE DIGIT + AC4000 + JMS I (FPGO + ACMDGT + TAD DDPSW + SNA CLA + ISZ OD /BUMP DIGIT IF DEC PT SEEN + JMP DINLOP +DDPSW, 0 + /6 WORD FLOATING NEGATE + +DFNEG, 0 + TAD EAC3 + CLL CMA IAC /NEGATE LOW ORDER WORD OF MANTISSA + DCA EAC3 /STORE IT BACK + CML RAL /ADJUST OVERFLOW+CARRY + TAD EAC2 /CONTINUE WITH REST OF MANTISSA + CMA IAC + DCA EAC2 + CML RAL + TAD EAC1 + CMA IAC + DCA EAC1 + CML RAL + TAD ACL + CMA IAC + DCA ACL + CML RAL + TAD ACH + CLL CMA IAC + DCA ACH + JMP I DFNEG +DINESW, 0 + PAGE + *FPPKG /EAE PKG LOADS OVER REGULAR PKG + +LPBUF2, ZBLOCK 16 + LPBUF5 + +AL1BMP, 0 /*K* MUST BE AT SAME LOC AS NON-EAE VERSION + STA + TAD ACX + DCA ACX + JMS I (AL1 + JMP I AL1BMP + +/EAE FLOATING POINT INTERPRETER +/FOR PDP8/E WITH KE8-E EAE + +/W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN + +/FLOATING MULTIPLY--DOES 4 SINGLE MULTIPLIES WITH EAE +/THIS USES THE FACT THAT IF AC IS NON-ZERO WHEN YOU DO +/A MUY INSTR, THE AC IS ADDED TO RESULT OF THE MULTIPLY. +/(IN THE LOW ORDER, NATCHERLY) + +DDMPY, JMS I (DARGET + SKP +FFMPY, JMS I (ARGET + JMS EMDSET /SET UP FOR MULT + CLA MUY /MULTIPLY-LOW ORDER FAC STILL IN MQ + OPH /THIS IS PRODUCT OF LOW ORDERS + MQL /ZAP LOW ORDER RESULT-INSIGNIFICANT + TAD ACH /GET LOW ORDER(!) OF FAC + SWP MUY /TO MQ-HIGH ORD. RESLT OF LAST MPY + OPL /TO AC-WILL BE ADDED TO RESLT-THIS + DST /IS PRODUCT-LOW ORD FAC,HI ORD OP + AC0 /STORE RESULT + CLA + TAD ACL /HIGH ORDER FAC TO MQ + MQL + TAD OPX /GET OPERAND EXPONENT + TAD ACX /ADD FAC EXPONENT-GET SUM OF EXPS. + DCA ACX /STORE RESULT + MUY /MUL. HIGH ORDER FAC BY LOW ORD OP. + OPH /HIGH ORDER FAC WAS IN MQ + DAD /ADD IN RESULT OF SECOND MULTIPLY + AC0 + DCA ACH /STORE HIGH ORDER RESULT + TAD ACL /GET HIGH ORDER FAC + SWP /SEND IT TO MQ AND LOW ORD. RESULT + DCA AC0 /OF ADD TO AC-STORE IT + RAL /ROTATE CARRY TO AC + DCA ACL /STORE AWAY + MUY /NOW DO PRODUCT OF HIGH ORDERS + OPL /FAC HIGH IN MQ, OP HIGH IN OPL + DAD /ADD IN THE ACCUMULATED # + ACH + /MULTIPLIES DONE - MASSAGE RESULT + + SNA /ZERO? + JMP RTZRO /YES-GO ZERO EXPONENT + NMI /NO-NORMALIZE (1 SHIFT AT MOST!) + DCA ACH /STORE HIGH ORDER RESULT + CLA SCA /GET STEP CNTR-DID WE NEED A SHIFT? + SNA CLA + JMP SNCK /NO-JUST CHECK SIGN + TAD AC0 /YES - WATCH OUT FOR LOST ACCURACY! + RAL + DCA AC0 + SZL /IF HIGH ORDER BIT OF OVERFLOW WORD WAS ON, + DPIC /TURN MQ11 ON (IT WAS 0 FROM THE NMI) + CLA CMA /MUST DECREASE EXP. BY 1 + TAD ACX +RTZRO, DCA ACX /STORE BACK +SNCK, TAD AC0 + SPA CLA /IS HIGH ORDER OF OVERFLO WD. 1? + DPIC /YES-ADD 1 TO LOW ORDER-STILL IN MQ + TAD ACH + SMA + JMP EMDONE /WE DIDN'T OVERROUND - GOODY + LSR + 1 /BUT OVERROUNDING IS EASILY CORRECTED! + ISZ ACX / (OVERCORRECTED??) + NOP + +/COMMON CLEANUP ROUTINE FOR MULTIPLY AND DIVIDE + +EMDONE, ISZ EMSIGN /SHOULD SIGN BE MINUS? + SKP /NO + DCM /YES-DO IT + SNA + DCA ACX /FORCE EXPONENT 0 IF MANTISSA = 0 + DCA ACH /STORE IT BACK + SWP + DCA ACL + TAD DFLG + SMA SZA CLA + TAD ACX /IF D.P. INTEGER MODE AND ACX LESS THAN 0, + SNA /GO TO UNNORMALIZE RESULT + JMP I FPNXT /OTHERWISE BUMP RETN. AND RETN. + CMA + JMS I (ACSR + JMP I FPNXT +EMSIGN, 0 + /ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE + +EMDSET, 0 + CLA CLL CMA RAL /MAKE A MINUS TWO + DCA EMSIGN /AND STORE IN EMSIGN. + DLD /GET HIGH ORDER MANTISSA OF OP. + OPH + SWP + SMA /NEGATIVE? + JMP .+3 /NO + DCM /YES-NEGATE IT + ISZ EMSIGN /BUMP SIGN COUNTER + SHL /SHIFT OPRND LEFT 1 TO AVOID OVRFLO + 1 + DST /STORE BACK-OPH CONTAINS LOW ORDER + OPH / OPL CONTAINS HIGH ORDER + DLD + ACH + SWP + SMA /FAC LESS THAN 0? + JMP .+4 /NO + DCM + ISZ EMSIGN + NOP /EMSIGN MAY BUMP TO 0 + DST /STORE BACK - ACH CONTAINS LOW ORDER + ACH / ACL CONTAINS HIGH ORDER + JMP I EMDSET + PAGE + /FLOATING DIVIDE-BY-0 ROUTINE - MUST BE AT 0 IN PAGE + +DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL + JMS I ERR + TAD DBAD + DCA ACX /SET AC TO A LARGE POSITIVE NUMBER + AC2000 + JMP I (EMDONE + +/FLOATING DIVIDE + +DDDIV, JMS I (DARGET + SKP +FFDIV, JMS I (ARGET + JMS I (EMDSET /GET ARG. AND SET UP SIGNS + DVI /DIVIDE-ACH AND ACL IN AC,MQ + OPL /THIS IS HI (!) ORDER DIVISOR + DST /QUOT TO AC0,REM TO AC1 + AC0 + SZL CLA /DIVIDE ERROR? + JMP DBAD /YES - HANDLE IT + TAD OPX /DO EXPONENT CALCULATION + CMA IAC /EXP. OF FAC - EXP. OF OP + TAD ACX + DCA ACX + DPSZ /IS QUOT = 0? + SKP /NO-GO ON + DCA ACX /YES-ZERO EXPONENT +DVLP, MUY /NO-THIS IS Q*OPL*2**-12 + OPH + DCM /NEGATE IT + TAD AC1 /SEE IF GREATER THAN REMAINDER + SNL + JMP EDVOPS /YES-ADJUST FIRST DIVIDE + DVI /NO-DO Q*OPL*2**-12/OPH + OPL + SZL CLA /DIV ERROR? + JMP DBAD /YES +EDVLP1, TAD AC0 /NO-GET QUOT OF FIRST DIV. + SMA /NEGATIVE? + JMP I (EMDONE /NO-REMEMBER-QUOT OF 2ND DIV. IN MQ + LSR /YES-MUST SHIFT IT RIGHT 1 + 1 + ISZ ACX /ADJUST EXPONENT + NOP + SGT /TEST SHIFTED OUT BIT + JMP I (EMDONE /ZERO - NO ROUND + DPIC /BUMP AC FRACTION + JMP EDVLP1+1 /MAYBE SHIFT AGAIN + /CONTINUATION OF DIVIDE ROUTINE +/WE ARE ADJUSTING THE RESULT OF THE +/FIRST DIVIDE. + +EDVOPS, CMA IAC + DCA AC1 /ADJUST REMAINDER + TAD OPL /WATCH FOR OVERFLOW + CLL CMA IAC + TAD AC1 + SNL + JMP EDVOP1 /DON'T ADJUST QUOT. + DCA AC1 + CMA + TAD AC0 + DCA AC0 /REDUCE QUOT BY 1 +EDVOP1, CLA CLL + TAD AC1 /GET REMAINDER + SNA /ZERO? + CAM /YES-ZERO EVERYTHING + DVI /NO + OPL + SZL CLA /DIV. OVERFLOW? + JMP DBAD /YES + DCM /NO-ADJUST HI QUOT (MAYBE) + JMP EDVLP1 /GO BACK + +/ROUTINE TO NORMALIZE THE FAC + +EFFNOR, 0 + CDF 0 + DLD /PICK UP MANTISSA + ACH + SWP /PUT IT IN CORRECT ORDER + NMI /NORMALIZE IT + SNA /IS THE # ZERO? + DCA ACX /YES-INSURE ZERO EXPONENT + DCA ACH /STORE HIGH ORDER BACK + SWP /STORE LOW ORDER BACK + DCA ACL + CLA SCA /STEP COUNTER TO AC + CMA IAC /NEGATE IT + TAD ACX /AND ADJUST EXPONENT + DCA ACX + JMP I EFFNOR /RETURN + +ADDRS, OPH + ACH + +LPBUF5, ZBLOCK 50 + LPBUF7 + PAGE + /"OPNEG" MUST BE AT 0 IN PAGE + +OPNEG, 0 /ROUTINE TO NEGATE OPERAND + DLD + OPH + SWP + DCM + DCA OPH + MQA + DCA OPL + JMP I OPNEG + +/FLOATING ADD AND SUBTRACT-IN ORDER NOT TO LOSE BITS, +/WE DO NOT SHIFT BOTH NUMBERS RIGHT 1 BIT BEFORE ADD- +/ONLY SHIFTS DONE ARE TO ALIGN EXPONENTS. + +FFSUB, JMS I (ARGET + JMS OPNEG /NEGATE OPERAND + SKP +FFADD, JMS I (ARGET /PICK UP ARGUMENTS + TAD OPH + SNA CLA /IF OPERAND IS 0, + JMP I FPNXT /RESULT IS ALREADY IN AC. + TAD ACH + SZA CLA /CHECK FOR AC=0 + JMP BOTHN0 /NO + DLD + OPH /YES - ANSWER IS OPERAND + SWP + DCA ACH + JMP FADND /JUMP INTO CLEANUP CODE +BOTHN0, TAD OPX /PICK UP EXPONENT OF OPERAND + MQL /SEND IT TO MQ FOR SUBTRACT + TAD ACX /GET EXPONENT OF FAC + SAM /SUBTRACT-RESULT IN AC + SPA /NEGATIVE RESULT? + CMA IAC /YES-MAKE IT POSITIVE + DCA CNT /STORE IT AS A SHIFT COUNT + TAD CNT /COUNT TOO BIG?(CAN'T BE ALIGNED) + TAD (-27 + SPA SNA CLA + CMA /NO-OK + DCA AC0 /YES-MAKE IT A LOAD OF LARGEST # + DLD /GET ADDRESSES TO SEE WHO'S SHIFTED + ADDRS + SGT /WHICH EXP GREATER(GT FLG SET + /BY SUBTR. OF EXPS.) + SWP /OPERAND'S-SHIFT THE FAC + DCA SHFBG /STORE ADDRESS OF WHO GETS SHIFTED + SWP /GET ADDRESS OF OTHER (0 TO MQ) + DCA DADR /THIS ONE JUST GETS ADDED + TAD ACX /GET FAC EXP.INTO AC + SGT /WHICH EXPONENT WAS GREATER? + DCA OPX /FAC'S-STORE FINAL EXP. IN OPX + DLD /GET THE LARGER # TO AC,MQ +DADR, 0 + SWP /PUT IN THE RIGHT ORDER + ISZ AC0 /COULD EXPONENTS BE ALIGNED? + JMP LOD /NO-JUST LEAVE LARGER IN AC,MQ + DST /YES-STORE THIS TEMPORARILY + AC0 /(IF ONLY FAC STORAGE WAS REVERSED) + DLD /GET THE SMALLER # +SHFBG, 0 + SWP /PUT IT IN RIGHT ORDER + ASR /DO THE ALIGNMENT SHIFT +CNT, 0 + DAD /ADD THE LARGER # + AC0 + DST /STORE RESULT + AC0 + SZL /OVERFLOW?(L NOT = SIGN BIT) + CMA /NOTE-WE DIDN'T SHIFT BOTH RIGHT 1 + SMA CLA + JMP NOOV /NOPE + CLA CLL CML RAR /MAYBE-SEE IF 2 #S HAD SAME SIGN + AND ACH + TAD OPH + SMA CLA /SIGNS ALIKE? + JMP OVRFLO /YES-OVERFLOW +NOOV, AC4000 /NO-GET HIGH ORDER RESULT BACK + TAD AC1 /CHECK FOR 4000 0000 MANTISSA + DPSZ /IT WILL BE SET TO 0 BY NMI + JMP .+3 /OK-RESTORE NUMBER + AC2000 /GOT A 4000 0000-SET TO 6000 0000 + JMP DOIT /AND INCREMENT EXPONENT + TAD (4000 /RESTORE NUMBER +LOD, NMI /NORMALIZE (LOW ORDER STILL IN MQ) + DCA ACH /STORE FINAL RESULT + SCA /GET SHIFT COUNTER(# OF NMI SHIFTS) + CMA /NEGATE IT +ADON, IAC +FADND, TAD OPX /AND ADJUST FINAL EXPONENT + DCA ACX + SWP /GET AND STORE LOW ORDER + DCA ACL + JMP I FPNXT /RETURN +OVRFLO, TAD AC1 /OVERFLOW-GET HIGH ORDER RESLT BACK + ASR /SHIFT IT RIGHT 1 + 1 +DOIT, TAD (4000 /REVERSE SIGN BIT + DCA ACH /AND STORE + JMP ADON /DONE + +LPBUF7, ZBLOCK 34 + LPBUFE + PAGE + *7400 /RTS CLEANUP ROUTINE - SAVED WITH PG 17600 + +CLNUP, DCA I CFPTR /ENTER HERE ON ^C OR ERROR +TDEXFG, JMP CTMP /ENTER HERE ON "STOP" OR "CALL EXIT" + TAD TDEXFG /TDEXFG CONTAINS TOP MEM FIELD + CLL RTL /IF WE ARE ON AN IN-CORE TD8E CONFIGURATION + RAL + TAD (CDF + DCA TDGTDF +TDGTDF, HLT + TAD I TDPTR /MOVE THE TD8E ROUTINE + CDF 20 + DCA I TDPTR /DOWN TO FIELD 2 + ISZ TDPTR + JMP TDGTDF + CDF 0 + TAD (CIF 20 + JMS TDSET /RESET THE F0 CDF'S TO POINT TO FIELD 2 +CTMP, CDF 0 + TAD (6213 + DCA I (7605 + TAD (5267 + DCA I (7606 /RESTORE PAGE 7600 + AC7776 + AND I (OSJSWD + IAC + DCA I (OSJSWD /MARK 10000-11777 AS USELESS + AND I 0 + AND I 0 /DELAY A WHILE IN CASE ITS AN LA30 + AND I 0 + AND I 0 + AND I 0 + TSF + SKP + JMP WTOVR + ISZ ZERO + TAD I (TOCHR /IF TTY IS NOT IDLE, + SZA CLA /DELAY LONG ENOUGH TO AVOID GARBLE. + JMP CTMP +WTOVR, TAD I (7777 + CLL RAL + SMA CLA /IS BATCH EXECUTING? + JMP NOBTCH /NO - RELAX + TAD (212 /TO PREVENT OVERPRINTING, POP UP A LINE + TLS /ON THE TELETYPE + LLS /AND ON THE LINE PRINTER + TSF + JMP .-1 /WAIT FOR THE SLOWER ONE (I HOPE) + CLA + NOBTCH, CDF 10 +CLOSLP, TAD I CFPTR + SNA /ANY MORE ENTRIES IN THE TENTATIVE + JMP GOAWAY /FILE TABLE? + DCA CTMP /YES - SAVE FILE LENGTH PTR + CDF 0 + TAD I CTMP + CDF 10 + SNA + JMP IGNORC /UNWRITTEN FILES AREN'T CLOSED + DCA FLEN + JMS I USR + 10 /BRING USR IN + TAD (200 + DCA USR /KEEP IT IN + TAD (HPLACE+1 + DCA CHAND + JMS I USR + 13 /RESET DEVICE HANDLER TABLE + 0 /BUT NOT TENTATIVE FILES! + ISZ CFPTR + TAD I CFPTR /GET UNIT NUMBER + JMS I USR + 1 +CHAND, 0 /FETCH HANDLER + JMP CLSERR + TAD I CFPTR /GET UNIT AGAIN + ISZ CFPTR /BUMP PTR TO NAME + JMS I USR +C4, 4 +CFPTR, 7600 /CLOSE THE FILE +FLEN, 0 + JMP CLSERR + SKP +IGNORC, AC0002 + TAD CFPTR + TAD C4 + DCA CFPTR + JMP CLOSLP /LOOK FOR MORE + +TDSET, 0 + DCA I (7721 + TAD I (7721 + DCA I (7727 + TAD I (7721 + IAC + DCA I (7642 + JMP I TDSET + GOAWAY, CDF CIF 0 + JMP I (7605 /RETURN TO OS/8 AQAP +CLSERR, JMS I USR /"IMPOSSIBLE" ERROR - GIVE "USER ERROR 2" + 7 + 2 /IT'S BETTER THAN HALTING + +TDPTR, 7600 +ZERO, 0 +USR, 7700 + $$$-$$$-$$$ + diff --git a/sw/f4/FRTSRC/rts.pa b/sw/f4/FRTSRC/rts.pa new file mode 100644 index 0000000..7fd43cf --- /dev/null +++ b/sw/f4/FRTSRC/rts.pa @@ -0,0 +1,3789 @@ +/FORTRAN IV RUNTIME SYSTEM, V5A +/ +/ +/ +/ +/ +/ +/ +// +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1975 +/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. +/ +/ +/ +/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A +/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- +/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER +/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE +/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO +/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE +/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. +/ +/ +/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT +/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL +/EQUIPMRNT COROPATION. +/ +/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS +/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. +/ +/ +/ +/ +/ +/ + /FORTRAN 4 RUNTIME SYSTEM - R.LARY +/AND NOW WITH DOUBLE PRECISION! - MKH +/RTS-8 SUPPORT ADDED 5/20/74 - RL +/LAST EDITED 5/19/74 + +XVERSN=5 /UPDATE WITH EVERY RELEASE! +XPATCH="A /PATCH LEVEL A + +/NOTES TO MAINTAINERS: + +/THIS PROGRAM IS DESIGNED TO SUPPORT MANY DIFFERENT HARDWARE +/CONFIGURATIONS IN A MINIMAL AMOUNT OF SPACE. IT ACHIEVES THIS GOAL +/BY "TAILORING" ITSELF AT INITIALIZATION TIME +/BASED ON A SURVEY OF ITS HARDWARE/SOFTWARE ENVIRONMENT. THIS MAKES +/THIS PROGRAM DIFFICULT TO MODIFY UNLESS THE MODIFYING PROGRAMMER +/KNOWS WHAT IS GOING ON. IT IS THEREFORE SUGGESTED THAT YOU READ THIS +/LISTING THOROUGHLY AND UNDERSTAND THE MAJOR ROUTINES BEFORE +/MAKING EVEN "TRIVIAL" CHANGES. + +/ALL SYMBOLS BEGINNING WITH THE LETTER "Q" ARE ENTRIES IN THE +/HEADER BLOCK OF THE LOADER-IMAGE (.LD) FILE. + +/ALL SYMBOLS BEGINNING WITH THE LETTER "Y" DENOTE THE BEGINNING OF +/A BLOCK OF CODE WHICH WILL BE REPLACED BY DIFFERENT CODE IF FRTS +/IS RUNNING IN THE BACKGROUND UNDER RTS-8. THE REPLACEMENT CODE +/CAN BE FOUND IN THE TABLE "BKRLST". + +/ALL SYMBOLS BEGINNING WITH THE LETTER "V" ARE DEFINED IN THE LOADER +/SYMBOL TABLE AND CANNOT BE MOVED WITHOUT CHANGING THE LOADER. ONLY +/A VERY FEW OF THESE SYMBOLS OCCUR IN PLACES OTHER THAN +/PAGE 200 OR THE FIRST LOCATION OF OTHER PAGES. + +/CODE WHICH CONTAINS THE CHARACTER SEQUENCE "*K*" IN THE COMMENT FIELD +/IS PARTICULARLY SUBTLE/OBSCURE (THE "K" IS FOR "KLUDGE"). THE REST OF THE +/COMMENT SHOULD INDICATE WHAT IS GOING ON. +/ +/ +/ FIXES FOR V4 J.K. 1975 +/ +/ .SCALE FACTOR PRINTED BY P FORMAT OPERATOR +/ .FRTS /P +/ .RK8E HANDLER TO RUN WITH INTERRUPTS ON +/ .SLASH AT END OF FORMAT STATEMENT +/ +/ +/ CHANGES FOR OS/78 AND OS/8 V3D BY P.T. +/ .CHANGED THE VERSION NUMBER TO 5A +/ .FIXED THE FIELD OVERFLOW PROBLEM +/ .FIXED THE "K=K+1" PROBLEM + /DEFINITIONS: + +AC7775= STA CLL RTL +AC7776= STA CLL RAL +AC4000= CLA STL RAR +AC3777= STA CLL RAR +AC2000= CLA STL RTR +AC0002= CLA STL RTL + +/DEFINITIONS OF KE-8/E INSTRUCTIONS + +MQL= 7421 +MQA= 7501 +CAM= CLA MQL +SWP= MQA MQL +SWAB= 7431 +SCA= 7441 +MUY= 7405 +DVI= 7407 +NMI= 7411 +SHL= 7413 +ASR= 7415 +LSR= 7417 +ACS= 7403 +SAM= 7457 +DAD= 7443 +DLD= 7663 +DST= 7445 +DPIC= 7573 +DCM= 7575 +DPSZ= 7451 +SGT= 6006 + +/DEFINITIONS OF FPP IOT'S + +FPINT= 6551 +FPICL= 6552 +FPCOM= 6553 +FPHLT= 6554 +FPST= 6555 +FPRST= 6556 + /FPP OPCODES: + +FLDA= 0000 +FADD= 1000 +FSUB= 2000 +FDIV= 3000 +FMUL= 4000 +FADDM= 5000 +FSTA= 6000 +FMULM= 7000 + LONG= 400 /TWO-WORD ADDRESSING + BASE= 200 /BASEPAGE ADDRESSING + IND= 600 /INDIRECT ADDRESSING + +FEXIT= 0000 +FNORM= 0004 +STARTF= 0005 +STARTD= 0006 +JAC= 0007 +XTA= 0030 +STARTE= 0050 +LDX= 0100 + +JA= 1030 +JNE= 1040 +TRAP3= 3000 + +/OS8 EQUIVALENCES: + +OS8SWS= 7643 +OSJSWD= 7746 +OS8DVT= 7647 +OS8DCB= 7760 +OS8DAT= 7666 + +/VARIOUS OTHER IOT'S: + +LSF= 6661 +LCF= 6662 +LSE= 6663 +LIE= 6665 +LLS= 6666 +LIF= 6667 + /PAGE ZERO FOR FORTRAN IV RTS + + *0 /INTERRUPT STUFF + 0 + JMP I .+1 + INTRPT +LPGET, LPBUFR /LINE PRINTER RING BUFFER FETCH POINTER +TOCHR, 0 /TELETYPE STATUS WORD +KBDCHR, 0 /KEYBOARD INPUT CHARACTER +POCHR, 0 /P.T. PUNCH COMPLETION FLAG +RDRCHR, 0 /P.T. READER STATUS +FMTPXR, 0 /XR USED TO INDEX FORMAT PARENTHESIS ARRAY +INXR, INBUFR-1 /XR USED TO GET CHARS FROM INPUT LINE +XR, 0 +XR1, 0 + +*16 +VEOFSW, 0 /USED BY "EOFCHK" TO STORE VARIABLE ADDRESS + 0 /*K* MUST BE IN AUTO - XR +T, 0 /TEMPORARY +DFLG, 0 /0 = F.P., 1 = D.P. +INST, 0 /CURRENT INSTRUCTION WORD + +/IOH PAGE ZERO LOCATIONS + +RWFLAG, 0 /READ/WRITE FLAG +FMTTYP, 0 /TYPE OF CONVERSION BEING DONE +EOLSW, 0 /EOL SW ON INPUT - CHAR POS ON OUTPUT +N, 0 /REPEAT FACTOR +W, 0 /FIELD WIDTH +D, 0 /NUMBER OF PLACES AFTER DECIMAL POINT + +DATCDF, 0 /SUBROUTINE TO CHANGE DATA FIELD +DATAF, 0 /CONTAINS VARIOUS CDF'S + JMP I DATCDF /RETURN + +ERR, ERROR /POINTER TO ERROR ROUTINE +FATAL, 0 /FATAL ERROR FLAG - 0=FATAL +MCDF, MAKCDF + +/FPP PARAMETER TABLE LOCATIONS: + +APT, 0 /VARIOUS FIELD BITS FOR FPP +PC, DPTEST /FPP PROGRAM COUNTER +XRBASE, 0 /FPP INDEX REGISTER ARRAY ADDRESS +BASADR, 0 /FPP BASE PAGE ADDRESS +ADR, 0 /ADDRESS TEMPORARY +ACX, 0 +ACH, 0 /*** FLOATING ACCUMULATOR *** +ACL, 0 +EAC1, 0 +EAC2, 0 /** FOR EXTENDED PRECISION OPTION ** +EAC3, 0 + /FLOATING POINT PACKAGE LOCATIONS + +AC0, 0 +AC1, 0 /FLOATING AC OVERFLOW WORD +AC2, 0 /OPERAND OVFLOW WORD +OPX, 0 +OPH, 0 /*** FLOATING OPERAND REGISTER *** +OPL, 0 + +/RTS I/O CONVERSION SYSTEM LOCATIONS + +FMTBYT, 0 /FORMAT BYTE POINTER +IFLG, 0 /I FOEMAT FLAG +GFLG, 0 /G FORMAT FLAG +EFLG, 0 /E FORMAT FLAG - SOMETIMES ON FOR G FMT +OD, 0 +SCALE, 0 +PFACT, 0 /P-SCALE FACTOR +PFACTX, 0 /TEMP FOR PFACT +ACI, 0 /INTEGERIZED FAC FROM "FFIX" SUBR +CHCH, 0 +FMTNUM, 0 /CONTAINS ACCUMULATED NUMERIC VALUE +CTCINH, 0 /^C INHIBIT FLAG +LOGUNT, 0 /DSRN POINTER - ONLY USED FROM ONE PAGE! +PTTY, TTY /POINTER TO TTY HANDLER - USED BY LDDSRN + 0 / SO FORMS CONTROL WILL WORK ON UNIT 0 +FPNXT, ICYCLE /USED AS INTERPRETER ADDRESS IF NO FPP + +/DSRN IMAGE + +HAND, 0 /HANDLER ENTRY POINT +HCODEW, 0 /HANDLER LOAD ADDR & FIELD + IOFFLG + FORMS CTL FLG +BADFLD, 0 /BUFFER ADDRESS AND FIELD +CHRPTR, 0 /ACTUALLY A WORD POINTER +CHRCTR, 0 /COUNTER - RANGES FROM -3 TO -1 +STBLK, 0 /STARTING BLOCK OF FILE +RELBLK, 0 /CURRENT RELATIVE BLOCK NUMBER +TOTBLK, 0 /LENGTH OF FILE +FFLAGS, 0 /FILE FLAGS: + /BIT 0 - "HAS BEEN WRITTEN" FLAG + /BITS 1-2 - FORMATTED/UNFORMATTED FLAGS + /BIT 11 - "END-FILED" FLAG + +BUFFLD, 0 /ROUTINE TO SET DF TO BUFFER FIELD +BUFCDF, HLT + JMP I BUFFLD + +FADD1, FADD+LONG /FPP CODE TO ADD 1.0 TO FAC + ONE /AND FALL INTO STORE CODE +FGPBF, 0 /THESE THREE WORDS ARE USED +BIOPTR, 0 /TO FETCH AND STORE FLOATING POINT NUMBERS + FEXIT /FROM RANDOM MEMORY + PAGE + /STARTUP CODE + +FTEMP2, ISZ .+3 /ALSO USED AS I/O F.P. TEMPORARY + CDF CIF 10 + JMP I .+1 +VDATE, RTSLDR /USED TO STORE OS/8 DATE + +/RTS ENTRY POINTS - "VERSION INDEPENDENT" + +VUERR, JMP I (USRERR /USER ERROR + /** LOADER MUST DEFINE #ARGER AS VARGER-1 ** +VARGER, JMS I ERR /LIBRARY ARGUMENT ERROR +VRENDO, ISZ RWFLAG /END OF I/O LIST +VRFSV, JMP I GETLMN /I/O LIST ARG ENTRY - COROUTINE WITH GETLMN +VBAK, JMP I (BKSPC /"BACKSPACE" ROUTINE +VENDF, JMP I (ENDFL /"END FILE" ROUTINE +VREW, JMP I (RWIND /"REWIND" ROUTINE +VDEF, JMP I (DFINE /"DEFINE FILE" ROUTINE +VWUO, AC4000 /UNFORMATTED WRITE +VRUO, JMP I (RWUNF /UNFORMATTED READ +VWDAO, AC4000 /DIRECT ACCESS WRITE +VRDAO, JMP I (RWDACC /DIRECT ACCESS READ +VWRITO, AC4000 /FORMATTED (ASCII) WRITE +VREADO, JMP I (RWASCI /FORMATTED (ASCII) READ +VSWAP, JMP I (SWAP /OVERLAY PROCESSOR +VEXIT, TRAP3; CALXIT /"STOP" ROUTINE - ENTERED IN FPP MODE +V8OR12, 0;0 /0;1 IF CPU IS A PDP-12 +VBACKG, JMP I (NULLJB /BACKGROUND JOB DISPATCHER + 0 + CDF CIF 0 /USED BY ROUTINE "ONQB" IN LIBRARY + JMS I .-2 + JMP VBACKG + +/IOH GET VARIABLE ROUTINE. +/THIS ROUTINE MAKES THE FORMATTED I/O PROCESSOR AND THE USER'S +/PROGRAM CO-ROUTINES (DEF(COROUTINE)= 2 ROUTINES EACH THINKING THE OTHER +/ IS A SUBROUTINE). ON ENTRY FAC=INPUT NUMBER +/IF I/O IS A READ, ON RETURN FAC=OUTPUT NUMBER IF I/O IS A WRITE. + +GETLMN, 0 +VRETRN, JMP I [RETURN /SHORT ROUTINE FOR ALL THOSE COMMENTS, NO? + /INTERRUPT DRIVEN I/O HANDLERS + +LPT, 0 /RING-BUFFERED - LP08 OR LS8E + AND [377 /JUST IN CASE +LPTSNA, SNA + JMP I (IOERR /CANNOT BE USED FOR INPUT +YLPT, IOF + DCA I LPPUT + TAD LPGET + CIA + TAD LPPUT + SZA CLA /IS LPT QUIET? + JMP .+3 /NO + TAD I LPPUT + LLS /YES - START 'ER UP + CLA IAC + LIE /ENABLE LPT INTERRUPTS + TAD LPPUT /1 IN AC, REMEMBER? + DCA LPPUT + TAD I LPPUT + SPA + JMP .-3 /NEGATIVE NUMBERS ARE BUFFER LINKS + SZA CLA /ANY ROOM LEFT IN BUFFER? + JMS I (HANG + LPUHNG /WAIT FOR LINE PRINTER + ION /TURN INTERRUPTS BACK ON + JMP I LPT /RETURN + +LPPUT, LPBUFR + +PTP, 0 /PAPER TAPE PUNCH HANDLER +YPTP, SNA + JMP I (IOERR /INPUT IS ERROR + DCA LPT /SAVE CHAR + IOF + TAD POCHR /IF PUNCH IS NOT IDLE, + SZA CLA /WE DISMISS JOB + JMS I (HANG + PPUHNG /WAIT FOR PUNCH INTERRUPT + TAD LPT + PLS /OUTPUT CHAR + DCA POCHR /SET FLAG NON-ZERO + ION + JMP I PTP + +/*K* THE FOLLOWING ADDRESSES GET FALLEN INTO & MUST BE SMALL + + IFNZRO PPUHNG&7000 <__ERROR__> + IFNZRO TTUHNG&7000 <__ERROR__> + IFNZRO KBUHNG&7000 <__ERROR__> + IFNZRO RDUHNG&7000 <__ERROR__> + IFNZRO LPUHNG&7000 <__ERROR__> + /INTERRUPT-DRIVEN PTR AND TELETYPE HANDLER + +PTR, 0 /CRUDE READER HANDLER +YPTR, SZA CLA + JMP I (IOERR /OUTPUT ILLEGAL TO PTR + IOF + RFC /START READER + JMS I (HANG + RDUHNG /HANG UNTIL COMPLETE + TAD RDRCHR /GET CHARACTER + ION + JMP I PTR /RETURN + +TTY, 0 /BUFFERS 2 CHARS ON OUTPUT, 1 ON INPUT +YTTY, IOF /DELICATE CODE AHEAD + SNA /INPUT OR OUTPUT? + JMP KBD /INPUT + DCA LPT /OUTPUT - SAVE CHAR + TAD TOCHR /GET TTY STATUS + SMA SZA CLA /G.T. 0 MEANS A CHAR IS BACKED UP + JMS I (HANG + TTUHNG /WAIT FOR LOG JAM TO CLEAR + TAD TOCHR /NO CHAR BACKED UP - SEE IF TTY BUSY + CLL RAL /"BUSY" FLAG IN LINK - INTERRUPTS ARE OFF! + CLA CML RAR /COMPLEMENT OF BUSY IN SIGN + TAD LPT /GET CHAR + SPA /IF TTY NOT BUSY, + TLS /OUTPUT CHAR + DCA TOCHR /STORE POS OR NEG, BACKED UP OR BUSY +TTYRET, ION /TURN INTERRUPTS BACK ON + JMP I TTY /AND LEAVE + KBD, TAD KBDCHR /HAS A CHARACTER BEEN INPUT? + SNA CLA + JMS I (HANG + KBUHNG /NO - RUN BACKGROUND UNTIL ONE IS + TAD KBDCHR /GET CHARACTER + DCA LPT + DCA KBDCHR /CHEAR CHARACTER BUFFER + TAD LPT + JMP TTYRET /RETURN WITH INTERRUPTS ON + +KILFPP, FPHLT /BRING FPP TO A SCREECHING HALT + ISZ .-1 + JMP .-1 /WAIT FOR IT TO STOP + FPICL /CLEAN UP MESS HALT HAS MADE IN FPP +BEEORC, SZL /^C OR ^B? + JMP I (7600 /^C - HIYO SILVER, AWAY! + KCC /CLEAR KBD FLAG ON ^B +CTLBER, JMS I ERR /*** THIS MAY BE DANGEROUS! ** + PAGE + /INTERRUPT SERVICE ROUTINES + +INTRPT, DCA INTAC + RAR + DCA INTLNK +VINT, JMP .+4 /** MUST BE AT 403 ** + IFNZRO VINT-403 <___ CHANGE LOADER!!!> + 0 + CDF CIF 0 /USER INTERRUPT ROUTINE GOES HERE + JMS I .-2 + + FPINT /CHECK FOR FPP DONE + JMP LPTEST +FPUHNG, JMP DISMIS /ALWAYS GOES TO RESTRT + +VDISMS, JMP DISMIS /FOR USE BY USERS + JMP DISMIS + JMP DISMIS + +LPTEST, LSF + JMP NOTLPT +LPTLCF, LCF /CLEAR FLAG + TAD I LPGET + SNA CLA /CHECK FOR SPURIOUS INTERRUPT +JMPDIS, JMP DISMIS /GO AWAY IF SO + DCA I LPGET /ZERO CHAR JUST OUTPUT + ISZ LPGET + TAD I LPGET + SPA + DCA LPGET /TAKE CARE OF BUFFER LINKS + SNA + TAD I LPGET /MAKE SURE CHAR IS IN AC + SZA /IS THERE A CHARACTER? + LLS /YES - PRINT IT + CLA + LSF /CHECK FOR IMMEDIATE FLAG +LPUHNG, JMP DISMIS /NO - MAYBE RESTART PROGRAM + JMP LPTLCF /YES - LOOP + +NOTLPT, TSF /CHECK TTY + JMP NOTTTY + TCF /CLEAR FLAG + TAD TOCHR /GET TTY STATUS + SMA SZA /IF THERE IS A CHARACTER WAITING, + TLS /OUTPUT IT. + SMA SZA CLA /CHANGE "WAITING" TO "BUSY", + STL RAR /"BUSY" TO "IDLE". + DCA TOCHR +TTUHNG, JMP DISMIS + /KBD AND PTP INTERRUPTS + +NOTTTY, KSF + JMP NOTKBD + TAD [200 + KRS /USE KRS TO FORCE PARITY BIT + DCA KBDCHR /AND ALSO SO THAT ^C WILL STILL BE IN BUFFER IN OS/8 + TAD KBDCHR + TAD (-202 /CHECK FOR ^C OR ^B + CLL RAR + SNA CLA + JMP CTCCTB /YUP - TAKE SOME DRASTIC ACTION + KCC /DATA CHARACTER - CLEAR FLAG +KBUHNG, JMP DISMIS + +CTCCTB, TAD CTCINH + SNA CLA /ARE WE IN A HANDLER? + JMP NOTINH /NO + TAD INTLNK + CLL RAL /YES - RETURN WITH INTERRUPTS OFF + TAD INTAC /TRUST IN GOD AND RTS + RMF + JMP I 0 + +NOTKBD, PSF + JMP NOTPTP + PCF /P.T. PUNCH INTERRUPT - CLEAR FLAG + DCA POCHR /CLEAR SOFTWARE FLAG +PPUHNG, JMP DISMIS + +NOTPTP, RSF + JMP LPTERR + TAD [200 + RRB /GET RDR CHAR + DCA RDRCHR +RDUHNG, JMP DISMIS + +LPTERR, LSE /TEST FOR LP08 ERROR FLAG + SKP + LIF /DISABLE LP08 INTERRUPTS IF ERROR FLAG ON +DISMIS, TAD INTLNK + CLL RAL + TAD INTAC /RESTORE AC AND LINK + RMF + ION + JMP I 0 /RETURN FROM THE INTERRUPT + +INTAC, 0 +INTLNK, 0 + /BACKGROUND INITIATE/TERMINATE ROUTINE + +HANG, 0 /ALWAYS CALLED WITH INTERRUPTS OFF! + TAD I HANG /GET POINTER TO UNHANGING LOCATION + DCA UNHANG + RDF /GET FIELD CALLED FROM + TAD HCIDF0 + DCA HNGCDF /SAVE FOR RETURN +HCIDF0, CDF CIF 0 + TAD (JMP RESTRT /CHANGE THE "JMP DISMIS" AT THAT LOC + DCA I UNHANG /TO A "JMP RESTRT" + TAD BACKLK + CLL RAL + TAD BACKAC /SET UP BACKGROUND AC AND LINK +BAKCIF, CIF 0 +BAKCDF, CDF 0 + ION + JMP I BACKPC /INITIATE BACKGROUND + +/ COME HERE WHEN THE HANG CONDITION HAS GONE AWAY + +RESTRT, TAD JMPDIS /RESTORE THE UNHANG LOCATION + DCA I UNHANG + TAD INTAC /SUSPEND THE BACKGROUND + DCA BACKAC + TAD INTLNK + DCA BACKLK + TAD 0 + DCA BACKPC + RIB + AND [70 + TAD HCIDF0 + DCA BAKCIF + RIB + JMS I MCDF /*K* OK SINCE BACKGROUND DOESN'T USE MAKCDF + DCA BAKCDF + ISZ HANG +HNGCDF, HLT + JMP I HANG /INTERRUPTS ARE OFF - RETURN + +NOTINH, TAD JMPDIS /IN CASE WE WERE HUNG, WE DON'T WANT + DCA I UNHANG /TO GET "UNHUNG" OUT OF THE ERROR ROUTINE! + JMP I (KILFPP /KILL FPP AND GO TO EXIT OR ERROR + +UNHANG, 0 +BACKAC, 0 +BACKLK, 0 +BACKPC, VBACKG +VHANG= HANG + IFNZRO VHANG-0524 <__ CHANGE LOADER!> + PAGE + /I-O CONVERSION ROUTINES - STARTUP CODE + +RWASCI, JMS I [RWINIT /"READ(N,FMT)" OR "WRITE(N,FMT)" + 2000 /"FORMATTED" BIT + JMS I [FETPC /GET ADDRESS OF FORMAT STMT + DCA FMTDF + JMS I [FETPC + DCA FMTADR + DCA FMTTYP + DCA PFACT /CLEAR SCALE FACTOR + JMS I [GETLMN /EXIT TO MAIN PROGRAM TO GET 1ST VARIABLE + + TAD (FMTPDL-1 +FMTSET, DCA FMTPXR /STORE NEW FORMAT PUSHDOWN POINTER + TAD I FMTPXR + DCA FMTBYT /GET NEW BYTE POINTER (NOTE-FMTPDL CONTAINS A 0) + /MAIN FORMAT DECODING LOOP + +FMTFLP, TAD FMTBYT + DCA FMPBYT /SAVE CURRENT BYTE PTR FOR PARENTHESES HACK +FMTDLP, DCA FMTNUM /ZERO ACCUMULATED NUMBER +FMTCLP, JMS FMTGCH /GET A CHARACTER + ISZ FMTBYT /BUMP BYTE POINTER + JMS I [CHTYPE /CLASSIFY CHAR + 1234; FMTDIG /DIGIT + -42; DBLQOT /" + -44; ABORTO /$ + -55; FMINUS /- + -56; FMTPER /. + -57; SLASH // + -54; COMMA /, + -50; LPAREN /( + -51; RPAREN /) + -47; KWOTE /' + -40; FMTCLP /SPACE + 0 /ANYTHING ELSE + + TAD FMTTYP + SZA CLA /CHECK THAT WE DO NOT HAVE A FIELD OUTSTANDING + JMP I (FMTERR /IF WE DO - ERROR + TAD CHCH /GET FIELD CHARACTER + DCA FMTTYP + TAD FMTNUM + SNA /IF REPEAT COUNT WAS MISSING OR ZERO + IAC /MAKE IT ONE + CMA + DCA N /STORE -(REPEAT COUNT +1) + DCA W /CLEAR WIDTH INITIALLY + ISZ FMTNUM /PRECLUDE "FORMAT ERROR" ON X,P, OR H FORMATS + TAD FMTTYP + AND [7 /IS THE CHARACTER P, X, OR H? + SNA CLA /IF SO, DON'T WAIT +COMMA, JMS I (DOFMT /EXECUTE THE STORED FIELD SPECIFICATION + JMP FMTFLP /BACK FOR MORE + +FMTADR, 0 /ADDRESS OF FORMAT + FMTGCH, 0 /GET CHARACTER FROM FORMAT + JMS FMTGAD /GET WORD CONTAINING CHAR AND L/R SWITCH + CDF 0 + JMS I (FMTGLR /EXTRACT CHARACTER + JMP I FMTGCH + +FMTGAD, 0 /SUBR TO GET A WORD FROM A CHARACTER OFFSET + TAD FMTBYT /GET OFFSET + CLL RAR + CLL + TAD FMTADR /COMPUTE BASE ADDR + [OFFSET/2] + DCA D + RAL + TAD FMTDF + JMS I MCDF /SET UP PROPER DATA FIELD + DCA .+1 + HLT + TAD FMTBYT + RAR + CLA /LEAVE L/R SWITCH IN LINK + TAD I D + JMP I FMTGAD /RETURN WITH WORD IN AC + +FMTDF, 0 /FIELD OF 1ST CHAR OF FORMAT IN BITS 9-11 + +FMTDIG, TAD FMTNUM /DIGIT PROCESSOR + CLL RTL + TAD FMTNUM + CLL RAL /MULTIPLY FMTNUM BY 10 + TAD CHCH /ADD IN THE DIGIT + JMP FMTDLP /STORE IT BACK AND CONTINUE + /PARENTHESIS AND DIGIT ROUTINES + +LPAREN, TAD FMTPXR + TAD (2-FMTPDL + SZA /ARE WE AT PARENTHESIS LEVEL 1? + JMP .+3 /NO + TAD FMPBYT /YES - STORE A POINTER TO THE FIRST DIGIT OF THE + DCA I (FMTPDL-2 /GROUP COUNT PRECEDING THIS PAREN + /AS THE LOOP POINTER FOR LEVEL 1 + TAD [7 + SPA CLA /PUSHDOWN OVERFLOW? +FPOERR, JMS I ERR /YES + AC7775 + TAD FMTPXR + DCA FMTPXR /BUMP PARENTHESIS PUSHDOWN POINTER + TAD FMTBYT + DCA I FMTPXR /SAVE BYTE POINTER + TAD FMTNUM + SNA + IAC /NO GROUP COUNT MEANS COUNT = 1 + CIA + DCA I FMTPXR /SAVE LOOP COUNT + DCA I (FMTPDL-1 /INITIAL GROUP COUNT IS INFINITE! +RPLOOP, AC7776 /COME HERE ON RIGHT PAREN ALSO + TAD FMTPXR /BACK UP FORMAT PDL POINTER + JMP FMTSET /RESTORE FMTBYT FROM TOP OF LIST + +FMPBYT, 0 + +RPAREN, JMS I (DOFMT /EXECUTE PREVIOUS SPEC IF ANY + TAD FMTPXR + TAD (2-FMTPDL /IS THIS THE FINAL RIGHT PAREN? + SNA CLA + JMS I [ENDREC /YES - CHECK FOR END OF FORMAT + ISZ I FMTPXR /BUMP COUNT + JMP RPLOOP /DIDN'T OVERFLOW - LOOP TO BYTE AFTER ( + ISZ FMTPXR /POP UP PARENTHESES STACK + JMP FMTFLP /CONTINUE PAST RIGHT PAREN + PAGE + /QUOTE AND HOLLERITH FORMAT PROCESSORS + +KWOTE, TAD MINUS5 /APOSTROPHE PROCESSOR +DBLQOT, TAD (-42 /QUOTE PROCESSOR + DCA KWODEL /SAVE TERMINATOR + JMS DOFMT /PROCESS PRECEDING FIELD , IF ANY + SKP +KWOTLP, JMS FMTHCV /PROCESS ONE CHARACTER + JMS I [FMTGCH /GET THE NEXT FORMAT CHAR + TAD KWODEL + SZA CLA /IS IT THE TERMINATOR? + JMP KWOTLP /NO - PROCESS IT AND CONTINUE + ISZ FMTBYT /BUMP OVER TERMINATOR + JMS I [FMTGCH + TAD KWODEL + SNA CLA /IS THIS ANOTHER TERMINATOR? + JMP KWOTLP /TWO TERMINATORS PRINT AS ONE + JMP I (FMTFLP /OTHERWISE GO BACK TO FORMAT LOOP + +HFMT, JMS MORE /MORE CHARACTERS? + JMS FMTHCV /YES - PROCESS ONE + JMP HFMT /AND LOOP + +FMTHCV, 0 /ROUTINE COMMON TO H AND QUOTED FORMATS + TAD RWFLAG /PROCESSES ONE CHAR IN OR OUT OF THE FORMAT +H7700, SMA CLA /IN OR OUT? + JMP FMTHIN /IN + JMS I [FMTGCH /OUT - GET THE CHAR + JMS I [FMTOUT /PRINT IT + JMP FMTHCR /RETURN +FMTHIN, JMS I [FMTIN /INPUT - GET THE CHAR FROM THE INPUT LINE + DCA W /SAVE IT + JMS I (FMTGAD + SZL /WHICH SIDE? + JMP FHRGHT /RIGHT SIDE + AND [77 /LEFT - KEEP RIGHT CHAR + DCA MORE + TAD W + CLL RTL + RTL + RTL + TAD MORE /ADD NEW CHAR IN ON THE LEFT + JMP .+3 +FHRGHT, AND H7700 /KEEP THE CHAR ON THE LEFT + TAD W /ADD NEW CHAR IN ON THE RIGHT + DCA I D /RESTORE ALTERED WORD + CDF 0 +FMTHCR, ISZ FMTBYT /BUMP BYTE POINTER + JMP I FMTHCV + +KWODEL, 0 /MUST BE UNIQUE! + MORE, 0 /SUBR TO BUMP REPEAT COUNT AND EXIT ON OVFLO + ISZ N + JMP I MORE +DOFRTN, DCA FMTTYP /INDICATE NO SPECIFICATION COLLECTED + JMP I DOFMT /RETURN FROM "DOFMT" + +DOFMT, 0 /ROUTINE TO PROCESS A FORMAT SPECIFICATION + TAD FMTNUM /GET THE CURRENT NUMBER + DCA D /STORE IT AS DECIMAL POINT SPEC + DCA IFLG + DCA EFLG + DCA GFLG /ZERO CONVERSION FLAGS + TAD FMTTYP + SNA CLA /ANY SPECIFICATION WAITING? + JMP I DOFMT /NO - JUST RETURN + TAD W + TAD D /IF THERE WAS NO W OR D SPECIFICATION, + SNA CLA + JMP FMTERR /ITS AN ERROR + TAD FMTTYP + JMS I [CHTYPE /YES - WHICH ONE? + -30; XFMT /X + -24; TFMT /T + -20; PFMT /P + -14; LFMT /L + -11; IFMT /I + -10; HFMT /H + -7; GFMT /G + -6; FFMT /F +MINUS5, -5; EFMT /E + -4;DF, EFMT /D - EQUIVALENT TO E IF NO D.P. FPP + -2;BF, FFMT /B - EQUIVALENT TO F IF NO D.P. FPP + -1; AFMT /A + 0 /NONE OF THE ABOVE - ERROR +FMTERR, JMS I ERR + ENDREC, 0 /ROUTINE TO END A LINE AND MAYBE THE I/O + JMS I [EOLINE + CLA IAC + AND RWFLAG /LO BIT OF RWFLAG IS "I/O LIST EXHAUSTED" FLAG + SNA CLA /SKIP IF NO MORE ELEMENTS IN I/O LIST + JMP I ENDREC + JMP I [ENDIO /NOW FINISH UP AND LEAVE + +SLASH, JMS DOFMT /EXECUTE THE FIELD SPEC IF ANY + JMS I [EOLINE /TERMINATE CURRENT LINE + JMP I (FMTFLP + +PFMT, CLA CMA + TAD FMTNUM + ISZ MINFLG /P FORMAT - CHECK FOR NEGATIVE SCALE + CIA + DCA PFACT + STA /FALL INTO CODE TO CLEAR MINFLG + DCA MINFLG /SET FLAG ON MINUS + JMP DOFRTN + +FMINUS, JMS DOFMT /EXECUTE PRECEDING SPEC + DCA MINFLG /CLEAR MINUS FLAG + JMP I (FMTFLP + +MINFLG, -1 + +FMTPER, TAD FMTNUM /PERIOD PROCESSOR + DCA W /STORE WIDTH + JMP I (FMTFLP + +ABORTO, JMS DOFMT /$ - SPECIAL HACK TO ALLOW PROMPTS + DCA EOLSW /FAKE BEGINNING OF LINE + DCA I (TTYLF /INHIBIT LF BEFORE NEXT TTY INPUT + JMP I [ENDIO /GO AWAY + PAGE + CHTYPE, 0 /ROUTINE TO CLASSIFY CHARACTERS + DCA CHCH /SAVE CHAR + JMP CHLOOP+1 +CDIGIT, TAD CHCH /CHECK FOR DIGIT + TAD (-72 + CLL + TAD [12 + SZL /IS CHAR A DIGIT? + JMP JMPOUT /YES +CHLOOP, ISZ CHTYPE /SKIP OVER ADDRESS + CLA + TAD I CHTYPE + ISZ CHTYPE + SMA /END OF LIST? + JMP JMPOTX /MAYBE - JUMP WITH CODE IN AC + TAD CHCH + SZA CLA /DOES CHAR MATCH CHAR ON LIST? + JMP CHLOOP /NO - KEEP LOOKING +JMPOUT, DCA CHCH /ZERO CHAR + TAD I CHTYPE + DCA CHTYPE /SET UP TO RETURN INDIRECTLY +JMPOTX, SZA CLA /IS THIS THE END? + JMP CDIGIT /NO - GO CHECK FOR DIGIT + JMP I CHTYPE /GO TO SPECIFIED ADDRESS + + +SKPOUT, 0 /ROUTINE USED BY DATA-HANDLING SPECIFICATIONS + JMS I [MORE /CHECK FOR REPEAT COUNT EXHAUSTED + TAD RWFLAG + CLL RAR + SZA CLA /IF OUTPUT, + ISZ SKPOUT /SKIP RETURN + SZL CLA /IF END OF I/O LIST, + JMS I [ENDREC /DON'T RETURN AT ALL - GO AWAY + JMP I SKPOUT + /A FORMAT PROCESSOR + +AINPUT, TAD (4040 + DCA ACH + TAD (4040 + DCA ACL /INITIALIZE LOW-ORDER WORDS TO BLANKS +AINPTL, JMS GADR + SZL /LEFT OR RIGHT? + JMP AINPTR /RIGHT + JMS I [FMTIN + STL RTL /INPUT CHAR GOES IN HIGH-ORDER + RTL /WITH BLANK IN LOW-ORDER + RTL + JMP AINPTC +AINPTR, JMS I [FMTIN + TAD I FMTGLR /COMBINE INPUT CHAR AND OLD LEFT HALF + TAD [-40 /DELETE PREVIOUS RIGHT-HALF SPACE +AINPTC, DCA I FMTGLR /STORE WORD + ISZ W + JMP AINPTL /LOOP AROUND WIDTH +ANXT, JMS I [GETLMN /GET NEXT ELEMENT +AFMT, TAD D + CIA + DCA W /SAVE FIELD WODTH AS A COUNT + JMS I [SKPOUT /CHECK FOR REPEAT COUNT OVFLO AND I/O DIR + JMP AINPUT +AOTPUT, JMS GADR /OUTPUT - GET ADDRESS OF BYTE + TAD I FMTGLR + JMS FMTGLR /GET BYTE + JMS I [FMTOUT /PRINT IT + ISZ W + JMP AOTPUT /LOOP ON WIDTH + JMP ANXT + +FMTGLR, 0 /SUBR TO EXTRACT A CHAR FROM A WORD + SZL + JMP .+4 /RIGHT HALF + RTR + RTR + RTR /LEFT HALF - ROTATE INTO RIGHT HALF + AND [77 + JMP I FMTGLR + +GADR, 0 /BYTE ADDRESS ROUTINE FOR A FORMAT PROCESSOR + TAD D + TAD W /FORM BYTE OFFSET IN THE RANGE 0 THRU D-1 + CLL RAR + TAD (ACX + DCA FMTGLR + JMP I GADR /LEAVE WITH L/R FLAG IN LINK + /"STOP" ROUTINE - TERMINATES JOB + +CALXIT, TAD EXDVNO + CIA + DCA ACI /GO THROUGH THE FORTRAN UNIT NUMBERS. + DCA I (ENDFLS /*K* TURN "ENDFL" INTO A SUBROUTINE + JMS I (LDDSRN /IF WE FIND A UNIT WHICH IS BEING USED + SNA CLA /AND HAS NOT BEEN ENDFILED, + JMP XITISZ /WE WILL DUMP THE CURRENT BUFFER (IF IT + CLA IAC /IS A FORMATTED OUTPUT FILE) AND + AND FFLAGS /END-FILE IT + SNA CLA + JMS I (ENDFL +XITISZ, ISZ EXDVNO + JMP CALXIT +LPTTWT, TAD I LPGET /WAIT FOR LINE PRINTER AND TELETYPE TO + TAD TOCHR /GO QUIET. + SZA CLA + JMP LPTTWT + ISZ CLNADR /SET UP TO CLOSE OUTPUT FILES +PDPXIT, IOF /ENTER HERE FROM 7605 + CDF 0 /TO PROTECT CLODS WITH PDP 8/E'S + JMS I (7607 + 0210 + 7400 /READ IN CLEANUP ROUTINE + 37 /AND OS/8 PAGE 17600 + JMP .-5 /AYEEEE!! SYSTEM DEVICE GONZO! + CDF CIF 10 + JMP I CLNADR /CLOSE TENTATIVE FILES AND EXIT +CLNADR, CLNUP +EXDVNO, -11 + +ARGLD, 0 /ROUTINE TO GET VALUE OF AN ARG + JMS I [FETPC + AND [7 /THROW AWAY OPCODE (JA) + TAD FLDTM2 + DCA FGPBF + JMS I [FETPC /CONSTRUCT AN FPP INSTRUCTION + DCA BIOPTR + JMS I [FPGO + FGPBF + JMP I ARGLD + +FLDTM2, FLDA+LONG + FTEMP2 + FEXIT + PAGE + /SUBROUTINE TO OPEN A UNIT FOR I/O + +RWINIT, 0 + DCA RWFLAG /DIRECTION IN AC ON ENTRY + AC7776 + AND I RWINIT /IF CALLED FROM BACKSPACE, REWIND OR ENDFILE + SZA CLA /UNIT NUMBER IS IN FAC + JMS I [ARGLD /OTHERWISE, GET UNIT NUMBER + JMS I [FFIX + TAD ACI + CLL CMA + TAD [12 + SZL CLA /CHECK DEVICE NUMBER IN RANGE 0-9 + JMS LDDSRN /LOAD DSRN ENTRY INTO PAGE 0 + SNA CLA /IS UNIT INITIALIZED? +UNTERR, JMS I ERR /NO - ERROR + TAD RWFLAG + SPA /IF WE ARE WRITEING FOR THE FIRST TIME + TAD FFLAGS /ON A UNIT WHICH WAS BEING READ, + CMA RAL /WE MUST BUMP THE RELATIVE BLOCK NUMBER DOWN + SNL SMA CLA /ONE BECAUSE OF A PHILOSOPHICAL DIFFERENCE + JMS I (RD2WR /BETWEEN READ AND WRITE + TAD I RWINIT + TAD RWFLAG /OR THE I/O TYPE AND + CMA + AND FFLAGS /DIRECTION BITS INTO THE FLAG WORD + TAD I RWINIT + TAD RWFLAG + DCA FFLAGS + TAD FFLAGS + CMA RTL + SNL SMA CLA /IT IS ILLEGAL TO ACCESS A FILE IN + JMP UNTERR /FORMATTED AND UNFORMATTED MODES + ISZ RWINIT + TAD ACI + CLL RAL + TAD ACI + TAD (DATABL-4 + DCA XR /STORE POINTER INTO DIRECT-ACCESS TABLE + JMP I RWINIT + /REWIND AND END FILE + +RWIND, JMS RWINIT /GET THE DSRN ENTRY + 0 /DON'T PLAY WITH MODES + AC2000 + TAD FFLAGS + SNA CLA /IF FORMATTED OUTPUT FILE AND NOT EOF'D + JMS DMPBUF /DUMP LAST BUFFER AS A FAVOR +ATLDMK, CLA IAC + AND FFLAGS /KILL ALL FLAG BITS + DCA FFLAGS /EXCEPT "END-FILED" BIT + TAD BADFLD + AND [7400 + DCA CHRPTR + AC7775 + DCA CHRCTR /INITIALIZE BUFFER POINTERS + DCA RELBLK /AND RELATIVE BLOCK # + JMP I [ENDIO /RESTORE DSRN AND EXIT + +ENDFL, JMS RWINIT /*K* USED AS A SUBROUTINE BY CALXIT + 1 /GET DSRN, SET "END FILE" FLAG + TAD FFLAGS /IF THE FILE IS UNFORMATTED, + CMA RAL /OR WAS NOT OUTPUT ONTO, + SNL SMA CLA /THEN ENDFILE DOES NOTHING. + JMS DMPBUF /ELSE DUMP THE FINAL BUFFER + AC3777 + AND FFLAGS /CLEAR WRITE BIT SO WE WILL NOT TRY +SETTOT, DCA FFLAGS /ANYTHING ON A SUBSEQUENT ENDFILE + TAD RELBLK /SET NEW LENGTH OF FILE IN CASE ITS TENTATIVE, + DCA TOTBLK /AND SO WE WON'T READ PAST EOF. +ENDIO, JMS INITMV /SET UP DSRN POINTERS + TAD I XR1 + DCA I XR /STORE BACK THE DSRN ENTRY + ISZ T /FOR THIS LOGICAL UNIT + JMP .-3 + DCA VEOFSW /CLEAR EOFSW AT END OF EVERY READ +ENDFLS, JMP I [RETURN /RETURN TO THE CALLING PROGRAM + JMP I ENDFL /*K* OR RETURN TO CALXIT + +INITMV, 0 /ROUTINE TO SET UP STUFF +ICDF0, CDF 0 + TAD LOGUNT + DCA XR + TAD (HAND-1 + DCA XR1 + TAD (-11 + DCA T + JMP I INITMV + /ROUTINE TO DUMP CURRENT OUTPUT BUFFER WITH ^Z AT THE END + +DMPBUF, 0 + ISZ EOLSW /FORCE COLUMN 1 SWITCH OFF + TAD (7712 /OUTPUT A LINE FEED + JMS I [FMTOUT + TAD HAND /IF THE FILE IS BEING OUTPUT VIA + SMA CLA /AN OS/8 HANDLER, + JMP CLREOL /WE MUST TERMINATE THE BUFFER PROPERLY. + TAD (32 +CTZLP, TAD Z7700 /OUTPUT A ^Z AND FILL BUFFER WITH ZEROES. + JMS I [FMTOUT /NEGATIVE NUMBERS TURN INTO CONTROL CHARS + TAD CHRPTR + AND [377 + TAD CHRCTR /FILL THE BUFFER UNTIL CHRPTR POINTS TO + IAC /A BLOCK BOUNDARY AND CHRCTR = -3 +Z7700, SMA CLA /WE ARE THEN AT BUFFER-END + JMP CTZLP +CLREOL, DCA EOLSW /RESET TO BEGINNING OF LINE + JMP I DMPBUF /RETURN + +/ROUTINE TO MOVE THE PROPER DSRN ENTRY INTO PAGE 0 + +LDDSRN, 0 + TAD ACI / READ/WRITE INIT SINGS THIS SONG, + CLL RTL / (DOO DAH, DOO DAH,) + RAL / DSRN ENTRIES 9 WORDS LONG + TAD ACI / (OH, DEE DOO DAH DAY). + + SNA /DEVICE NUMBER 0 IS SPECIAL - + TAD (PTTY+11-DSRN /IT'S ALWAYS THE TELETYPE + TAD (DSRN-12 + DCA LOGUNT + JMS INITMV /SET UP FOR MOVE + TAD I XR + DCA I XR1 /PUT DSRN ENTRY IN PAGE 0 + ISZ T + JMP .-3 + TAD BADFLD + AND [70 + TAD ICDF0 + DCA BUFCDF /SAVE BUFFER FIELD AS A CDF + TAD HAND + JMP I LDDSRN + PAGE + /BACKSPACE ROUTINE - WORKS ON BINARY OR ASCII FILES + +BKSPC, JMS I [RWINIT + 0 /GET THE DSRN ENTRY WITHOUT ALTERING MODE + TAD HAND + SMA CLA + JMP I [UNTERR /UNIT MUST BE BLOCK ORIENTED + AC2000 + AND FFLAGS + SZA CLA /IS FILE FORMATTED? + JMP BKASCI /YES - PAIN IN NECK + JMS BMPBLK /UNFORMATTED FILE - REREAD LAST BLOCK + TAD CHRPTR + TAD [377 + DCA T + JMS BUFFLD /SET DATA FIELD TO FIELD OF BUFFER + TAD I T /LOOK AT LAST WORD IN BUFFER + CIA /REGARD IT AS THE NUMBER OF BLOCKS/RECORD + TAD RELBLK + DCA RELBLK /RELBLK POINTS TO FIRST BLOCK OF PREV. REC + JMP I [ENDIO + +BMPBLK, 0 /SUBR TO BUMP BLOCK # BACK AND READ + CMA CLL /AC MAY NOT BE 0 ON ENTRY + TAD RELBLK + DCA RELBLK /BUMP BLOCK BACK + SNL + JMP I (ATLDMK /BACKSPACED TOO FAR - CALL IT QUITS + DCA CHRPTR /ZERO CHRPTR TO FORCE A READ FROM MASSIO + JMS I [MASSIO /READ A BLOCK + JMP I BMPBLK + +/**** NULL JOB GOES HERE FOR LACK OF A BETTER PLACE **** + +NULLJB, TAD N2525 +NULLLP, ISZ N2525 /PUT THE FAMOUS "POLY BASIC PATTERN" + JMP NULLLP /IN THE AC LIGHTS + ISZ NUMISZ + JMP NULLLP + CML CMA RAR + DCA N2525 + TAD [-4 + DCA NUMISZ + JMP I (VBACKG /GOT SOMETHING MORE USEFUL TO DO? +N2525, 2525 +NUMISZ, -4 + /BACKSPACE FOR FORMATTED FILES + +BKLORD, TAD I CHRPTR + ISZ CHRPTR + NOP + AND [177 /GET 7 BITS + TAD (-15 /COMPARE WITH C.R. - SINCE WE SKIPPED + SNA CLA /THE FIRST ONE THIS WILL BELONG TO THE PREVIOUS + JMP I [ENDIO /LINE AND WE WILL BE DONE (HAH!) +BKASCI, JMS I (MASBMP /A COMPLICATED MESS - FIRST BUMP THE + SKP /CHARACTER POINTER BACK TWO PLACES + JMP BKGTCH /AND THEN FETCH A CHARACTER. THIS WILL IGNORE + TAD BADFLD /THE LAST CHAR READ/WRITTEN (WHICH SHOULD + AND [7400 /BE A CARRIAGE RETURN). + CIA + TAD CHRPTR + CLL RAR + SZA CLA /TEST WHETHER WE HAVE TO READ AN OLD BUFFER + JMP BKNORD /NO + TAD CHRCTR /SAVE POSITION IN CURRENT DOUBLEWORD + DCA GETCH3 + DCA CHRPTR + AC4000 /IF WE ARE BACKSPACING AN OUTPUT FILE, + TAD FFLAGS /WE MUST SAVE THE INFORMATION IN THE + SPA /CURRENT BUFFER BY WRITING IT OUT. + JMP .+4 + DCA FFLAGS /ALSO CHANGE THE UNIT TO AN INPUT FILE + AC4000 /(RWINIT TAKES CARE OF SWITCHING BACK TO OUTPUT) + JMS I [MASSIO + CLA IAC /WE DON'T WANT THE LAST BLOCK READ/WRITTEN, + JMS BMPBLK /THAT'S IN CORE - WE WANT THE ONE + TAD GETCH3 /BEFORE THAT. + DCA CHRCTR + TAD CHRCTR + TAD (401 + SKP /COMPUTE WORD POINTER FROM CHAR POINTER +BKNORD, STA + TAD CHRPTR + DCA CHRPTR /BUMP WD PTR BACK 1 +BKGTCH, JMS I (MASBMP /NOW GET A CHARACTER - THIS LOOKS A LOT + JMP BKLORD /LIKE THE INPUT ROUTINE + JMS GETCH3 + JMP BKLORD+1 + GETCH3, 0 /COMMON CODE BETWEEN BACKSPACE AND INPUT + TAD I CHRPTR + AND [7400 + DCA BMPBLK /HANDY TEMPORARY + ISZ CHRPTR + TAD I CHRPTR + AND [7400 + CLL RTR + RTR /COMBINE TWO 4-BIT QUANTITIES + TAD BMPBLK /INTO A CHARACTER + CLL RTR + RTR + JMP I GETCH3 + +DATABL, ZBLOCK 33 /DIRECT ACCESS TABLE + PAGE + /I,E,F,AND G FORMAT CONVERSIONS + +IFMT, TAD D + DCA W /SET WIDTH PROPERLY + DCA D /FOR SCALING PURPOSES + STA + DCA IFLG + JMP FFMT + +GFMT, STA + DCA GFLG /SET G AND E FLAGS + +EFMT, STA + DCA EFLG /SET E FLAG + JMP FFMT + +IGEF, JMS I [GETLMN /MAIN LOOP FOR CONVERSIONS - SKIPPED 1ST TIME +FFMT, TAD D + DCA OD /SAVE COUNT OF POST-D.P. DIGITS + TAD IFLG + SNA CLA /APPLY THE P-SCALE FACTOR + TAD PFACT /ONLY IF THE FORMAT IS NOT I + DCA PFACTX + DCA SCALE /DON'T LOOK FOR TROUBLE + JMS I [SKPOUT /CHECK IF MORE AND TEST DIRECTION + JMP I (IGEFIN /INPUT + STA + DCA I [FFNEG /USE NEGATE ROUTINE HEADER AS SIGN FLAG + TAD EFLG + CLL RAL + CLL RAL /0 IF NOT E, -4 IF E + TAD W /THIS PROVIDES FOR THE EXP. FIELD (IF E FMT) + DCA OW /OR THE 4 TRAILING SPACES (IF G FMT) + TAD ACH + SNA + JMP SKPSHT /AC IS ZERO - SKP A LOT OF SHT + SPA CLA + JMS I [FFNEG /AC<0 - NEGATE IT AND SET FLAG (CLEVER) +SCALUP, DCA SCALE + TAD ACX + SMA SZA CLA /AC<1.0? + JMP GT1 /NO + JMS I [FPGO /YES - MULTIPLY BY 10.0 + FMUL10 + STA + TAD SCALE /BUMP POWER OF TEN + JMP SCALUP + /I,G,E,F, OUTPUT CONVERSIONS - NUMBER IS NOW =>1.0 + +GT1, JMS I (SCALDN /NOW DECREASE IT TO THE INTERVAL [0,1) + JMS I [FPGO /SAVE IT AWAY + FSTTMP + TAD [7 + JMS OSCALE + JMS I [FPGO /USE IT TO ROUND THE NUMBER TO BE OUTPUT + FADTMP + JMS I (SCALDN /WE COULD HAVE ROUNDED FROM .999... TO 1.000... +SKPSHT, TAD GFLG /ENTER HERE IF NUM WAS 0 - SCALE=0 + SNA CLA + JMP NOTG /NOT G FORMAT + TAD SCALE /G FORMAT - TEST FOR OUT OF F FORMAT RANGE + TAD PFACTX + CIA CLL /F FORMAT RANGE IS [.1,10**(D VALUE)) + TAD OD + SNL + JMP USEE /IF OUT OF BOUNDS USE E FORMAT (FLAG IS SET) + DCA OD /REDUCE D VALUE BY SCALE FACTOR + DCA EFLG /TO RETAIN CORRECT # OF SIG. DIGITS +USEE, CLA + JMP NOTG + +/SET UP TO PRINT DIGITS + + +DIGCNT, 0 + TAD PFACTX /COMPUTE EXPONENT JUST IN CASE E FORMAT + CIA + TAD SCALE + DCA FMTNUM + TAD EFLG + SNA CLA /NOW COMPUTE THE NUMBER OF DIGITS BEFORE THE D.P. + TAD SCALE /TAKE SCALE FACTOR INTO ACCOUNT IF NOT E FORMAT + TAD PFACTX /TAKE P FACTOR INTO ACCOUNT IF NOT I OR F/G + DCA SCALE /STORE THE NUMBER OF DIGITS BEFORE THE D.P. + TAD I [FFNEG /INCREASE NUMBER OF LEADING BLANKS BY 1 + SPA CLA /IF THE NUMBER IS POSITIVE. THIS DEPENDS ON + ISZ OW /THIS LOCATION BEING BELOW 4000. + TAD SCALE /GET THE NUMBER OF PRE-D.P. DIGITS (AS NEGATIVE #) + SPA SNA + CLA IAC /IF NONE, PRINT A 0 SO COUNT AS 1 + TAD OD /REDUCE THE WIDTH BY THIS NUMBER + CMA + TAD OW /REDUCE IT AGAIN BY THE POST-D.P. DIGIT COUNT + CIA + TAD IFLG /AND AGAIN BY 1 FOR THE D.P. (IF NOT I FORMAT) + JMP I DIGCNT +OW, 0 + /I,G,E,F FORMAT - ROUTINE TO SCALE ROUNDING FACTOR + +OSCALE, 0 /SUBR TO SCALE .5 THE CORRECT # OF TIMES + DCA NPLCS /MAX IN AC ON ENTRY + DCA ACX + AC2000 /FORM A FLOATING 0.5 IN ORDER + DCA ACH /TO ROUND THE NUMBER BEFORE PRINTING. + DCA ACL + TAD EFLG /FIGURE OUT HOW TO SCALE IT - + SNA CLA /THE THEORY IS THAT IT SHOULD BE SCALED + TAD SCALE /DOWN BY THE NUMBER OF SIGNIFICANT + DCA T /PRINTING DIGITS. THIS CAN BE + TAD SCALE /EXPRESSED AS: + CIA CLL /(P FACTOR) * (NOT (G FMT PRINTING AS F)) + TAD OD / + (SCALE FACTOR) * (NOT E FMT) + (D VALUE). + SZL CLA /THE SCALE FACTOR IS < 0 FOR + TAD GFLG /NUMBERS < .1, WHICH REDUCES + SNA CLA /THE # OF SIG. DIGITS VIA LEADING ZEROS. + TAD PFACTX /IF THERE ARE < 0 SIG. DIGITS + TAD T /IT DOESN'T MATTER WHAT WE DO + TAD OD /SINCE THE NUMBER WILL PRINT AS + SMA /0.00000 ANYWAY. + CMA /IF THERE ARE >NPLCS SIG. PRINTING DIGITS + TAD NPLCS /THE ROUNDING GETS MEANINGLESS SO MAKE + SPA /THE EXCESS DIVISIONS DIVIDES BY 2 INSTEAD + DCA ACX / OF BY 10. THIS FUDGE WORKS QUITE WELL + CIA /FOR NUMBERS OF UP TO NPLCS+2 + TAD NPLCS /SIGNIFICANT DIGITS. + CIA + DCA T + JMP .+3 +FDIVLP, JMS I [FPGO /SCALE THE .5 DOWN THE CORRECT NUMBER OF TIMES + FDIV10 + ISZ T + JMP FDIVLP + JMP I OSCALE +NPLCS, 0 +ONE, 1;2000;0 + PAGE + /I,G,E,F OUTPUT CONVERSION - ACTUAL OUTPUT SECTION + +OUTNUM, SMA /CHECK FOR FIELD OVERFLOW + JMP ASTSK1 /YES - PRINT ******* + JMS OBLNKS /PRINT LEADING BLANKS - AC IS NOT 0! + /***IMPORTANT - OBLNKS CLEARS AC1 *** + AC7775 + ISZ I [FFNEG /IF SIGN IS NEGATIVE, + JMS DIGIT /OUTPUT A MINUS SIGN + CLA /OTHERWISE OUTPUT NOTHING + TAD ACX + SNA /ALIGN THE FAC MANTISSA INTO A DOUBLEWORD + JMS I [AL1 /FRACTION IN THE RANGE [.1,1) + IAC /THIS INVOLVES SHIFTING THE MANTISSA + CMA /RIGHT BY (-ACX-1) PLACES + SMA /WHERE A NEGATIVE NUMBER MEANS A LEFT SHIFT. + JMS I [ACSR + CLA + TAD ACL /NOW MOVE THE FAC DOWN A WORD SO THAT + DCA AC1 /WHEN WE MULTIPLY BY 10 THE OVERFLOW APPEARS + TAD ACH /IN THE HIGH-ORDER WORD + DCA ACL + TAD SCALE + SPA SNA /DO WE HAVE DIGITS TO THE LEFT OF THE D.P.? + JMP PRZERO /NO - PRINT A ZERO THERE + JMS DIGITS /YES - PRINT THEM +PRDCPT, TAD IFLG + SZA CLA + JMP I (IGEF /IF I FORMAT, WE'RE DONE NOW + AC7776 + JMS DIGIT /OTHERWISE PRINT DECIMAL POINT + TAD SCALE + SMA CLA /CHECK WHETHER WE NEED TO PRINT LEADING ZEROS + JMP NOLZRO /NO + TAD SCALE + DCA T +LZLOOP, STA CLL + TAD OD /BUMP D VALUE DOWN BY ONE + SNL /IF IT GOES NEGATIVE, + JMP NOMOAC /WE'VE RUN OUT OF FIELD WIDTH + DCA OD + JMS DIGIT /PRINT A ZERO + ISZ T /UNTIL THE COUNT (OR THE WIDTH) RUNS OUT + JMP LZLOOP +NOLZRO, TAD OD + SZA /IF THERE ARE ANY DIGITS YET TO BE PRINTED, + JMS DIGITS /PRINT THEM + /I,G,E,F OUTPUT CONVERSION - FINISH UP + +NOMOAC, CLA + TAD EFLG + SNA CLA /E FORMAT? + JMP CHKG /NO - CHECK FOR G FORMAT OUTPUT AS F + JMS EXPFLD + JMP I (IGEF +EXPFLD, 0 + TAD (5 + JMS I [FMTOUT /OUTPUT "E" + TAD FMTNUM /GET EXPONENT + CLL + SPA + CML CIA /SEPARATE INTO MAGNITUDE AND SIGN + DCA FMTNUM /SAVE MAGNITUDE + RTL + TAD (-5 /PRINT + OR - + JMS DIGIT + DCA T /INITIALIZE QUOTIENT OF DIVISION +DVELP, TAD FMTNUM /SUBTRACT 10 FROM EXPONENT + TAD [-12 + SPA /DID IT GO NEGATIVE? + JMP PRNTXP /YES - DONE + DCA FMTNUM /NO - STORE IT BACK + ISZ T /BUMP QUOTIENT + JMP DVELP /LOOP +PRNTXP, CLA + TAD T + TAD [-12 + SMA CLA + JMP ASTSK3 + TAD T + JMS DIGIT + TAD FMTNUM + JMS DIGIT /PRINT TWO DIGITS OF EXPONENT + JMP I EXPFLD + +CHKG, TAD GFLG + SNA /WAS IT G FORMAT? + JMP I (IGEF /NO - F OR I - DONE + DCA EFLG /RE-SET EFLG SINCE WE ZEROED IT BEFORE + TAD (-5 + JMS OBLNKS /OUTPUT 4 BLANKS + JMP I (IGEF /DONE WITH G FORMAT OUTPUT + +PRZERO, CLA /COME HERE IF NO SIG. DIGITS LEFT OF D.P. + JMS DIGIT /PRINT A ZERO + JMP PRDCPT /CONTINUE + +ASTSK3, AC0002 + JMP .+3 +ASTSK1, CLA /CLEAR THE AC + TAD W /GET THE FIELD WIDTH + JMS I [ASTRSK + JMP I (IGEF + /I,G,E,F OUTPUT CONVERSION - OUTPUT SUBROUTINES + +OBLNKS, 0 /SUBROUTINE TO PRINT A STRING OF BLANKS + DCA AC1 /MUST LEAVE AC1 ZERO ON EXIT SO THAT + JMP .+3 /FAC LEFT SHIFT WON'T SHIFT IN GARBAGE LATER ON + TAD [40 + JMS I [FMTOUT /OUTPUT A BLANK + ISZ AC1 + JMP .-3 /LOOP + JMP I OBLNKS /RETURN + +DIGITS, 0 /ROUTINE TO OUTPUT A STRING OF DECIMAL DIGITS + CIA + DCA T +DGLOOP, TAD AC1 + DCA AC2 /COPY AC INTO OPERAND FOR ADDITION LATER ON + TAD ACL + DCA OPL + DCA ACH /CLEAR "OVERFLOW WORD" + JMS I [AL1 + JMS I [AL1 /FAC=FAC*4 + DCA OPH + JMS I [OADD + JMS I [AL1 /FAC=ORIGINAL FAC*10 + TAD ACH /GET OVERFLOW + JMS DIGIT /PRINT IT + ISZ T /LOOP FOR SPECIFIED NUMBER + JMP DGLOOP + JMP I DIGITS /RETURN + +DIGIT, 0 /ROUTINE TO OUTPUT A DIGIT + TAD [60 + JMS I [FMTOUT /TRIVIAL, ISN'T IT? + JMP I DIGIT + PAGE + /I,G,E,F INPUT CONVERSION + +IGEFIN, STA /OD CONTAINS SCALING IF NO D.P. IN INPUT + DCA DPSW /INITIALIZE D.P. SW + STA + DCA INESW /DITTO EXPONENT SWITCH + TAD W + CMA + DCA FMTNUM /GET CHAR COUNT +INERSM, DCA ACX /RE-ENTER HERE AFTER SEEING "E" + DCA ACH /CLEAR FLOATING AC + DCA ACL + STA + JMP INMINS /SET SIGN PLUS + +INGCH, JMS I [FMTIN /GET A CHAR + JMS I [CHTYPE /CLASSIFY IT + 1234; IDIGIT /DIGIT + -56; INDCPT /. + -53; INLOOP /+ + -55; INMINS /- + -5; INE /E + -40; IBLDIG /BLANK - TREAT LIKE 0 IN FORTRAN STANDARD + -54; INEONM /, + 0 /OTHER - ERROR +INER, JMS I ERR + +INDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER D.P. + ISZ DPSW /TEST AND SET D.P. SWITCH + JMP INER /WHOOPS - TWO D.P.S IN A NUMBER + JMP INLOOP /KEEP GOING + +IBLDIG, TAD EOLSW /SINCE THE BLEEPING STANDARD DOESN'T COVER + SZA CLA /TELETYPE I/O, WE KEEP SOME COOL BY IGNORING + JMP INLOOP /BLANKS CREATED BY EARLY LINE TERMINATION. + +IDIGIT, TAD CHCH + DCA DGT+1 /SAVE THE DIGIT + JMS I [FPGO /FORM 10*FAC + DIGIT IN FAC + ACMDGT + TAD DPSW + SNA CLA + ISZ OD /BUMP DIGIT COUNT IF D.P. SEEN + JMP INLOOP + INMINS, DCA I [FFNEG /SET SIGN NEGATIVE + +INLOOP, ISZ FMTNUM + JMP INGCH /LOOP UNTIL WIDTH EXHAUSTED +INEONM, ISZ I [FFNEG /CHECK IF SIGN NEGATIVE + JMS I [FFNEG /YES - NEGATE + ISZ INESW /SEE IF "E" SEEN + JMP FIXUPE /YES - WE HAVE EXPONENT, NOT NUMBER + TAD PFACTX /NO "E" SEEN - SCALE USING P FACTOR + +SCALIN, TAD OD /GET SCALING FACTOR + STL + SNA + JMP I (IGEF /NO SCALING NECESSARY + SMA + CIA CLL /AC CONTAINS MAGNITUDE, LINK CONTAINS SIGN + DCA OD + RTL + RAL /AC CONTAINS 0 IF DIVIDE, 4 IF MULTIPLY + TAD (FDIV10 + DCA IGEFOP + JMS I [FPGO /MULTIPLY OR DIVIDE BY 10.0 +IGEFOP, 0 + ISZ OD + JMP IGEFOP-1/MULT OR DIV APPROPRIATE NUMBER OF TIMES + JMP I (IGEF /RETURN FOR MORE + +INE, ISZ INESW /SEE IF THIS IS THE SECOND "E" + JMP INER /YES - ERROR + ISZ DPSW /FORCE DP SW ON (TO INHIBIT D.P. AFTER E) + TAD OD /USE SCALE FACTOR ONLY IF D.P. SEEN + DCA SCALE /SAVE SCALE FACTOR + ISZ I [FFNEG + JMS I [FFNEG /GET SIGN OF NUMBER CORRECT + JMS I [FPGO /SAVE IT TEMPORARILY + FSTTM2 + JMP INERSM /GO COLLECT EXPONENT + +FIXUPE, JMS I [FFIX + TAD ACI /GET EXPONENT + CIA + TAD SCALE /ADD IN EXPONENT TO D.P. SCALE FACTOR + DCA OD + JMS I [FPGO /GET NUMBER BACK IN FAC + FLDTM2 + JMP SCALIN + +DPSW, 0 +DGT, 13;0;0;0;0;0 +NOTG, JMS I (DIGCNT + DCA SCALDN + TAD IFLG + SNA CLA + JMP NOTI + TAD SCALE + TAD (-7 + SPA CLA +NOTI, TAD SCALDN + JMP I (OUTNUM + SCALDN, 0 /SUBROUTINE TO SCALE THE FAC LESS THAN 1.0 + TAD ACX + SPA SNA CLA /IS THE FAC => 1.0? + JMP I SCALDN /NO - WE'RE DONE + JMS I [FPGO /DIVIDE BY TEN + FDIV10 + ISZ SCALE /BUMP POWER OF TEN + 0 /BACKUP FOR WIDTH + JMP SCALDN+1 /LOOP + +ASTRSK, 0 + CIA + DCA T + TAD (52 + JMS I [FMTOUT + ISZ T + JMP .-3 + JMP I ASTRSK /GET NEXT ELEMENT + +INESW, 0 /"E SEEN" SWITCH ON INPUT + PAGE + /L AND X FORMATS , T FORMAT INPUT + +TFMTIN, JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY + CLA /BY FETCHING AND WASTING A CHARACTER + TAD (INBUFR + DCA INXR + DCA EOLSW /SET TO BEGINNING OF LINE + JMP XFMT +XFMTIN, JMS I [FMTIN +H7600, 7600 /WASTE AN INPUT CHAR +XFMT, JMS I [MORE /ANY MORE CHARS? + TAD RWFLAG /YES - IN OR OUT? + SMA CLA + JMP XFMTIN /IN +TPPLBL, TAD [40 /HERE WITH AC=13 TO OVERPRINT ON T OUTPUT + JMS I [FMTOUT /OUT + JMP XFMT + +LINGCH, JMS I [FMTIN + JMS I [CHTYPE /GET AND CLASSIFY CHARACTER + -40; LINLP /BLANK + -24; LINTRU /T + -6; LINFLS /F + 0 /OTHER - ERROR + JMP I (INER + +LINTRU, TAD (4001 +LINFLS, CLL RAR /PUT EITHER 0.0 OR 1.0 IN THE FAC + DCA ACH + DCA ACL + RAL + DCA ACX +LINLP, ISZ W + JMP LINGCH /LOOP ON FIELD WIDTH + +LNXT, JMS I [GETLMN /GET NEXT ELEMENT FOR I/O +LFMT, TAD D + CMA + DCA W /SAVE WIDTH AS A COUNT + JMS I [SKPOUT /IN OR OUT? + JMP LINFLS /IN + CLA IAC + TAD W + JMS I (OBLNKS /OUTPUT W-1 BLANKS + TAD ACH + SZA CLA + TAD (16 + TAD (6 /NON-ZERO IS TRUE, ZERO FALSE + JMS I [FMTOUT /OUTPUT T OR F + JMP LNXT /NEXT VICTIM + /T FORMAT OUTPUT AND RANDOM SUBROUTINES + +TFMT, TAD D + CIA + DCA N /USE N TO FAKE OUT "X" FMT ROUTINE + TAD RWFLAG + SMA CLA + JMP TFMTIN /INPUT + TAD N + TAD EOLSW /COMPARE DESIRED POSITION WITH CURRENT ONE + SPA + JMP TPBLNK /AFTER - SPACE TO IT + JMS EOLINE /OUTPUT CR AND ZERO EOLSW + JMS I [MORE /KLUDGE FOR "T1" FORMAT + TAD (13 /FAKE X FORMAT INTO PRINTING + JMP TPPLBL /A + AND (N-1) SPACES +TPBLNK, DCA N /SAVE DIFFERENCE BETWEEN POSITIONS + JMP XFMT /GO SPACE OUT + +EOLINE, 0 /SUBROUTINE TO TERMINATE I/O LINE + TAD RWFLAG /CAUTION - AC LO-ORDER BITS MAY NOT BE 0 + SPA CLA /INPUT OR OUTPUT? + JMP EOOUTL /OUTPUT + JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY + CLA + TAD (INBUFR-1 + DCA INXR /SET XR TO NEGATIVE WORD AT THE + JMP .+3 /BEGINNING OF THE INPUT BUFFER +EOOUTL, TAD (7715 + JMS I [FMTOUT /OUTPUT A CARRIAGE RETURN + DCA EOLSW /CLEAR EOLSW FOR INPUT AND OUTPUT + JMP I EOLINE + /ROUTINE TO MOVE A HANDLER INTO FIELD 0 + +GETHND, 0 /HANDLER CODE WORD IN AC ON ENTRY + DCA HCW /SAVE HANDLER CODE WORD + TAD [7774 + AND HCW /KNOCK OUT ION AND FORMS CTL BITS + CIA + SZA /IF HANDLER IS NOT RESIDENT, + TAD HKEY /SEE IF THE HANDLER IS ALREADY + SNA CLA /IN THE HANDLER AREA IN FIELD 0 + JMP HINF0 /YES + TAD HCW /NO - PUT IT THERE + AND [70 + TAD HCDF0 + DCA HNDCDF /GET CDF TO FIELD IN WHICH HANDLER RESIDES + TAD HCW + AND H7600 + TAD (-1 /GET POINTER TO HANDLER ADDRESS + DCA XR1 /IN THAT FIELD + TAD (HPLACE-1 + DCA XR /ALSO TO HANDLER AREA IN FIELD 0 + TAD [7400 /SET UP COUNT OF 7400 + DCA HKEY /INDEPENDENT OF HANDLER SIZE +HNDCDF, HLT + TAD I XR1 +HCDF0, CDF 0 + DCA I XR /MOVE HANDLER INTO HANDLER AREA + ISZ HKEY + JMP HNDCDF + TAD [7774 + AND HCW + DCA HKEY /SET NEW KEY CODE WORD +HINF0, CLA IAC + AND HCW + SNA CLA /INTERRUPTS ALLOWED? +YHIOF, IOF /NO - TOO BAD + ISZ CTCINH /INHIBIT ^C DURING HANDLER CALL + JMP I GETHND +HKEY, 0 +HCW, 0 + PAGE + /CHARACTER INPUT ROUTINE - LINE AT A TIME + +FMTIN, 0 + TAD EOLSW + SNA /END OF LINE ALREADY FOUND? + TAD I INXR /NO - GET CHAR FROM LINE BUFFER + SPA /TIME TO READ A NEW LINE? + JMP READLN /YES + SNA /END OF LINE? + JMP INEOL /YES - SET INDICATOR + AND [77 /CONVERT TO SIXBIT + JMP I FMTIN /RETURN WITH IT +INEOL, TAD [40 +UNPKLN, DCA EOLSW /SET EOL INDICATOR TO A BLANK + JMP FMTIN+1 /AND RETURN BLANKS FROM HERE ON IN +READLN, DCA EOLSW /USE EOLSW AS A COUNT SO IT WINDS UP 0 + TAD HAND + TAD (-TTY + SNA CLA /IS IT TELETYPE INPUT? + STA /YES - SET TTY FLAG + DCA TTYFLG + JMS ECHO +TTYLF, 12 /ECHO LF IF TTY INPUT + TAD [12 /TTYLF IS ZEROED BY ABORTO + DCA TTYLF + +READLP, CLA + TAD HAND + SPA CLA /CHARACTER ORIENTED DEVICE? + JMP MASSIN /NO - UNPACK CHAR FROM BUFFER + JMS I HAND /GET A CHARACTER +GOTCHR, AND [177 /STRIP OFF PARITY + JMS I [CHTYPE /CLASSIFY IT + -15; INCRET /CARRIAGE RETURN + -177; RUBOUT /RUBOUT + -11; INTAB /TAB + -25; CTRLU /^U + -32; INEOF /^Z + 0 /ANYTHING ELSE + TAD CHCH + TAD [-40 + SMA /IF CHARACTER IS >37, + JMS INPUTC /STORE IT AND ECHO IT IF TTY + JMP READLP + /CHARACTER INPUT ROUTINE - SPECIAL CHARACTER HANDLERS + +INTAB, JMS INPUTC /TAB - INSERT (AND ECHO) BLANKS + TAD INXR + AND [7 + SZA CLA /UNTIL A COLUMN MULTIPLE OF 8 IS REACHED + JMP INTAB + JMP READLP + +RUBOUT, TAD EOLSW + CIA + TAD I (INBUFR /IGNORE RUBOUTS IF LINE EMPTY + AND TTYFLG + SNA CLA + JMP READLP /OR IF NON-TTY INPUT + JMS ECHO + 134 /ECHO A BACKSLASH +IBAKUP, STA + TAD INXR + DCA INXR /BACK UP LINE POINTER + STA + TAD EOLSW + DCA EOLSW /AND CHAR COUNTER + JMP READLP + +INEOF, TAD VEOFSW /CHECK SWITCH SET BY "CHKEOF" LIBRARY ROUTINE + SNA /WAS HE EXPECTING AN EOF? +EOFERR, JMS I ERR /NO + JMS I MCDF + DCA .+1 + HLT /CDF TO FIELD OF INDICATOR VARIABLE + AC2000 + DCA I VEOFSW+1 /SET VARIABLE TO .5 + CDF 0 /FALL INTO CARRIAGE RETURN CODE + +INCRET, DCA I INXR /CARRIAGE RETURN - ZERO OUT REST OF LINE + SKP +CTRLU, STA /SNEAKY, SNEAKY! + TAD (INBUFR + DCA INXR /RESET XR TO FETCH LINE CHARS + JMS ECHO + 15 /ECHO THE C.R. + JMP UNPKLN /BACK TO FETCH FIRST CHAR + +INPUTC, 0 /ROUTINE TO STORE AND ECHO A CHAR + TAD [40 + DCA INTMP + JMS ECHO +INTMP, 0 /ECHO CHAR IF TTY INPUT + TAD INTMP + DCA I INXR /STORE CHAR IN LINE BUFFER + ISZ EOLSW + JMP I INPUTC /RETURN IF NO OVERFLOW + JMP IBAKUP /IGNORE CHAR IF OVERFLOW + ECHO, 0 /ROUTINE TO ECHO CHAR IF TTY INPUT + TAD I ECHO /GET CHAR + AND TTYFLG + SZA /SHOULD WE ECHO? + JMS I HAND /YES + JMP I ECHO /RETURN TO CHARACTER - ITS SMALL +TTYFLG, 0 + +/CHARACTER INPUT ROUTINE - MASS STORAGE SECTION + +MASSIN, JMS MASBMP /GET BUFFER FIELD AND CHAR NUMBER + JMP INLORD /CHAR 1 OR 2 - STRAIGHTFORWARD + JMS I (GETCH3 /USE COMMON SUBROUTINE + JMP MASICM /GO TO COMMON CODE + +INLORD, JMS I [MASSIO /CHECK IF WE SHOULD READ IN A BUFFERLOAD + JMS BUFFLD /SET FIELD OF BUFFER + TAD I CHRPTR +MASICM, ISZ CHRPTR /GET THE CHAR (IN LOW 8 BITS) AND BUMP PTR + NOP /WATCH END OF FIELD FUNNYBUSINESS! + CDF 0 /RESET DATA FIELD + JMP GOTCHR /GO EXTRACT SEVEN BIT CHARACTER + +MASBMP, 0 + JMS BUFFLD /SET TO BUFFER'S DATA FIELD + ISZ CHRCTR /BUMP CHAR COUNTER + JMP I MASBMP /CHAR 1 OR 2 - NO SWEAT + AC7775 + DCA CHRCTR /CHAR 3 - RESET CHAR CTR + AC7776 + TAD CHRPTR /BUMP BACK CHAR PTR + DCA CHRPTR + ISZ MASBMP + JMP I MASBMP /SKIP RETURN + PAGE + /CHARACTER OUTPUT ROUTINE + +FMTOUT, 0 + TAD [40 /FIRST CONVERT SIXBIT TO ASCII + SMA /CTL CHARS COME IN NEGATIVE + AND [77 + TAD (240 + DCA OCHAR /SAVE ASCII CHAR (WITHOUT PARITY BIT) + TAD EOLSW + SZA CLA + JMP NOT1ST /FIRST CHAR IS DECODED FOR FORMS CONTROL + AC0002 /CHECK TO SEE IF THIS UNIT + AND HCODEW /SHOULD RECEIVE FORMS CONTROL + SZA CLA + JMP LFPLCH /NO - JUST PRINT A LINE FEED AND THE CHAR + TAD OCHAR + JMS I [CHTYPE /CLASSIFY CONTROL CHAR + -261; OUTFFX /1 - TOP OF FORM + -260; OUT2LF /0 - DOUBLE SPACE + -253; NOLF /+ - OVERPRINT + 0 /ANYTHING ELSE - SINGLE SPACE + JMP OUTLF + +OUTFFX, TAD HAND + TAD (-TTY /IF HANDLER IS TTY OUTPUT TWO LINE FEEDS + SZA CLA /INSTEAD OF A FORM FEED + JMP OUTFF +OUT2LF, TAD [12 + DCA OCHAR /SET 2ND CHAR TO LINE FEED +LFPLCH, STA + DCA EOLSW /SET SWITCH FOR 2ND CHAR + TAD OCHAR + DCA CHCH /SAVE CHARACTER AWAY +OUTLF, AC7776 +OUTFF, TAD F214 /SUBSTITUTE THE APPROPRIATE FORM CONTROL + DCA OCHAR /FOR THE CHARACTER +NOT1ST, TAD HAND + SPA CLA /CHARACTER ORIENTED DEVICE? + JMP MASOUT /NO - PACK CHAR INTO BUFFER + TAD OCHAR + JMS I HAND /OUTPUT CHAR +NOLF, ISZ EOLSW /BUMP CHAR CTR + JMP I FMTOUT /NO - RETURN + TAD CHCH /AHA - ANOTHER CHARACTER SHOULD BE OUTPUT + JMP OUTFF+1 /GO TO IT + /CHARACTER OUTPUT - MASS STORAGE OUTPUT + +MASOUT, JMS I (MASBMP /GET BUFFER FIELD AND CHAR NUMBER + JMP OULORD /CHAR 1 OR 2 - STRAIGHTFORWARD + JMS OSUBR /CHAR 3 - PACK FIRST HALFBYTE + JMS OSUBR /PACK SECOND HALFBYTE + AC4000 + JMS MASSIO /CHECK IF WE SHOULD DUMP THE BUFFER +MASOCM, CDF 0 + JMP NOLF /GO RETURN OR REENTER + +OULORD, TAD OCHAR + DCA I CHRPTR /STORE CHAR, ZAPPING HIGH-ORDER BITS + ISZ CHRPTR /BUMP CHAR PTR +F214, 214 /GUARD AGAINST OVFLO + JMP MASOCM /RETURN + +OSUBR, 0 /ROUTINE TO PACK A HALFBYTE + TAD OCHAR + CLL RTL + RTL /SHIFT CHAR 4 LEFT + DCA OCHAR + TAD I CHRPTR /CLEAR OUT ANY RESIDUE + AND [377 /FROM HIGH-ORDER OF BUFFER WORD + DCA I CHRPTR /IN CASE WE ARE WRITING AFTER A BACKSPACE. + TAD OCHAR + AND [7400 /GET 4 BITS + TAD I CHRPTR + DCA I CHRPTR /ADD INTO HIGH-ORDER OF BUFFER WORD + ISZ CHRPTR /BUMP POINTER + 200 /OVERFLOW! + JMP I OSUBR + +MASSIO, 0 /SUBROUTINE TO READ/WRITE BUFFER IF NECESSARY + CDF 0 + TAD BUFCDF /ADD BUFFER CDF TO R/W BIT IN AC + TAD (-6001 /TAKE AWAY CDF, LEAVE BIT 4 ON + DCA IOCTL /STORE I/O CONTROL WORD + TAD CHRPTR + AND [377 + SZA CLA /SEE IF POINTER IS AT BUFFER BOUNDARY + JMP I MASSIO /YES - RETURN DOING NOTHING + TAD RELBLK + TAD STBLK /STORE BLOCK # IN HANDLER CALL + DCA BLOCK + TAD BADFLD + AND [7400 + DCA BUFFER /STORE BUFFER ADDRESS IN HANDLER CALL + /CHARACTER OUTPUT - BUFFER I/O ROUTINE CONTINUED + + TAD TOTBLK + CIA CLL + TAD RELBLK + SZL CLA /CHECK FOR FILE OVERFLOW +IOVFLO, JMS I ERR /YES - ERROR + TAD HCODEW + JMS I (GETHND /GET HANDLER INTO FIELD 0 + JMS I HAND /CALL HANDLER +IOCTL, 0 +BUFFER, 0 +BLOCK, 0 + SMA CLA /HANDLER ERROR - ABORT + SKP /IF NOT EOF +IOERR, JMS I ERR + JMS I (RECOVR /CLEAR ANY FLAGS SET BY OS8 HANDLER + ISZ RELBLK /BUMP RELATIVE BLOCK NUMBER + TAD BUFFER + DCA CHRPTR /RESET CHAR PTR + JMP I MASSIO /RETURN +/FPP CODE FOR I/O CONVERSION + +FDIV10, FDIV+LONG + TEN + FEXIT +OCHAR, 0 /*** NEEDED FOR PADDING *** +FMUL10, FMUL+LONG /FMUL10 MUST BE AT FDIV10+4 + TEN + FEXIT + +FWTOBL, FSUB+LONG + ONE + FDIV+LONG + FLTG85 + FEXIT + PAGE + /UNFORMATTED (BINARY) INPUT-OUTPUT + +RWUNF, JMS I [RWINIT /"READ(N)" OR "WRITE(N)" + 1000 /"UNFORMATTED" BIT + TAD SZLCLA /ENABLE SEQUENCE CHECKING +UNFIO, DCA SEQCHK /*** SET SEQCHK TO "SZL CLA" OR "CLA" + DCA RECCTR /ENTER HERE FROM DIRECT ACCESS + TAD HAND + SMA CLA /CHECK FOR MASS-STORAGE HANDLER + JMP I [UNTERR /NO - ERROR + JMS I [GETLMN /GET FIRST VARIABLE + TAD RWFLAG + SPA CLA +RSETBP, TAD (125 /INITIALIZE COUNT TO -86 FOR WRITE, + CMA /-1 FOR READ + DCA CHRCTR + TAD BADFLD + AND [7400 + DCA BIOPTR /INITIALIZE BUFFER POINTER + TAD BADFLD + AND [70 + IAC + CLL RTR /AC BIT 0 NOW ON + TAD RWFLAG /AC BIT 0 CONTAINS COMP. OF R/W FLAG + CLL RAR /AC=(.NOT.RW)*2000+BUFFER FIELD + TAD (FSTA+LONG /AC=(FSTA OR FLDA) + BUFFLD + DCA FGPBF + JMP UIOVLP /SKIP FIRST VARIABLE FETCH/STORE +BFINCR, JMS I [FPGO + FGPBF /LOAD OR STORE A BUFFER ENTRY + ISZ BIOPTR + ISZ BIOPTR /INCREASE BUFFER POINTER + ISZ BIOPTR + JMS I [GETLMN /GET A VARIABLE FROM THE CALLING PROGRAM +UIOVLP, TAD RWFLAG + CLL RAR /LOWORDER BIT OF RWFLAG = END LIST FLAG + SZL CLA + JMP ENDUIO /NO MORE VARIABLES - TERMINATE + ISZ CHRCTR /BUMP COUNTER + JMP BFINCR /ROOM IN BUFFER - MOVE VARIABLE + JMS UDOIO /GET A NEW BUFFER + JMP RSETBP /RESET BUFFER POINTERS AND COUNTERS + +ENDUIO, TAD RWFLAG /COME HERE WHEN I/O LIST EXHAUSTED + SPA CLA /WRITE? + JMS UDOIO /YES - WRITE OUT THE LAST BUFFER + JMP I [ENDIO /RESTORE DSRN ENTRY AND QUIT + +RECCTR, 0 + /DIRECT-ACCESS I/O + +RWDACC, JMS I [RWINIT /"READ(N'R)" OR "WRITE(N'R)" + 1000 /DIRECT ACCESS IS UNFORMATTED I/O + TAD I XR + DCA T /GET BLOCKS/RECORD FACTOR FROM D.A. TABLE + JMS I [ARGLD /GET RECORD NUMBER + JMS I [FFIX /CONVERT TO INTEGER + TAD T + TAD ACI + ISZ T /MULTIPLY RECORD NUMBER BY BLOCKS/RECORD + JMP .-2 /TO GET RELATIVE BLOCK NUMBER + DCA RELBLK + TAD I XR + SNA /THIS LOC SHOULD NOT BE ZERO! +DAERR, JMS I ERR + DCA FGPBF /IT SHOULD BE AN FSTA + THE FIELD + TAD I XR /IN WHICH THE CONTROL VARIABLE IS + DCA BIOPTR /STORED. THE NEXT WORD IS THE ADDRESS + JMS I [FPGO /OF THE CONTROL VARIABLE IN THAT FIELD + FADD1 /ADD 1 TO RECORD # AND STORE IN CONTROL VAR + TAD DUMPIT /*K* "DCA T" SAME AS "CLA" HERE + JMP UNFIO /NOW GO DO A REGULAR BINARY READ/WRITE + +UDOIO, 0 + ISZ RECCTR /BUMP NUMBER OF RECORDS TRANSFERRED + TAD BADFLD + AND [7400 + TAD [377 /FORM POINTER TO LAST WORD IN BUFFER + DCA BIOPTR + TAD RECCTR + JMS BUFFLD + DCA I BIOPTR /FOR WRITE, PUT RECORD NUMBER IN 256TH WORD +UDOIOL, DCA CHRPTR + AC4000 + AND RWFLAG + JMS I [MASSIO /DO I/O (CHRPTR=0 TO FORCE I/O) + JMS BUFFLD + TAD RECCTR + CMA STL /FOR READ, CHECK THE INPUT + TAD I BIOPTR /SEQUENCE NUMBER TO MAKE SURE IT IS + CDF 0 /NO LARGER THAN THE ONE WE EXPECT. +SEQCHK, SZL CLA /*K* IF IT IS LARGER THIS IMPLIES THAT WE + JMP I UDOIO /ARE STILL IN THE MIDDLE OF THE LAST + JMP UDOIOL /RECORD AND SO WE READ AGAIN. + /DEFINE FILE PROCESSOR + +DFINE, JMS I [RWINIT /SET UP A POINTER INTO THE D.A. TABLE + 1000 /DIRECT ACCESS I/O IS UNFORMATTED + JMS I [ARGLD /GET NUMBER OF RECORDS + JMS I [FFIX + TAD ACI + CIA +DUMPIT, DCA T /SAVE IT FOR MULTIPLY + JMS I [ARGLD /GET THE NUMBER OF WORDS/RECORD + JMS I [FPGO /CONVERT WORDS TO BLOCKS + FWTOBL + JMS I [FFIX /CONVERT TO INTEGER + ISZ ACI + TAD ACI /MULTIPLY THE NUMBER OF BLOCKS/RECORD + ISZ T /BY THE NUMBER OF RECORDS + JMP .-2 + DCA RELBLK /TO GET THE FILE LENGTH IN BLOCKS + TAD ACI + CIA + DCA I XR /STORE NUMBER OF BLOCKS/RECORD + JMS I [ARGLD /GET POINTER TO CONTROL VARIABLE + TAD FGPBF + TAD (FSTA-FLDA /CHANGE A LOAD TO A STORE + DCA I XR /SAVE "FSTA CONTROL-VARIABLE" + TAD BIOPTR + DCA I XR + TAD TOTBLK + CMA CLL + TAD RELBLK /MAKE SURE WE HAVE ROOM FOR THE FILE +SZLCLA, SZL CLA +DFERR, JMS I ERR /WE DON'T + AC7776 + AND FFLAGS + IAC /FORCE "END-FILED" BIT FOR CLOSE + JMP I (SETTOT /SET LENGTH AND EXIT + PAGE + /SWAPPER AND ERROR ROUTINE + +SWAP, JMS I [FETPC /SWAPPER CALLING SEQUENCE: + DCA T / TRAP3 SWAP + TAD T / ADDR OVLY*4000000+LVL*100000+ENTRYADR + AND [7 + TAD (JA + DCA STRTUP /STORE JA TO ENTRY POINT + JMS I [FETPC + DCA STRTUP+1 + TAD T + AND [70 + CLL RAR /FORM 4*LVL + TAD (OVLYTB /INDEX INTO LEVEL TABLE + DCA ADR + TAD T + AND [7400 + DCA T /T CONTAINS OVERLAY NUMBER IN BITS 0-3 + CDF 0 /WATCH D.F.! + TAD I ADR + TAD T /SEE IF THIS OVERLAY IS IN CORE + SNA CLA + JMP ITSIN /YES - DON'T LOAD + TAD T + CIA + DCA I ADR /MARK THIS OVERLAY IN CORE (OPTIMIST) + ISZ ADR + TAD I ADR + AND [7400 + DCA OVADR /SAVE INITIAL OVERLAY LOAD ADDRESS + TAD I ADR + AND [70 + DCA OVIOW /AND FIELD + ISZ ADR + TAD I ADR /GET STARTING BLOCK OF THIS LEVEL + DCA OVBLK + ISZ ADR + TAD I ADR + DCA OVLEN /STORE LENGTH OF OVERLAY IN BLOCKS +OVADLP, TAD T /LEVEL STARTING BLOCK + + SNA /(OVERLAY #) * (OVERLAY LENGTH) + JMP LOADOV /= OVERLAY STARTING BLOCK + TAD [7400 + DCA T + TAD OVBLK + TAD OVLEN + DCA OVBLK + JMP OVADLP + /SWAPPER - CONTINUED + +LOADLP, DCA OVLEN /STORE UPDATED OVERLAY LENGTH + TAD OVIOW /GET LAST READ CONTROL WORD + RAL + AND [7400 /CONVERT BLOCK COUNT TO WORD COUNT + TAD OVADR /INCREMENT OVERLAY LOAD ADDRESS (LINK = 0) + DCA OVADR + RTL + RTL /USE THE CARRY + TAD OVIOW /TO INCREMENT THE LOAD FIELD IF NECESSARY + AND [70 + DCA OVIOW /OVIOW CONTAINS ONLY THE LOAD FIELD NOW + +LOADOV, TAD OVADR + CIA /LOTSA CALCULATIONS HERE - OS/8 HANDLERS + SNA /CAN'T READ MORE THAN 15 BLOCKS AT A TIME + TAD [7400 /AND CANNOT READ OVER FIELD BOUNDARIES + CLL RTL + RTL /SO WE MUST BREAK UP THE OVERLAY READ + CMA CML RAL /INTO SEVERAL SMALL READS OF MAXIMAL LENGTH. + TAD OVLEN /THE NUMBER OF BLOCKS TO READ IS GIVEN BY: + CMA /MINIMUM(B,L,15) + SMA /WHERE B IS THE # OF BLOCKS LEFT IN THIS FIELD + CLA /AND L IS THE # OF BLOCKS LEFT IN THE OVERLAY + TAD OVLEN /AND 15 IS THE # OF BLOCKS A HANDLER CAN READ + DCA T / ANSWER IN T + TAD T + CLL RTR + RTR + RTR /TURN NUMBER OF BLOCKS INTO 0S/8 BLOCK COUNT + TAD OVIOW + DCA OVIOW /ADD FIELD BITS AND STORE AS I/O CONTROL WD + TAD OVHCDW /GET OVERLAY HANDLER CODE WORD + JMS I (GETHND /LOAD HANDLER INTO FIELD 0 + JMS I OVHND +OVIOW, 0 +OVADR, 0 +OVBLK, 0 +OVERR, JMS I ERR /WHOOPS - OVERLAY READ ERROR + JMS RECOVR /CLEAR ANY NASTY FLAGS LEFT BY HANDLER + TAD T + TAD OVBLK + DCA OVBLK /UPDATE BLOCK NUMBER + TAD T + CIA + TAD OVLEN /BUMP DOWN RECORD COUNT + SZA /SEE IF WE ARE DONE + JMP LOADLP /NO - PREPARE FOR NEXT READ + /OVERLAY IN CORE - EXECUTE IT + +ITSIN, JMS I [FPGO /START UP FPP + STRTUP /AND JA TO ENTRY POINT + +TRAP5I, +TRAP6I, +TRAP7I, +FPAUSE, +FPPERR, JMS I ERR /SHOULD NEVER GET HERE + +STRTUP, 0;0 /JA ENTRY +OVLEN, 0 +OVHND, 0 /SET BY LOADER +OVHCDW, 0 /SET BY LOADER + +RECOVR, 0 /ROUTINE TO CLEAN UP ANY FLAGS + DCA CTCINH /LEFT ON BY SLOPPY OS/8 HANDLERS. +YRCOVR, NOP + NOP + NOP + NOP /RIGHT NOW I DON'T KNOW OF ANY. + NOP + NOP + NOP + NOP + ION + JMP I RECOVR + +FSTTMP, FSTA+LONG + FTEMP + FEXIT + +TEN, 4;2400;0;0;0;0 /10.0D0 +FLTG85, 7;2520;0 /85.0 + PAGE + /INPUT BUFFER - CONTAINS STARTUP CODE + +INBUFR, -206 /LENGTH + 0 /INPUT LINE BUFFER - FIRST A LITTLE PADDING, + +/RTS EXECUTION INITIALIZATION - IN INPUT BUFFER + +FPSTRT, 6601 /CLEAR DF32 FLAG + PCF /HSP FLAG + RRB /HSR FLAG +PP7600, 7600 /CLEAR READER CHAR + 6135 /CLEAR KW12 OR DK8-EP EVENT FLAGS + CLA + 6132 /STOP KW12 CLOCKS + 6134 /DISABLE KW12 INTERRUPTS + 6530 /CLEAR AD8-EA FLAGS + 6050 /CLEAR VC8/E FLAG + 6500 /DISABLE XY8/E INTERRUPTS + STA + 6130 /DISABLE DK8-EP INTERRUPTS + CLA /LEAVE SPACE FOR ADDITIONAL CLEARS + NOP + NOP + NOP + NOP + NOP + NOP + NOP + NOP + NOP + NOP + NOP + DCA EOLSW +LDPROG, JMS I [FPGO /START UP FPP OR PSEUDO-FPP + STSWAP +HLTNOP, NOP /SET TO HLT IF /H SPECIFIED, + JMP PRTCR /SKP IF /P SPECIFIED + TAD .-1 + DCA LDPROG /BYPASS LOADING ON STARTUP + TAD PCHWD /HLT + DCA I (PDPXIT+1 + /ROUTINE TO PUNCH RTS+PROGRAM ON FORTRAN UNIT 9 (UNCOMMENTED) + +PPTR, TAD P11 +PCKSUM, DCA ACI + JMS I (LDDSRN + SMA CLA + JMP I [UNTERR + JMP LDRTLR +FLDLP, DCA PPTR + DCA PCKSUM + TAD (100 + JMS SIXOUT + JMS SIXOUT + TAD FLD + AND [70 +JFMOUT, JMS I [FMTOUT /*K* ONLY WORKS FOR FIELD 0-3 + TAD (100 + JMS SIXOUT + JMS SIXOUT +FLD, CDF 0 + TAD I PPTR + CDF 0 + JMS PCHWD + ISZ PPTR +P11, 11 + ISZ PCTR + JMP FLD + TAD PCKSUM + JMS PCHWD + TAD FLD + TAD (10 + DCA FLD +LDRTLR, TAD PP7600 + DCA ACH + TAD [200 + JMS SIXOUT + ISZ ACH + JMP .-3 + ISZ FCNT + JMP FLDLP + TAD (6000 + DCA FFLAGS + DCA I (ENDFLS /*K* SAME KLUDGE AS CALXIT + JMS I (ENDFL + DCA I (PDPXIT+1 /WIPE HALT SO WE CAN RETURN TO OS/8 + JMP I (PDPXIT-1 + PCHWD, HLT + DCA ACH + TAD ACH + RTR + RTR + RTR + AND [77 + JMS SIXOUT + TAD ACH + AND [77 + JMS SIXOUT + JMP I PCHWD + +SIXOUT, 0 + DCA T + CLA IAC + DCA EOLSW + TAD PCKSUM + TAD T + DCA PCKSUM + TAD T + TAD (-300 + JMS I [FMTOUT + JMP I SIXOUT + +PCTR, 200 /DON'T PUNCH 07600! +FCNT, 0 + PRTCR, TAD (215 + JMS I PTTY /PRINT CARRIAGE RETURN + TAD JFMOUT + DCA I (ERRENB /ENABLE ERROR TRACEBACK + JMS I [FPGO + STJUMP /NOW JUMP TO THE NEWLY-LOADED CODE +STSWAP, TRAP3 /TRAP3 + SWAP + 0 + .+1 + TRAP3 + HLTNOP + PAGE +STJUMP, 0 + 0 + ZBLOCK INBUFR+210-. /PAD OUT TO END OF BUFFER + /OVERLAY AND DSRN TABLES + + *.-4 /FIRST ENTRY IN OVLYTB ONLY NEEDED TO LOAD MAIN PGM + +OVLYTB, ZBLOCK 40 /OVERLAY TABLE + +DSRN, PTR; ZBLOCK 10 + PTP; ZBLOCK 10 + LPT; ZBLOCK 10 + TTY; 0;0 + 1234 /*K* PREVENT PROBLEM IN + ZBLOCK 5 /RWINIT INVOLVING WRITE + /AFTER READ ON TELETYPE + ZBLOCK 55 + + ZBLOCK 12 /FORMAT PARENTHESIS PUSHDOWN LIST +FMTPDL, 0 /GUARD WORD + PAGE + /SOFTWARE FLOATING POINT ROUTINES WHICH ARE USED +/EVEN IF FLOATING HARDWARE IS PRESENT + +/** MUST NOT DESTROY FAC! ** + +FFIX, 0 /ROUTINE TO FIX FAC + STA /ANSWER IS RETURNED IN ACI +TADACX, TAD ACX /ABS(FAC) MUST BE LESS THAN 2048 + CLL /DETERMINE IF FAC EXPONENT IS + TAD (-13 /BETWEEN 1 AND 14 + SNA + JMP FIXBIG /14 IS A SPECIAL CASE +EAEFIX, DCA ACI + SZL + JMP FIXDNE /EXP GT 14 OR LT 1 - RETURN 0 + TAD ACH + JMP FIXISZ +FIXLP, CLL /0 IN LINK + SPA /IS IT LESS THAN 0? + CML /YES-PUT A 1 IN LINK + RAR /SCALE RIGHT +FIXISZ, ISZ ACI /DONE YET? + JMP FIXLP /NO +FIXDNE, DCA ACI /RETURN WITH ANSWER IN ACI + JMP I FFIX /RETURN + +FIXBIG, TAD ACL /IF EXP IS 14 WE MUST SHIFT AC FRACTION + RAL /LEFT ONE PLACE TO INTEGERIZE IT. + CLA + TAD ACH + RAL + JMP FIXDNE /STORE ANSWER AND RETURN + +SETB, TAD DATAF + DCA I (BASCDF /SET BASE PAGE LOCATION + TAD ADR + DCA BASADR + JMP I FPNXT + / +/SHIFT FAC LEFT 1 BIT +/ +AL1, 0 + TAD AC1 /GET OVERFLOW BIT + CLL RAL /SHIFT LEFT + DCA AC1 /STORE BACK + TAD ACL /GET LOW ORDER MANTISSA + RAL /SHIFT LEFT + DCA ACL /STORE BACK + TAD ACH /GET HI ORDER + RAL + DCA ACH /STORE BACK + JMP I AL1 /RETN. +/ +/SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE) +/ +ACSR, 0 + CMA /AC CONTAINS COUNT-1 + DCA AC0 /STORE COUNT +LOP1, TAD ACH /GET HIGH ORDER MANTISSA + CLL + SPA /PROPAGATE SIGN + CML + RAR /SHIFT RIGHT 1, PROPAGATING SIGN + DCA ACH /STORE BACK + TAD ACL /GET LOW ORDER + RAR /SHIFT IT + DCA ACL /STORE BACK + ISZ ACX /INCREMENT EXPONENT + NOP + ISZ AC0 /DONE? + JMP LOP1 /NO-LOOP + RAR + DCA AC1 /SAVE 1 BIT OF OVERFLOW + JMP I ACSR /YES-RETN-AC=L=0 +/ +/FLOATING NEGATE +/ +FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE) + TAD ACL /GET LOW ORDER FAC + CLL CMA IAC /NEGATE IT + DCA ACL /STORE BACK + CML RAL /ADJUST OVERFLOW BIT AND + TAD ACH /PROPAGATE CARRY-GET HI ORD + CLL CMA IAC /NEGATE IT + DCA ACH /STORE BACK + JMP I FFNEG + OADD, 0 /ADD OPERAND TO FAC + CLL + TAD AC2 /ADD OVERFLOW WORDS + TAD AC1 + DCA AC1 + RAL /ROTATE CARRY + TAD OPL /ADD LOW ORDER MANTISSAS + TAD ACL + DCA ACL + RAL + TAD OPH /ADD HI ORDER MANTISSAS + TAD ACH + DCA ACH + JMP I OADD /RETN. + +FETPC, 0 + ISZ PC + JMP PCCDF /NO FIELD BUMP + ISZ APT /BUMP FIELD FOR FPP RESTART (IN CASE FPP EXISTS) +FPC10, 10 /PROTECTION FOR ISZ + TAD PCCDF + TAD FPC10 + DCA PCCDF +PCCDF, HLT + TAD I PC + JMP I FETPC + +EEPUT, STL /EXTENDED PRECISION STORE +EEGET, DCA ADR /EXTENDED PRCISION FETCH + TAD [-6 + DCA DATCDF + SNL + AC2000 /SET UP "TAD ACX" OR "DCA ACX" + TAD TADACX + DCA EEINST +EELOOP, SNL /LINK=1 MEANS STORE + TAD I ADR +EEINST, HLT + SZL + DCA I ADR + ISZ ADR + SKP + JMS I (DFBUMP + ISZ EEINST + ISZ DATCDF + JMP EELOOP + JMP I FPNXT + +FSTTM2, FSTA+LONG + FTEMP2 + FEXIT +/ +FTEMP, ZBLOCK 6 +/ + PAGE + /RUN-TIME SYSTEM ERROR LIST + +ERRLST, VARGER; ARGMSG + UERR; UMSG + FPOERR; FPOMSG + FMTERR; FMTMSG + UNTERR; UNTMSG + CTLBER; CTLBMS + INER; INMSG + IOVFLO; IOVMSG + IOERR; IOMSG + DAERR; DAMSG + FPPERR; FPPMSG + OVERR; OVMSG + EOFERR; INEMSG + FPOVER; OFLMSG + DFERR; DFMSG + -1; DV0MSG /BY ELIMINATION + /RTS ERROR MESSAGES + +ARGMSG, TEXT /BAD ARG/ +UMSG, TEXT /USER ERROR/ +FPOMSG, TEXT /PARENS TOO DEEP/ +FMTMSG, TEXT /FORMAT ERROR/ +UNTMSG, TEXT /UNIT ERROR/ +INMSG, TEXT /INPUT ERROR/ +OVMSG, TEXT /OVERLAY / + *.-1 +IOMSG, TEXT %I/O ERROR% +DAMSG, TEXT /NO DEFINE FILE/ +FPPMSG, TEXT /FPP ERROR/ +INEMSG, TEXT /EOF ERROR/ +DV0MSG, TEXT /DIVIDE BY 0/ +DFMSG, TEXT /D.F. TOO BIG/ +IOVMSG, TEXT /FILE / + *.-1 +OFLMSG, TEXT /OVERFLOW/ +CTLBMS, TEXT /^B/ + +USRERR, TAD ERRFLG /USER ERROR - OPTIONALLY NON-FATAL + DCA FATAL +UERR, JMS I ERR /PRINT MESSAGE + JMP I [RETURN /IF NON-FATAL, CONTINUE PROCESSING +ERRFLG, 0 /SET TO NON-ZERO IF /E SWITCH SPECIFIED + +TRPPRT, TRAP3 /CODE WHICH IS LOADED INTO PROGRAM PROLOGUES + PRTNAM /BY THE ERROR TRACEBACK ROUTINE + PAGE + MAKCDF, 0 /ROUTINE TO MAKE A CDF FROM AC9-11 + RTL + RAL + AND [70 + TAD ERCDF /STRAIGHTFORWARD ENOUGH, ISN'T IT? + JMP I MAKCDF + +RD2WR, 0 /ROUTINE CALLED WHEN SWITCHING + STA /FROM READ TO WRITE. (CALLED ONLY ONCE!) + TAD RELBLK /BUMP BLOCK # BACK FROM "NEXT BUFFER'S BLOCK #" + DCA RELBLK /TO "THIS BUFFER'S BLOCK #". + TAD CHRCTR /HOWEVER, IF WE ARE AT THE VERY END OF A + IAC /BUFFER, WRITE ROUTINE EXPECTS US TO + SZA CLA /BE AT THE BEGINNING OF THE NEXT BUFFER, + JMS I [MASSIO /SO RE-READ THIS BUFFER AND SET POINTERS + JMP I RD2WR + +/RUN-TIME-SYSTEM ERROR ROUTINE + +ERROR, 0 +ERCDF, CDF 0 + CLA + TAD (ERRLST-2 + DCA XR +ERRLP, ISZ XR /SEARCH ERROR LIST FOR CALLING ADDRESS + TAD I XR /ERROR LIST CONTAINS + CMA + SZA /CALLING ADDRESSES AND + TAD ERROR /CORRESPONDING MESSAGES + SZA CLA + JMP ERRLP + TAD I XR + DCA I (FMTADR + DCA I (FMTDF + TAD PTTY + DCA HAND /QUICK FUDGE FOR TTY OUTPUT + DCA HCODEW /TO SET CARRIAGE CONTROL + AC4000 + DCA RWFLAG + JMS I [EOLINE /TYPE CARRET AND SET EOLSW + DCA FMTBYT /INITIALIZE MESSAGE PTR +ERPTLP, JMS I [FMTOUT /OUTPUTS LF FIRST TIME + JMS I [FMTGCH /GET CHAR USING FORMAT ROUTINES + ISZ FMTBYT + SZA + JMP ERPTLP /LOOP UNTIL 0 CHAR + /PRINT ROUTINE NAME AND LINE NUMBER + +PRTNAM, TAD [40 +ERRENB, JMP I E7605 /*K* IN CASE INITIALIZATION OR /P GET ERRORS +/ PREVIOUS LINE REPLACED WITH: +/ JMS I [FMTOUT /OUTPUT A BLANK(LF ON EXTRA LINES) + JMS I [FPGO /START UP FPP + GTNMPT /GET POINTER TO NAME IN FAC + TAD ACH + DCA I (FMTDF /SET UP FORMAT GET CHARACTER ROUTINE + TAD ACL /TO GET CHARACTERS OF ROUTINE NAME + DCA I (FMTADR + DCA FMTBYT + TAD [-6 + DCA ISN /6 CHARACTER NAME +PRTNML, JMS I [FMTGCH + SNA + TAD [40 /AVOID PRINTING RANDOM @S + JMS I [FMTOUT /GET AND PRINT A CHARACTER + ISZ FMTBYT + ISZ ISN + JMP PRTNML + TAD [40 + JMS I [FMTOUT /SEPARATE THE NAME BY A SPACE + TAD [-4 /FROM THE LINE NUMBER. + DCA ISN +PTLNLP, TAD ISN+1 + CLL RTL + RAL + DCA ISN+1 /PRINT LINE NUMBER IN OCTAL + TAD ISN+1 /BECAUSE THAT IS THE WAY IT APPEARS + RAL /IN THE FORTRAN PROGRAM LISTING + AND [7 + JMS I (DIGIT + ISZ ISN + JMP PTLNLP + + JMS I [EOLINE /OUTPUT FINAL CR + TAD FATAL + SNA CLA /FATAL ERROR? + JMP TRCBAK /YES - GIVE FULL TRACEBACK + DCA FATAL /"NON-FATAL" FLAG MUST BE SET EACH TIME + JMP I ERROR +TRCBAK, JMS I [FPGO /START UP FPP + UP1LEV /MOVE UP TO CALLING ROUTINE + /FPP CODE DOES A "TRAP3 PRTNAM" +ISN, 0;0 + /FPP CODE FOR ERROR ROUTINE + +GTNMPT, STARTD + XTA 0 /LOAD LINE NUMBER FROM XR 0 + FSTA+LONG + ISN /STORE AWAY + FLDA+BASE 10 /LOAD POINTER TO PROLOGUE + FSUB+LONG + THREE /NAME IS 3 LOCATIONS BEFORE PROLOGUE + STARTF /FOR NON-FPP VERSION +THREE, FEXIT;3 /*K* DEPENDS ON FACT THAT FEXIT=0 + +UP1LEV, STARTD + FLDA+BASE 11 /GET THE UPWARD POINTER + JNE + NOTMN /ZERO MEANS MAIN PROGRAM + TRAP3 +E7605, 7605 /GO AWAY IF MAIN PROGRAM +NOTMN, FSTA+BASE 0 + LDX 1 + 2 /WE WILL STORE A "TRAP3 PRTNAM" + FLDA+LONG /IN THE FIFTH LOCATION OF THE PROLOGUE, + TRPPRT + FSTA+IND 0+10 /WHERE THE FIRST 4 LOCS WERE A SETX AND SETB. + FLDA+BASE 0 /GET THE PROLOGUE ADDRESS AGAIN + JAC /JUMP TO IT. + +ACMDGT, FMUL+LONG + TEN + FSTA+LONG + FTEMP + FLDA+LONG + DGT /GET UNNORMALIZED DIGIT INTO AC + FNORM /NORMALIZE IT +FADTMP, FADD+LONG + FTEMP + FEXIT +LPBUFR, ZBLOCK 4 + LPBUF2 + PAGE + HPLACE, /ZBLOCK 400 /HANDLER SWAP AREA + +/VARIOUS INITIALIZATION STUFF OVERLAYING THE RTS HANDLER AREA + +QLHDR, 0 /SHOULD BE A 2 FOR A LOADER IMAGE +QRTSWP, ZBLOCK 2 /INITIAL SWAP ARGS TO LOAD USER MAIN +QHGHAD, ZBLOCK 2 /HIGHEST ADDRESS USED +QVERNO, 0 /LOADER VERSION # +QDPFLG, 0 /"PROGRAM USES D.P." FLAG +QUSRLV, ZBLOCK 40 /USER OVERLAY INFO + +/EAE OVERLAY TO FIX AND FLOAT + +EFXFLT, RELOC EAEFIX + +FIXEAE, CMA + DCA FIXSH /SHIFT COUNT BETWEEN 0 AND 12 + SZL + JMP FIX0 /NOT INTEGERIZABLE + TAD ACH + ASR +FIXSH, 0 +FIX0, DCA ACI + JMP I FFIX + +FXFLTC= .-FIXEAE + RELOC + /SUBR TO DETERMINE MACHINE SIZE - RETURNS NUMBER OF +/BANKS IN AC. +/MUST RUN IN FIELD 0. + +CORE, 0 + TAD C6203 + RDF + DCA CORRET +CORELP, CDF 0 /NEEDED FOR PDP-8L + TAD I C7777 + AND COR70 /IF BITS 6-8 OF LOCATION 7777 ARE NOT ZERO, + CLL RTR /THEY SPECIFY THE LAST FIELD OF CORE + RAR /WHICH WE SHOULD USE. + SZA + JMP CORRET /SO RETURN THAT AMOUNT + TAD TRYFLD /GET FLD TO TST + CLL RTL + RAL + AND COR70 /MASK USEFUL BITS + TAD CORELP + DCA COR706 /SET UP CDF TO FLD +COR706, 0 + TAD I CORLOC /SAV CURRENT CONTENTS + NOP /HACK FOR PDP-8 + DCA .-3 + TAD .-2 /7000 IS A GOOD PATTERN + DCA I CORLOC +COR70, 70 /HACK FOR PDP-8.,NO-OP + TAD I CORLOC /TRY TO READ BK 7000 +CO7400, 7400 /HACK FOR PDP-8,.NO-OP + TAD CO7400 /GUARD AGAINST WRAP AROUND + TAD CORLOC+1 /TAD 1400 + SZA CLA + JMP .+5 /NON EXISTENT FLD EXIT + TAD COR706 /RESTORE CONTENS DESTROYED + DCA I CORLOC + ISZ TRYFLD /TRY NXT HIGHER FLD + JMP CORELP + STA + TAD TRYFLD +CORRET, 0 + JMP I CORE +CORLOC, CO7400 /ADR TO TST IN EACH FLD + 1400 /7000+7400+1400=0 +TRYFLD, 1 /CURRENT FLD TO TST +C6203, 6203 +C7777, 7777 + +DPTEST, STARTE /EXECUTED BY FPP DURING INITIALIZATION + FEXIT /CHECK WHETHER DOUBLE PRECISION ENABLED + /TABLE OF MODIFICATIONS TO MAKE TO FRTS FOR BACKGROUND OPERATION +/UNDER RTS-8. FORMAT OF TABLE IS: POINTER TO FIRST WORD OF BLOCK - 1 +/ (0 TERMINATES) FOLLOWED BY LIST OF REPLACEMENT WORDS (0 TERMINATES). + +BKRLST, YLPT-1 /LINE PRINTER OUTPUT ROUTINE + RELOC YLPT + LLS + CLA /DON'T DO RING-BUFFERING - JUST "OUTPUT" CHAR. + JMS CTCBCK /CHECK FOR ^C OR ^B + JMP I LPT +FJCTCT, JMS CTCBCK /COME HERE FROM INTERPRETED FPP JUMPS + JMP I FPNXT /CHECK FOR ^C,^B AND RETURN TO INTERPRETER + RELOC + 0 + + YPTP-1 /PAPER-TAPE PUNCH ROUTINE + CLA /ALL PAPER-TAPE I/O ILLEGAL + 0 + YPTR-1 /PAPER TAPE READER ROUTINE + CLA /ALL PAPER-TAPE I/O ILLEGAL + 0 + + YTTY-1 /TELETYPE INPUT/OUTPUT ROUTINE + RELOC YTTY + SNA + JMP KBDRTS /AC=0 MEANS INPUT + TSF + JMP .-1 /HANG UNTIL OUTPUT BUFFER NOT FULL + TLS + CLA + JMS CTCBCK /CHECK FOR ^C OR ^B TYPED + JMP I TTY +KBDRTS, KSF + JMP .-1 /HANG UNTIL CHAR RECEIVED + JMS CTCBCK /CHECK FOR ^C OR ^B + KRB + AND KB177 /STRIP PARITY + TAD KB177 + IAC /NOW FORCE PARITY BIT ON (177+1=200) + JMP I TTY + +CTCBCK, . /*K* CAN'T BE 0! + KRS /PEEK AT NEXT CHAR IN BUFFER + AND KB177 + TAD KBM2 + CLL RAR + SNA CLA /IS IT ^C OR ^B? + KSF /AND IS IT REALLY PENDING? + JMP I CTCBCK /NO - JUST RETURN WITH AC=0 + JMP BEEORC /TERMINATE JOB - LINK HAS ^C/^B FLAG +KB177, 177 +KBM2, -2 + RELOC + 0 + /CONTINUATION OF TABLE OF RTS-8 OVERLAYS TO FRTS + + YHIOF-1 /"GET OS/8 HANDLER" ROUTINE + NOP /ELIMINATE "IOF" INSTRUCTION + 0 + + YRCOVR-1 /"RECOVER FROM OS/8 HANDLER" ROUTINE + RELOC YRCOVR + JMP I RECOVR /SHORT-CIRCUIT PORTION OF ROUTINE WHICH DOES + RELOC /AN "ION" + 0 + + YFJMP-1 /FPP INTERPRETER - SUCCESSFUL JUMP SECTION + FJCTCT /TEST FOR ^C OR ^B TYPED BEFORE + 0 /RETURNING TO THE INTERPRETER + + 0 /** LIST TERMINATOR ** + /ERROR MESSAGES FOR RUN-TIME LOADER - IN HANDLER BUFFER +/*K* CANNOT LOAD BELOW HPLACE+200 AS HPLACE-HPLACE+177 ARE DESTROYED BY HEADER! + + IFNZRO .-HPLACE-200&4000 <__ERROR__> + +NOLI, TEXT /NOT A LOADER IMAGE/ +NONMSG, TEXT /NO NUMERIC SWITCH/ +FILMSG, TEXT /FILE ERROR/ +SYSMSG, TEXT /SYSTEM DEVICE ERROR/ +TOOMCH, TEXT /MORE CORE REQUIRED/ +TOMNYH, TEXT /TOO MANY HANDLERS/ +LIOEMS, TEXT /CAN'T READ IT!/ +NODPMS, TEXT /CAUTION - NO DP/ +XVERMS, TEXT /FRTS V/ + *.-1 + XVERSN&70^7+XVERSN+4060 /VERSION NUMBER IN SIXBIT + XPATCH&77^100+40 /PATCH LEVEL + TEXT / / + PAGE + /FPP INTERPRETER STARTUP ROUTINE + +FPPINT= . /FOR FPP OVERLAY +RETURN, JMP I FPNXT /RETURN DOES SOMETHING DIFFERENT IF FPP PRESENT + +FPGO, 0 +FPGCDF, CDF 0 /NECESSARY? + CLA + TAD PC + DCA SAVPC /ALLOW ONE LEVEL OF RECURSIVENESS + TAD I (PCCDF + DCA SPCCDF + STA + TAD I FPGO + DCA PC + ISZ FPGO + TAD FPGCDF /FPGO STARTS UP THE FPP FROM FIELD 0 ONLY + DCA I (PCCDF + JMP I FPNXT + +EXIT, TAD SAVPC + DCA PC + TAD SPCCDF + DCA I (PCCDF /RESTORE OLD PC + JMP I FPGO /RETURN TO PDP-8 CODE +SAVPC, 0 +SPCCDF, 0 + +FPXTA, TAD [27 /XR TO AC - NORMALIZE IF FLOATING MODE + DCA ACX + JMS DATCDF + TAD I ADR +CLFAC, DCA ACL + TAD ACL + SPA CLA /SIGN-EXTEND 12-BIT WORD + STA /INTO FAC FRACTION + DCA ACH +NRMFAC, DCA AC1 /CLEAR OVERFLOW WORD + TAD DFLG + SPA SNA CLA /UNLESS WE ARE IN D.P.I. MODE, + JMS I NORMX /NORMALIZE THE FAC + JMP I FPNXT + /MISCELLANEOUS JUMP CLASS INSTRUCTIONS + +JSA, TAD ADR + DCA PUTM + TAD DATAF + DCA JSCDF /SET UP LOC TO SAVE PC IN + AC0002 + TAD ADR + DCA ADR /BUMP ADDRESS BY 2 + RTL + RTL + TAD DATAF + DCA DATAF /INCLUDING DATA FIELD +JSAR, TAD I (PCCDF /JSA/JSR COMMON CODE + CLL RTR + RAR + ISZ PC /BUMP PC BEFORE STORING + SKP + IAC /INCLUDING FIELD BITS + TAD (JA-2620 /FORM "JA" INSTRUCTION +JSCDF, HLT + DCA I PUTM + ISZ PUTM + SKP + JMS I (DFBUMP /BUMP TARGET ADDRESS + TAD PC + DCA I PUTM + JMP I (DOJMP /NOW JUMP TO DESTINATION + +JSR, CLA CLL IAC + TAD BASADR + DCA PUTM + RTL + RTL + TAD I (BASCDF /SET JSCDF&PUTM TO BASE PAGE LOC +1 + DCA JSCDF + JMP JSAR + +FPJAC, TAD ACL + DCA ADR + TAD ACH + JMS I MCDF + DCA DATAF + JMP I (DOJMP + +SPCATX, TAD ACL + SKP +FPLDX, JMS I [FETPC + JMS DATCDF + DCA I ADR /SET XR TO NEXT INST WD + JMP I FPNXT + /MORE INDEX REGISTER & AC-TO-MEMORY INSTRUCTIONS + +ADDX, JMS I [FETPC + JMS DATCDF + TAD I ADR /ADD NEXT INST WD TO XR + JMP FPLDX+1 + +ATX, TAD DFLG /ATX WORKS DIFFERENTLY IN D.P.I. MODE + SMA SZA CLA + JMP SPCATX + JMS I NORMX /FAC MAY NOT BE NORMALIZED + JMS I [FFIX + TAD ACI + JMP FPLDX+1 + +OPMEM, DCA AD1 /GENERAL AC-TO-MEMORY INTERPRETER + TAD AD1 + DCA AD2 + RDF + CLL RTR + RAR + TAD KLUDGM /FORM FSTA X INSTRUCTION + DCA PUTM + AC2000 + AND INST /TURN OP 5 TO OP 1, + SZA CLA + TAD [3000 / OP 7 TO OP 4. + TAD [3000 + TAD PUTM /STICK IN FIELD BITS + DCA OPM + JMS I [FPGO + KLUDGM + JMP I FPNXT + +KLUDGM, FSTA+LONG + FTEMP /SAVE AC +OPM, 0 +AD1, 0 /PERFORM OP +PUTM, 0 +AD2, 0 /STORE RESULT + FLDA+LONG + FTEMP /RESTORE AC + FEXIT + +NORMX, FFNOR /*K* CHANGED TO EFFNOR IF EAE + PAGE + /MAIN INTERPRETER LOOP + +NEGFAC, JMS I [FFNEG + +ICYCLE, CLA + JMS I [FETPC /GET INST + DCA INST + TAD INST + CLL RTL + RTL + SMA /SKIP IF BASEPAGE ADDRESSING + JMP LONGI + AND [7 + TAD BASJMP + DCA OPJMP /SAVE OPCODE CALL ADDRESS + TAD INST /DATA FIELD IS STILL SET UP + SZL /SO IS LINK (WITH INSTRUCTION BIT 3) + JMP BPAGEI /INDIRECT ADDRESSING + CLL RAL + TAD INST /MULTIPLY BASE OFFSET BY 3 + TAD [200 /ELIMINATE ANY + AND (777 /HIGH ORDER BITS +IMFUDJ, CLL /CLL IAC IF D.P. INTEGER MODE + TAD BASADR /ADD IN BASE PAGE ORIGIN +BASCDF, HLT /CDF TO BASE PAGE FIELD + SZL + JMS DFBUMP /BUMP DF IF ADDITION OVERFLOWED +OPJCLL, CLL +OPJMP, HLT /JMP I EXECUTIONROUTINE + +BPAGEI, AND [7 + DCA ADR + TAD ADR + CLL CML RAL + TAD ADR /FORM 3*OFFSET+1 + TAD BASADR + DCA ADR + RTL + RTL + TAD BASCDF /FORM PROPER CDF + DCA ADDRLO +ADDRLO, HLT /EXECUTE IT + TAD I ADR /GET FIELD BITS OF REAL ADDRESS + DCA ADDRHI /FROM 2D WORD OF BASE PAGE LOC + ISZ ADR + SKP + JMS DFBUMP /WATCH FOR FIELD OVERFLOW + TAD I ADR /GET LOW-ORDER ADDRESS FROM 3D WORD + JMP INDEX /NOW GO DO INDEXING (IF ANY) + /COME HERE IF BIT 4 OF INSTRUCTION IS OFF + +LONGI, AND [7 + SNL /TEST BIT 3 OF INSTRUCTION + JMP I (SPECAL /SPECIAL INSTRUCTION + TAD BASJMP + DCA OPJMP + TAD INST + DCA ADDRHI /HIGH-ORDER ADDRESS BITS IN INST WD + JMS I [FETPC /NEXT INST WORD CONTAINS LOW-ORDER ADDRESS +INDEX, DCA ADDRLO + TAD INST + AND [70 + SNA /IS XR NUMBER 0? + JMP NOINDX /YES - NO INDEXING + JMS DCDIDX /GET XR VALUE (MAYBE INCREMENTED) + AC7775 + TAD DFLG /GET -3 IF F, -2 IF D, -6 IF E MODE + DCA DCDIDX + TAD ADDRLO +XRADLP, CLL + TAD I T + SZL + ISZ ADDRHI + ISZ DCDIDX /ADD THE XR IN THE PROPER NUMBER OF TIMES + JMP XRADLP + DCA ADDRLO +NOINDX, TAD ADDRHI + JMS I MCDF + DCA ADDRHI /TURN HIGH-ORDER ADDRESS INTO A CDF +ADDRHI, HLT /AND EXECUTE IT + TAD ADDRLO + JMP OPJCLL /GO EXECUTE THE INSTRUCTION + +DFBUMP, 0 /BUMP DATA FIELD + DCA DFTMP /SAVE AC + RDF + TAD (CDF 10 + DCA .+1 + HLT + TAD DFTMP /RESTORE AC + JMP I DFBUMP +DFTMP, 0 + DCDIDX, 0 + CLL RTR + RAR + TAD XRBASE /ADD IN BASE ADDRESS OF XR ARRAY +XRCDF, HLT /CDF TO XR ARRAY FIELD + SZL + JMS DFBUMP /OR MAYBE NEXT FIELD + DCA T /SAVE POINTER TO XR + TAD INST + AND DCD100 + SZA CLA /INCREMENT BIT ON? + ISZ I T /YES - BUMP XR +DCD100, 100 /** PROTECTION + JMP I DCDIDX + +BASJMP, JMP I JMPTB1 /JMP I JMPTB2 FOR D.P. MODE + +JMPTB1, FFGET / F MODE (FLOATING POINT) + FFADD + FFSUB + FFDIV + FFMPY + OPMEM /FADDM + FFPUT + OPMEM /FMULM + + DDGET / D MODE ( DOUBLE PRECISION INTEGER) + DDADD + DDSUB + DDDIV + DDMPY + OPMEM /DADDM + DDPUT + OPMEM /DMULM + + EEGET / E MODE ( 6 WD FLOATING POINT) + FFADD + FFSUB + FFDIV + FFMPY + OPMEM + EEPUT + OPMEM + PAGE + /MORE I CYCLE + +SPECAL, SNA + JMP XRINST /OPCODE 0 HAS MANY MANSIONS + TAD SPECOP + DCA SPCJMP /GET OPCODE JUMP ADDRESS + JMS I [FETPC + DCA ADR + TAD INST /ALL OF THESE ARE TWO-WORD INSTRUCTIONS + JMS I MCDF /SO FORM THE ADDRESS NOW + DCA DATAF + CDF 0 + TAD INST +SPCJMP, HLT + +XRINST, TAD INST + AND (7770 + CDF 0 + SNA CLA /IF SUB-OPCODE IS ZERO, + JMP OPERAT /DECODE SUB-SUB-OPCODE + TAD INST + AND [7 + CLL + TAD XRBASE + DCA ADR /COMPUTE INDEX REGISTER ADDRESS + RTL + RTL + TAD I (XRCDF + DCA DATAF +XJCOMN, TAD INST + CLL RTR + RAR + AND [77 /GET OPCODE - HIGH ORDER 2 BITS ARE 0 +OXCOMN, TAD (JMP I SP2 + DCA .+1 /EXECUTE APPROPRIATE JUMP + HLT + +OPERAT, TAD INST + CIA + JMP OXCOMN + +SETX, TAD DATAF /SET XR0 LOC + DCA I (XRCDF + TAD ADR + DCA XRBASE + JMP I FPNXT + /JUMP DECODER + +JUMPS, AND (100 /INSTRUCTION IN AC + CLL RTR /20 IN AC IF NOT COND. JUMP + SZA /IF NOT COND. JUMP, DECODE FURTHER + JMP XJCOMN + TAD INST + AND [70 + CLL RTR + RAR + TAD (CNDSKT + DCA T /INDEX INTO CONDITIONAL SKIP TABLE + TAD I T + DCA CNDSKP + TAD ACH + SZA + JMP CNDSKP + TAD ACL + SZA CLA /IF HIGH ORDER ZERO, AC MIGHT BE UNNORMALIZED. + IAC /USE LOW ORDER ON 0/NOT 0 BASIS +CNDSKP, HLT /TEST AC + JMP I FPNXT /FAILED - DON'T JUMP + +DOJMP, STA CLL + TAD ADR + DCA PC + SNL + TAD (-10 + TAD DATAF + CDF 0 + DCA I (PCCDF /ADDRESS-1 TO PC + JMP I .+1 +YFJMP, ICYCLE /** CHANGED IF RUNNING UNDER RTS-8 + +JXN, AND [70 /GET XR FIELD + JMS I (DCDIDX /GET XR VALUE WITH INCREMENTING + TAD I T + SNA CLA /ZERO? + JMP I FPNXT /YES + JMP DOJMP /JUMP ON INDEX NON-ZERO, RIGHT? + +CNDSKT, SZA CLA /JEQ + SPA CLA /JGE + SMA SZA CLA /JLE + SKP CLA /JA + SNA CLA /JNE + SMA CLA /JLT + SPA SNA CLA /JGT + JMP TSTALN /JAL + +TSTALN, CLA + TAD ACX + TAD (-27 + SPA SNA CLA + JMP I FPNXT + JMP DOJMP + /OPCODE TABLES + +SPECOP, JMP I SPECOP /SPECIAL OPCODE TABLE + JUMPS + JXN + TRAP3I + TRAP4I + TRAP5I + TRAP6I + TRAP7I + + FPJAC + STRTD + STRTF + NRMFAC + NEGFAC + CLFAC + FPAUSE +SP2, EXIT + ALN + ATX + FPXTA + ICYCLE /NOP + STRTE + ICYCLE /UNDEF OP + ICYCLE /" + FPLDX + ADDX + SETX + SETB + JSA + JSR + PAGE + /MISCELLANEOUS OPCODE ROUTINES + +TRAP3I, +TRAP4I, AC0002 + TAD DATAF + DCA .+1 /FORM CDF CIF N + HLT /EXECUTE IT + TAD INST + SMA CLA /TRAP4 JMS'S TO ITS TARGET ADDRESS, + JMP I ADR /TRAP3 JMP'S TO IT + JMS I ADR + JMP I FPNXT + +ALN, TAD ACX /ALIGN SIMULATOR + DCA OPX /SAVE EXPONENT IN CASE WE'RE IN D.I. MODE + TAD DFLG + SMA SZA CLA + DCA ACX /ZERO EXP IF D.I. MODE + JMS DATCDF /SET TO XR FIELD + TAD INST + AND [7 + TAD DFLG /IF WE'RE IN FLOATING POINT MODE, + SNA CLA /AND DOING AN "ALN 0", + TAD [27 /ALIGN UNTIL EXPONENT = 23 + SNA + TAD I ADR /OTHERWISE ALIGN UNTIL EXPONENT = XR VALUE + CDF 0 + CIA + TAD ACX + CMA /FORM DIFFERENCE - 1 + SPA /IF EXPONENT IS LARGER THEN DESIRED EXPONENT, + JMP ALNSHL /SHIFT LEFT + JMS I [ACSR /OTHERWISE SHIFT RIGHT +ALNXIT, TAD DFLG + SPA SNA CLA /IF DOUBLE INTEGER MODE, + JMP I FPNXT + TAD OPX /ALIGNMENT LEAVES THE EXPONENT UNCHANGED + DCA ACX + JMP I FPNXT +ALNSHL, DCA T /STORE SHIFT COUNT + SKP /SHIFT LEFT ONE LESS THAN COUNT + JMS I [AL1BMP + ISZ T + JMP .-2 + JMP ALNXIT /GO TO COMMON CODE + /ARG FETCH SUBROUTINES AND MODE CHANGE OPERATORS + +DARGET, 0 + DCA ADR + TAD DARGET + DCA ARGET + DCA ACX + JMP ARGET2 /FAKE OUT FLOATING POINT ROUTINE + +ARGET, 0 /SUBROUTINE TO FETCH ARG FOR ADD, SUBT, ETC. + DCA ADR /STORE ADDRESS OF OPERAND + TAD I ADR /PICK UP EXPONENT + ISZ ADR /MOVE POINTER TO HI MANTISSA WD + SKP + JMS I (DFBUMP +ARGET2, DCA OPX + TAD I ADR /PICK IT UP + DCA OPH /STORE + ISZ ADR /MOVE PTR. TO LO MANTISSA WD. + SKP + JMS I (DFBUMP /WATCH THOSE FIELD TRANSITIONS! + TAD I ADR /PICK IT UP + DCA OPL /STORE IT + CDF 0 + JMP I ARGET /RETURN + +STRTE, TAD DFLG /START EXTENDED PRECISION MODE + SPA CLA + JMP .+4 /CLEAR EXTENDED FAC + DCA EAC1 /IF NOT ALREADY IN E MODE + DCA EAC2 + DCA EAC3 + AC7775 + DCA DFLG + JMP DFECMN + +STRTD, CLA IAC /START DOUBLE PRECISION INTEGER MODE +STRTF, DCA DFLG /START FLOATING POINT MODE + TAD DFLG +DFECMN, TAD (CLL + DCA I (IMFUDJ /SET D.P.I FUDGE TO "CLL" OR "CLL IAC" + TAD DFLG + SPA + CMA /CHANGE -3 FOR E MODE TO +2 + CLL RTL + RAL + TAD (JMPTB1&177+5600 + DCA I (BASJMP + JMP I FPNXT + /DOUBLE PRECISION INTEGER OPERATORS + +DDSUB, JMS DARGET + JMS I (OPNEG + SKP +DDADD, JMS DARGET + DCA AC1 /CLEAR OVERFLOW JUSTINCASE + JMS I [OADD + JMP I FPNXT + +FFGET, DCA ADR /GET A FLOATING POINT NUMBER + TAD I ADR + DCA ACX /SAVE EXPONENT + ISZ ADR + JMP .+3 /NO FIELD OVERFLOW + JMS I (DFBUMP /BUMP DATA FIELD +DDGET, DCA ADR /SUAVE - ENTRY POINT FOR D.P. INTEGER GET + TAD I ADR + DCA ACH + ISZ ADR + SKP + JMS I (DFBUMP + TAD I ADR + DCA ACL + JMP I FPNXT + +FFPUT, DCA ADR /STORE A FLOATING POINT NUMBER + TAD ACX /GET FAC AND STORE IT + DCA I ADR /AT SPECIFIED ADDRESS + ISZ ADR + JMP .+3 + JMS I (DFBUMP +DDPUT, DCA ADR /ENTRY FOR D.P. INTEGER PUT + TAD ACH + DCA I ADR + ISZ ADR + SKP + JMS I (DFBUMP + TAD ACL + DCA I ADR + JMP I FPNXT + PAGE + FPPKG= . /FOR EAE OVERLAY + +/23-BIT FLOATING PT INTERPRETER +/W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN + +LPBUF2, ZBLOCK 16 + LPBUF3 + +AL1BMP, 0 /*K* UTILITY SUBROUTINE - USED BY INTERPRETER + STA + TAD ACX + DCA ACX + JMS I [AL1 + JMP I AL1BMP + +/FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES +DDMPY, JMS I (DARGET + SKP +FFMPY, JMS I (ARGET /GET OPERAND + JMS MDSET /SET UP FOR MPY-OPX IN AC ON RETN. + TAD ACX /DO EXPONENT ADDITION + DCA ACX /STORE FINAL EXPONENT + DCA MDSET /ZERO TEM STORAGE FOR MPY ROUTINE + DCA AC2 + TAD ACH /IS FAC=0? + SNA CLA + DCA ACX /YES-ZERO EXPONENT + JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR. + TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER + DCA OPL + JMS MP24 + TAD AC2 /STORE RESULT BACK IN FAC + DCA ACL /LOW ORDER + TAD MDSET /HIGH ORDER + DCA ACH + TAD ACH /DO WE NEED TO NORMALIZE? + RAL + SMA CLA + JMS AL1BMP /YES-DO IT FAST + TAD AC1 + SPA CLA /CHECK OVERFLOW WORD + ISZ ACL /HIGH BIT ON - ROUND RESULT + JMP MDONE + ISZ ACH /LOW ORDER OVERFLOWED - INCREMENT HIGH ORDER + TAD ACH + SPA /CHECK FOR OVERFLOW TO 4000 0000 + JMP I (SHR1 /WE HANDLE A SIMILIAR CASE IN FLOATING DIVIDE + CLA + MDONE, DCA AC1 /ZERO OVERFLOW WD(DO I NEED THIS???) + ISZ MSIGN /SHOULD RESULT BE NEGATIVE? + SKP /NO + JMS I [FFNEG /YES-NEGATE IT + TAD ACH + SNA CLA /A ZERO AC MEANS A ZERO EXPONENT + DCA ACX + TAD DFLG + SMA SZA CLA /D.P. INTEGER MODE? + TAD ACX /WITH ACX LESS THAN 0? + SNA + JMP I FPNXT /NO - RETURN + CMA + JMS I [ACSR /UN-NORMALIZE RESULT + JMP I FPNXT /RETURN + /MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE +/ALSO SHIFTS OPERAND ONE BIT TO THE LEFT. +/EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT +/CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND +/DATA FIELD SET PROPERLY FOR OPERAND. + +MDSET, 0 + CLA CLL CMA RAL /SET SIGN CHECK TO -2 + DCA MSIGN + TAD OPH /IS OPERAND NEGATIVE? + SMA CLA + JMP .+3 /NO + JMS I (OPNEG /YES-NEGATE IT + ISZ MSIGN /BUMP SIGN CHECK + TAD OPL /AND SHIFT OPERAND LEFT ONE BIT + CLL RAL + DCA OPL + TAD OPH + RAL + DCA OPH + DCA AC1 /CLR. OVERFLOW WORF OF FAC + TAD ACH /IS FAC NEGATIVE + SMA CLA + JMP LEV /NO-GO ON + JMS I [FFNEG /YES-NEGATE IT + ISZ MSIGN /BUMP SIGN CHECK + NOP /MAY SKIP +LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC + JMP I MDSET +MSIGN, 0 + /24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL +/MULTIPLICAND IS IN ACH AND ACL +/RESULT LEFT IN MDSET,AC2, AND AC1 + +MP24, 0 + TAD (-14 /SET UP 12 BIT COUNTER + DCA OPX + TAD OPL /IS MULTIPLIER=0? + SZA + JMP MPLP1 /NO-GO ON + DCA AC1 /YES-INSURE RESULT=0 + JMP I MP24 /RETURN +MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER +MPLP1, RAR /OF MULTIPLIER AND INTO LINK + DCA OPL + SNL /WAS IT A 1? + JMP MPLP2 /NO - 0 - JUST SHIFT PARTIAL PRODUCT + TAD AC2 /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT + TAD ACL /LOW ORDER + DCA AC2 + CML RAL /*K* NOTE THE "SNL" 5 WORDS BACK! + TAD ACH /HI ORDER +MPLP2, TAD MDSET + RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT + DCA MDSET + TAD AC2 + RAR + DCA AC2 + TAD AC1 + RAR /OVERFLOW TO AC1 + DCA AC1 + ISZ OPX /DONE ALL 12 MULTIPLIER BITS? + JMP MPLP /NO-GO ON + JMP I MP24 /YES-RETURN + PAGE + /DIVIDE-BY-ZERO ROUTINE - MUST BE AT BEGINNING OF PAGE + +DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL + JMS I ERR /GIVE ERROR MSG + TAD DBAD + DCA ACX /RETURN A VERY LARGE POSITIVE NUMBER + AC2000 + JMP FD + +/FLOATING DIVIDE - USES DIVIDE-AND-CORRECT METHOD + +DDDIV, JMS I (DARGET + SKP +FFDIV, JMS I (ARGET /GET OPERAND + JMS I (MDSET /GO SET UP FOR DIVIDE-OPX IN AC ON RETN. + CMA IAC /NEGATE EXP. OF OPERAND + TAD ACX /ADD EXP OF FAC + DCA ACX /STORE AS FINAL EXPONENT + TAD OPH /NEGATE HI ORDER OP. FOR USE + CLL CMA IAC /AS DIVISOR + DCA OPH + JMS DV24 /CALL DIV.--(ACH+ACL)/OPH + TAD ACL /SAVE QUOT. FOR LATER + DCA AC1 + TAD OPL + SNA CLA + JMP DVL2 /AVOID MULTIPLYING BY 0 + TAD (-15 /SET COUNTER FOR 12 BIT MULTIPLY + DCA DV24 /TO MULTIPLY QUOT. OF DIV. BY + JMP DVLP1 /LOW ORDER OF OPERAND (OPL) + +/DIVIDE ROUTINE - (ACH,ACL)/OPH = ACL REMAINDER REM (AC2=0) + +DV24, 0 + TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND + TAD OPH /DIVISOR IN OPH (NEGATIVE) + SZL CLA /IS IT? + JMP DBAD /NO-DIVIDE OVERFLOW + TAD (-15 /YES-SET UP 12 BIT LOOP + DCA AC2 + JMP DV1 /GO BEGIN DIVIDE +DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT + RAL + DCA ACH /RESTORE HI ORDER + TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER + TAD OPH /DIVIDEND + SZL /GOOD SUBTRACT? + DCA ACH /YES-RESTORE HI DIVIDEND + CLA /NO-DON'T RESTORE--OPH.GT.ACH +DV1, TAD ACL /SHIFT FAC LEFT 1 BIT-ALSO SHIFT + RAL /1 BIT OF QUOT. INTO LOW ORD OF ACL + DCA ACL + ISZ AC2 /DONE 12 BITS OF QUOT? + JMP DV2 /NO-GO ON + JMP I DV24 /YES-RETN W/AC2=0 + /DIVIDE ROUTINE CONTINUED + +MP12L, DCA OPL /STORE BACK MULTIPLIET + TAD AC2 /GET PRODUCT SO FAR + SNL /WAS MULTIPLIER BIT A 1? + JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT + CLL /YES-CLEAR LINK AND ADD MULTIPLICAND + TAD ACL /TO PARTIAL PRODUCT + RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER + DCA AC2 /RESULT-STORE BACK +DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER + RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.) + ISZ DV24 /DONE ALL BITS? + JMP MP12L /NO-LOOP BACK + CLL CIA /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC + DCA ACL /NEGATE AND STORE + CML RAL /PROPAGATE CARRY + TAD AC2 /NEGATE HI ORDER PRODUCT + STL CIA + TAD ACH /COMPARE WITH REMAINDER OF FIRST DIV. + SZL /WELL? + JMP DVOPS /GREATER THAN REM.-ADJUST QUOT OF 1ST DIV. + DCA ACH /OK - DO (REM - (Q*OPL)) / OPH +DVL3, JMS DV24 /DIVIDE BY OPH (HI ORDER OPERAND) +DVL1, TAD AC1 /GET QUOT. OF FIRST DIV. + SMA /IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT + JMP FD /NO-ITS NORMALIZED-DONE +SHR1, CLL + ISZ ACL /ROUND AND SHIFT RIGHT ONE + SKP + IAC /DOUBLE PRECISION INCREMENT + RAR + DCA ACH /STORE IN FAC + TAD ACL /SHIFT LOW ORDER RIGHT + RAR + DCA ACL /STORE BACK + ISZ ACX /BUMP EXPONENT + NOP + TAD ACH + JMP DVL1+1 /IF FRACT WAS 77777777 WE MUST SHIFT AGAIN +FD, DCA ACH /STORE HIGH ORDER RESULT + JMP I (MDONE /GO LEAVE DIVIDE + +DVL2, DCA ACL /COME HERE IF LOW-ORDER QUO=0 + JMP DVL3 /SAVE SOME TIME + /ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE +/REMAINDER OF THE FIRST DIVIDE IS LESS THAN QUOT*OPL + +DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER + DCA ACH + CLL + TAD OPH + TAD ACH /WATCH FOR OVERFLOW + SNL + JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV. + DCA ACH /NO OVERFLOW-STORE NEW REM. + CMA /SUBTRACT 1 FROM QUOT OF + TAD AC1 /FIRST DIVIDE + DCA AC1 +DVOP1, CLA CLL + TAD ACH /GET HI ORD OF REMAINDER + SNA /IS IT ZERO? +DVOP2, DCA ACL /YES-MAKE WHOLE THING ZERO + DCA ACH + JMS DV24 /DIVIDE EXTENDED REM. BY HI DIVISOR + TAD ACL /NEGATE THE RESULT + CLL CMA IAC + DCA ACL + SNL /IF QUOT. IS NON-ZERO, SUBTRACT + CMA /ONE FROM HIGH ORDER QUOT. + JMP DVL1 /GO TO IT + +LPBUF3, ZBLOCK 12 + LPBUF4 + PAGE + /"OPNEG" MUST BE AT 0 ON PAGE + +OPNEG, 0 /ROUTINE TO NEGATE OPERAND + TAD OPL /GET LOW ORDER + CLL CIA /NEGATE AND STORE BACK + DCA OPL + CML RAL /PROPAGATE CARRY + TAD OPH /GET HI ORDER + CLL CIA /NEGATE AND STORE BACK + DCA OPH + JMP I OPNEG +/ +/FLOATING SUBTRACT AND ADD +/ +FFSUB, JMS I (ARGET /PICK UO THE OP. + JMS OPNEG /NEGATE OPERAND + SKP +FFADD, JMS I (ARGET /PICK UP OPERAND + TAD OPH /IS OPERAND = 0 + SNA CLA + JMP I FPNXT /YES-DONE + TAD ACH /NO-IS FAC=0? + SNA CLA + JMP CLROFL /CLEAR OUT THE OVERFLOW BITS + TAD ACX /NO-DO EXPONENT CALCULATION + CLL CIA + TAD OPX + SMA SZA /WHICH EXP. GREATER? + JMP FACR /OPERANDS-SHIFT FAC + CIA /FAC'S-SHIFT OPERAND=DIFFRNCE+1 + TAD (-30 + SMA /TEST FOR INSIGNIFICANCE + JMP OPINSG /YES - ANSWER IS FAC + TAD (30 + JMS OPSR + JMS I [ACSR /SHIFT FAC ONE PLACE RIGHT +DOADD, TAD OPX /SET EXPONENT OF RESULT + DCA ACX + JMS I [OADD /DO THE ADDITION + JMS FFNOR /NORMALIZE RESULT + JMP I FPNXT /RETURN +FACR, TAD (-30 + SMA /TEST FOR INSIGNIFICANCE + JMP ACINSG /YES - ANSWER IS OPR + TAD (30 + JMS I [ACSR /SHIFT FAC = DIFF.+1 + JMS OPSR /SHIFT OPR. 1 PLACE + JMP DOADD /DO ADDITION + +OPINSG, CLA + JMP I FPNXT + /OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 IN AC + +OPSR, 0 + CMA /- (COUNT+1) TO SHIFT COUNTER + DCA AC0 +LOP2, TAD OPH /GET SIGN BIT + CLL /TO LINK + SPA + CML /WITH HI MANTISSA IN AC + RAR /SHIFT IT RIGHT, PROPAGATING SIGN + DCA OPH /STORE BACK + TAD OPL + RAR + DCA OPL /STORE LO ORDER BACK + ISZ OPX /INCREMENT EXPONENT + NOP + ISZ AC0 /DONE ALL SHIFTS? + JMP LOP2 /NO-LOOP + RAR /SAVE 1 BIT OF OVERFLOW + DCA AC2 /IN AC2 + JMP I OPSR /YES-RETN. + +FFNOR, 0 /ROUTINE TO NORMALIZE THE FAC + TAD ACH /GET THE HI ORDER MANTISSA + SNA /ZERO? + TAD ACL /YES-HOW ABOUT LOW? + SNA + TAD AC1 /LOW=0, IS OVRFLO BIT ON? + SNA CLA + JMP ZEXP /#=0-ZERO EXPONENT +NORMLP, CLA CLL CML RTR /NOT 0-MAKE A 2000 IN AC + TAD ACH /ADD HI ORDER MANTISSA + SZA /HI ORDER = 6000 + JMP .+3 /NO-CHECK LEFT MOST DIGIT + TAD ACL /YES-6000 OK IF LOW=0 + SZA CLA + SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS. + JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7) + JMS I [AL1BMP /SHIFT AC LEFT AND BUMP ACX DOWN + JMP NORMLP /GO BACK AND SEE IF NORMALIZED +ZEXP, DCA ACX +FFNORR, DCA AC1 /DONE W/NORMALIZE - CLEAR AC1 + JMP I FFNOR /RETURN + +ACINSG, CLA /COME HERE IF AC IS INSIGNIFICANT ON ADDITION + DCA ACH + DCA ACL + JMP DOADD-1 /FAKE AN ADD WITH OPR=0 + +LPBUF4, ZBLOCK 40 + LPBUFE +CLROFL, DCA AC1 /CLEAR THE FLOATING AC OVERFLOW WORD + DCA AC2 /CLEAR THE OPERAND OVERFLOW WORD + JMP DOADD /FAC=0; DO THE ADD + PAGE + /PAGE 7400 UNUSED RIGHT NOW + +LPBUFE, ZBLOCK 177 + LPBUFR + FIELD 1 + diff --git a/sw/f4/FRTSRC/sign.ra b/sw/f4/FRTSRC/sign.ra new file mode 100644 index 0000000..50137b1 --- /dev/null +++ b/sw/f4/FRTSRC/sign.ra @@ -0,0 +1,40 @@ +/ +/ VERSION 5A 4-27-77 PT +/ + SECT SIGN + ENTRY ISIGN + JA #ST +#XR, ORG .+10 + TEXT 'SIGN ' +#BASE, ORG .+3 +A, ORG .+3 +B, ORG .+3 + ORG #BASE+31 + JA #BASE +GOBACK, 0;0;0 + BASE #BASE +ISIGN, +#ST, STARTD + 0210 + FSTA GOBACK+1,0 + 0200 + SETX #XR + SETB #BASE + LDX 0,1 + FSTA #BASE + FLDA% #BASE,1+ + FSTA A + FLDA% #BASE,1+ + FSTA B + STARTF + FLDA% B + JLT #50 + FLDA% A + JLT #100 + JA GOBACK+1 +#50, FLDA% A + JLT GOBACK+1 +#100, FNEG + JA GOBACK+1 + END + diff --git a/sw/f4/FRTSRC/sin.ra b/sw/f4/FRTSRC/sin.ra new file mode 100644 index 0000000..bf938a1 --- /dev/null +++ b/sw/f4/FRTSRC/sin.ra @@ -0,0 +1,124 @@ +/ +/ +/ S I N +/ - - - +/ +/SUBROUTINE SIN(X) +/ +/ VERSION 5A 4-27-77 PT +/ + SECT SIN + JA #SIN + EXTERN #ARGER +SINER, TRAP4 #ARGER + TEXT +SIN + +SINXR, SETX XRSIN + SETB BPSIN +BPSIN, F 0.0 +XRSIN, F 0.0 +SIN1, F 0.0 +SIN2, F 0.0 +F1SIN, F 1. +FPI2SN, 1 /PI DIVIDED BY 2 + 3110 + 3755 +FPISIN, 2 /PI + 3110 + 3755 +F2PISN, 3 /TWO PI + 3110 + 3755 + ORG 10*3+BPSIN + FNOP + JA SINXR + 0 +SINRTN, JA . +/ +SINC9, 7764 + 2501 + 7015 +/ +SINC7, 7771 + 5464 + 5515 +/ +SINC5, 7775 + 2431 + 5362 +/ +SINC3, 0000 + 5325 + 0414 +/ +SINTST, 7770 + 2000 + 0000 + BASE 0 +#SIN, STARTD + FLDA 10*3 + FSTA SINRTN + FLDA 0 + SETX XRSIN + SETB BPSIN + BASE BPSIN + LDX 1,1 + FSTA BPSIN + FLDA% BPSIN,1 /ADDR OF X + FSTA BPSIN + STARTF + FLDA% BPSIN /GET X + LDX -1,0 /SET SIGN TO POSITIVE. + JGT SINMOD /IF POSITIVE BYPASS FUDGE. + JEQ SINRTN /IF ZERO EXIT. + FNEG /NEGATIVE. NEGATE AC. SIN(-X)=-SIN(X) + LDX 0,0 /SET SIGN TO MINUS. +SINMOD, JAL SINER /IF SIGN CAN T INT, THEN ERROR. + FDIV F2PISN /REDUCE TO BELOW TWO PI. + FSTA SIN1 /SAVE IN A TEMP. + ALN 0 + FNORM /INTERGIZE IT. + FNEG + FADD SIN1 /RECALL NUMBER. AC NOW <0 + FMUL F2PISN /NOW MULTIPLY BACK. + FSTA SIN2 /AND SAVE AWAY. + FSUB FPISIN /SUBTRACT OFF PI. + JLT SINP /LESS THEN PI. + FSTA SIN2 /RESTORE AS 2. + XTA 0 /INVERT THE SIGN. + FNEG + FSUB F1SIN /SIN(X-PI)=-SIN(X) + ATX 0 /AND PUT BACK. +/ +SINP, FLDA SIN2 /RECALL MAGIC GOODY. + FSUB FPI2SN /TEST TO SEE IF X +TTYCA, 0 +TTYWC, 0 +TTYTST, 0 +TTYCDF, 0 + TAD TTY200 + KRS /TEST FOR ^C WITH FLAG UP + TAD TTM203 + SNA + KSF + JMP I TTYTST +TTYCIF, CDF CIF 0 + JMP I TT7600 +TTPRNT, 0 + TLS + TSF + JMP .-1 + JMP I TTPRNT +TTCDF, CDF 0 + +/FOLLOWING CODE READS TTY AND PACKS IN BUFFER. +TTYGLP, JMS TTYGCH + DCA I TTYCA +TTYM32, JMS TTYGCH + DCA TTYPCH + JMS TTYGCH + RTL + RTL + DCA TTYGCH + TAD TTYGCH + AND TT7400 + TAD I TTYCA +TT3700, DCA I TTYCA + TAD TTYGCH +TTY200, AND TTY360 + CLL RTL + RTL /CLEARS LINK + TAD TTYPCH + ISZ TTYCA + DCA I TTYCA + JMP TTLOOP + IFNZRO .-TTY360-146 +TTYGCH, 0 /MUST BE AT REL LOC 146 + TAD TTYCDF +TT7700, SMA CLA + JMP I TTYGCH + ISZ TTYTST + JMP TTYKSF + TAD TTY212 + JMP TTECHO +TTYKSF, KSF + JMP .-1 + JMS TTYTST + TAD TTM27 + SNA /IS IT A ^Z? + DCA TTYCDF /YES - SET END-OF-FILE FLAG + TAD TTY14 + DCA TTYTST /TTYTST=-1 IF CARRIAGE RETURN + KRB +TTECHO, JMS TTPRNT /ECHO THE INPUT CHARACTER + JMP I TTYGCH +TTM203, -203 +TTM27, -27 +TTYM14, -14 +TTY177, 177 + IFNZRO .-TTY360-175 +TTYCTO, 6032 /SHOULD BE AT REL LOC 175 FOR PATCHERS + JMP TTYRTN +TTY14, 14 + $ + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/C2BOOT.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/C2BOOT.PA new file mode 100644 index 0000000..a525de9 --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/C2BOOT.PA @@ -0,0 +1,194 @@ +/SECONDARY BOOTSTRAP V5A +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1973,1974 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + +/ DEC-8E-OC2BA-A-LA +/ COPYRIGHT 1972 +/ DIGITAL EQUIPMENT CORPORATION +/ MAYNARD, MASS. 01754 + +/ S.R. + + VERSON= 5 /5= VERSION 5, ETC + SUBVER= 01 /01=A, ETC + + BSW=7002 + KSDR=6701 + KSDF=6701 + KSBF=6703 + KLSA=6704 + KGOA=6706 + KRSB=6707 + NOPUNCH + *3602 + ENPUNCH + +BIN, STA + DCA GRKNT +ITSFLD, TAD CDF0 + DCA FLD +ITSORG, DCA ORG /ASSUMES ORIGIN ALWAYS APPEARS + /AFTER FIELD SETTING +BINLDR, STA + DCA ORGSW + JMS GETBYT +FOOL, BSW + CLL RTR + SZL + JMP SPEC /BIT 4=1 + SPA /BIT 4=0 (TWO WORD COMMAND) + ISZ ORGSW /IS ORIGIN +N7000, NOP + RAL + CLL RAL + DCA TEM + JMS GETBYT + TAD TEM /COMBINE + ISZ ORGSW + JMP ITSORG /ORIGIN +FLD, HLT + DCA I ORG + ISZ ORG +CDF0, CDF 0 + JMP BINLDR +SPEC, SMA + JMP MON + RTL + AND N7000 + BSW + JMP ITSFLD + GETBYT, 0 + ISZ GRKNT + JMP RDBYTE + TAD X260 + KLSA + KGOA + KSBF + JMP .-1 + KRSB + AND X7774 + SZA CLA + HLT + ISZ FIRST + JMP NOTFST + JMS RESET + TAD X270 + STL + JMP I X4002 +NOTFST, TAD X7600 + DCA GRKNT + TAD X200 + KLSA + KGOA + KSDF + JMP .-1 +RDBYTE, KGOA + KSDF + JMP .-1 + JMP I GETBYT + + ZBLOCK 3701-. /LOCATION 3701 IS SKIPPED BY PRIMARY LOADER + + + NOPUNCH + 0 + ENPUNCH + MON, CDF CIF 10 + JMP I .+1 + 5200 + +ORG, 0 +TEM, 0 +ORGSW, 0 + +X200, 200 +X260, 260 +X270, 270 +X7737, 7737 +XKNT, 4035 +XPTR, 4036 +X4002, 4002 +GRKNT, 0 +X7774, 7774 +FIRST, -1 +X7600, 7600 +RESET, 0 /SET UP PRIMARY BOOTSTRAP FOR REUSE + TAD X7737 + DCA I XKNT + DCA I XPTR + TAD X3211 /A "DCA ." FOR LOCATION 4011 + DCA I X4011 + JMP I RESET +X3211, 3211 +X4011, 4011 + ZBLOCK 4000-. + BIN + JMP I .-1 /MUST END IN OCTAL 00 + $ + GETBYT, 0 /DF IS RAANDOM ON ENTRY + CDF 10 + ISZ GRKNT + JMP TB + TAD (-200 + DCA GRKNT + TAD (BINBUF + DCA GRPTR + CALL (HANDLER + READ+F1 + BINBUF + HLT + CALL XWAIT +TB, TAD I GRPTR + INCR GRPTR + EXIT GETBYT + +GRKNT, 0 +GRPTR, 0 + +/ 00 DATA +/ 01 ORIGIN +/ 11 FIELD +/ 10 LEADER/TRAILER + PAGE + $ diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/CREF.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/CREF.PA new file mode 100644 index 0000000..a68fc90 --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/CREF.PA @@ -0,0 +1,3052 @@ +/2 PDP-8 OS/8 CROSS REFERENCE +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. + / +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + + /CREF IS A CROSS REFERENCING PROGRAM FOR THE OS/8 ASSEMBLERS, +/PAL8 AND SABR. THE PURPOSE OF CREF IS: + +/ 1) PROVIDE A SEQUENCE NUMBERED (DECIMAL) OUTPUT LISTING + +/ 2) PROVIDE A LIST OF ALL USER DEFINED SYMBOLS AND LITERALS +/ AND THE SEQUENCE NUMBER OF THE LINES IN WHICH THEY OCCUR + +/FIXES FOR MAINTENANCE RELEASE: + +/1. 1975 COPYRIGHT, VERSION 4, EDIT 1 +/2. UNIFIED PAGE SIZE INTO ONE PLACE (& MADE IT WORK) +/3. OUTPUT EXTRA FORM FEED AT END +/4. MADE /A MEAN KEEP CREFLS.TM INSTEAD OF /E + +/FIXES FOR V3D: + +/INSTALLED ALL PUBLISHED PATCHES + +/DETAILS OF CREF. + +/CORE UTILIZED +/FIELD 0 + +/0-3377: MAINLINE CREF CODE +/4200-4577: INITIALIZATION CODE.EXECUTED ONCE AT BEGINNING +/5600-6177: LATER OVERWRITTEN +/DEVICE HANDLERS + BUFFERS ALLOCATED ACCORDING +/TO REQUIREMENTS OF DEVICES. +/USES 3400-5577 FOR INPUT HANDLER, OUTPUT HANDLER, + INPUT BUFFER +/7200-7577: OUTPUT BUFFER +/5600-7174: USED FOR REFERENCE STORAGE + +/FIELD 1 + +/0-NSYM*4+10 NSYM=NO. OF SYMBOLS.(USER+PERMANENT+LITERALS). +/7424-7577 PSEUDO OP TABLE +/THE REMAINDER IS USED FOR REFERENCES DURING PASSES GREATER THAN ONE + +/SYSTEM SCRATCH USED. +/IF CREF DECIDES THAT MORE THAN 2 PASSES ARE REQUIRED, THE SYMBOL +/TABLE IS SEGMENTED AT AN OPTIMUM POINT, AND PART IS SAVED +/IN SCRATCH BLOCKS 27-50 FOR A THIRD (OR LARGER) PASS. + + +/MAJOR ROUTINES AND CODE SECTIONS + +/MAIN-START OF TEXT PROCESSING.CHECKS FOR VALID LINE.READS AND WRITES + /TEXT LINES +/CVTSEQ CONVERTS SEQUENCE NUMBERS FROM OCTAL TO DECIMAL AND +/ WRITES THEM INTO THE OUTPUT BUFFER + +/GETLIN- GET A LINE OF INPUT INTO LINE BUFFER + +/WRTLIN- WRITE A LINE OF TEXT INTO OUTPUT BUFFER + +/ANALYZ- LINE SCANNING BEGINS.ALL SYMBOLS COLLECTED HERE + +/PACK- CHARACTER PACKING ROUTINE. THE SCHEME USED MAPS LETTERS + /A-Z AND [,],\,^ INTO 0-37. 0-9 INTO 40-51 +/ THE PACKING IS: CHAR1-300^52+CHAR2-300 + +/SYMCHK- BINARY SYMBOL TABLE SEARCH + +/ENTRY- MAKES ENTRIES IN USER SYMBOL TABLE + +/BUMP- BUMPS REFERENCE COUNTER OF SYMBOLS IN PASS 1 + +/ENDPAS- TERMINATES A PASS THROUGH INPUT + +/PASSN2- FILLS IN REFERENCE STORAGE ARE DURING PASSES +/ AFTER PASS ONE + +/DUMP- DUMPS CREF TABLE TO OUT BUFFER + + +/SWITCHES IN CREF: + /Q=INPUT IS SABR CODE + /R=INPUT IS RALF CODE + /P=DISABLE LISTING OUTPUT. RE ENABLE FOR CREF TABLE + /X=DON'T CREF LITERALS + /M=MAMMOTH FILE(2 PASSES) + /E=DON'T ELIMINATE CREFLS.TM + /U=/P + NO SYMBOL TABLE + DECIMAL + + PAGLEN=66 /V3C MOST PAPER HAS 66 LINES PER PAGE + + OCTAL + + PAGLEN=PAGLEN-6 /HEADINGS + + + VERSN="5 + PATCHL="A +/PAGE ZERO FOR CREF + + *10 +/AUTO INDEX REGISTERS + +XRLINE, SYMTAB-1 /USED TO MOVE UP SYMBOL TABLE +XRLIT, -1 /DITTO +XRSYM1, 0 +XRSYM2, 0 /THESE ARE USED IN SEARCHING SYMBOLS +OUSAVX, 7611 /USED TO SAVE ARGS FOR /M + + *20 +TXTBEG, LINBUF+12 /TEXT STARTS HERE +MARGIN, LINBUF-1 /LINE BUFFER +COUNT, 0 /GENERAL COUNTER +CHAR, 0 /HOLDS CHARACTER TO EXAMINE +SEQNO, 0 /SEQUENCE NO. +SAVE, 0 +TEMP, 0 +TEMP1, 0 /THESE THREE ARE TEMPORARY STORAGE +DSWIT, 0 +RSWIT, 0 /CD SWITCH WORDS +MLF, -212 /-LINE FEED +SYMCNT, -6 /ALLOW 6 CHARACTER SYMBOLS +ISYM, SYM1 /POINTER TO SYMBOL COLLECTOR +PSWCH, 0 /PACK SWITCH..LEFT OR RIGHT HALF +SYM1, 0 +SYM2, 0 +SYM3, 0 /COLLECT SYMBOLS HERE +USER, 0 /USER MUST FOLLOW SYM3! + 110 /INITIAL SYMBOL TABLE ENTRIES +PSEUDO, 0 + 0 /THESE 2 GET FILLED IN AT INITIALIZATION +PASN2, PASSN2 /IF NOT PASS 1 GO HERE WITH A SYMBOL +PASSG1, -1 /=0 IF NOT PASS1 +MAXFLD, 0 /-# OF FIRST NON-EXISTENT FIELD +CONST, 0 /EITHER 0 OR 96(10) +FLDPTR, 0 /POINTER TO CORE FIELD +USR, 200 /MONITOR IN CORE..CHANGED TO 7700 +DOLLAR, DOLL1 +SYMFLD, 2 /FIELDS WITH SYMBOLS: BITS 5-11 +MASKF, 0 /MASK FOR ABOVE WORD + +/THESE ARE THE DEFAULT PARAMETERS FOR THE I/O ROUTINES +/AJUSTED ACCORDING TO REQUIREMENTS OF DEVICES REQUESTED + +OUCTL=4200 +OUBUF=7200 +OUDEVH=4000 /VARIABLE-MAY ALSO BE 3600 +OUFLD=OUCTL&70 + +INCTL=0400 +INBUF=4600 /ALSO 4200 +INDEVH=3400 +INRECS=2 /ALSO 3 +INFLD=INCTL&70 +/(SUBJECT TO CHANGE WITHOUT NOTICE!) + +SYMADD, 0 /CONTAINS SYMBOL ADDRESS +SYMNUM, 0 /ABOVE MOD 4 +K0=USER +BUFFER, 0 /POINTER FOR UNPACKING +R=52 +RAD=52 /RADIX FOR CONVERTING SYMBOLS + +ADDER, 0 +SYSM, 0 +BASE, 0 /THESE ARE USED TO END A PASS +SYMLIM, 0 /UPPER LIMIT FOR SYMBOL REF TABLE +FINI, 0 + +IOSR, 0 + JMS I [7607 +CNTROL, 4010 /THIS IS ON PAGE ZERO MAINLY +CTPTR, 4 /BECAUSE CTPTR IS USED A LOT +SCRATCH=27 + SCRATCH /SYSTEM SCRATCH FOR OVERFLOW + SKP /ERROR ON SYS!!! + JMP I IOSR +HIOERR, JMS I [ERROR + HNDERR +LNPRPG, -PAGLEN /# LINES OF TEXT PER PAGE +LINES, -PAGLEN /V3C MASTER COPY +THOUS, 6030 /CONVERSION TABLE..OCTAL-DECIMAL + 7634 + 7766 + 7777 + +FPUT, STORIT /INITIALLY POINTS TO DCA I XRLINE + +M12=THOUS+2 +M1=THOUS+3 + +DPAT, 0 + DCA I (NOFIRM + DCA I (NOFORM + JMP I DPAT + + *200 + JMP I (ST1 /INITIALIZATION GETS DESTROYED +BREAK, JMP I (CHAIN /CHAIN ENTRY POINT + ZBLOCK 7 /BREAK TABLE. HOLDS SYMBOL + /NUMBERS DURING VARIOUS PASSES + /OF CREF. THE ENTRIES ARE THE NUMBER + /OF THE LARGEST SYMBOL + /WHOSE REFERENCES ARE IN A PARTICULAR + /FIELD. THE 0TH ENTRY CORRESPONDS TO + /FIELD 0. +ERROR, 0 + CLA + CDF 0 + TAD I ERROR + DCA BUFFER + TAD [-6 + DCA SYMCNT /12 CHARACTER MESSAGES + TAD TTY /POINT TO TTY OUT ROUTINE + DCA [OCHAR + + TAD I BUFFER + JMS I [DIVIDE /CONVERT AND PRINT MESSAGE + ISZ SYMCNT + JMP .-3 + JMP I [7605 +TTY, TTYPRT + + +/THE INPUT LINE IS STORED HERE. XRLINE POINTS TO VARIOUS +/PLACES THROUGHOUT THE SCAN, AND CHAR HOLDS THE CORRESPONDING +/CHARACTER WHILE WE EXAMINE IT. + + LINBUF=. + LITBUF=.+6 + VERTST=.+4 + + + *251 +FILEXT, 0 + CDF 10 + TAD I (7604 + CDF 0 + SNA + TAD (1423 + CDF 10 + DCA I (7604 + CDF 0 + JMP I FILEXT +P2ADJ, 0 + TAD I (PASS2 + SNA + JMP I P2ADJ + DCA I (OUBLK /LAST BLOCK WRITTEN TO + CDF 10 + TAD I OUSAVX + CDF 0 + DCA I (OUELEN /SIZE OF HOLE + CDF 10 + TAD I OUSAVX + DCA LNPRPG /NO. LINES IN LAST BLK WRITTEN + TAD I OUSAVX /NO. BLKS WRITTEN SO FAR + CDF 0 + JMP I (MP2 /NO ENTER +MORCOR, 0 + CLA CLL IAC + DCA MAXFLD /IN CASE NOT DEFINED + TAD I (7777 + AND (70 + SNA + JMP I MORCOR /USE OLD WAY TO DETERMINE + CLL RTR + RAR /NEED IT HI 3 + DCA MAXFLD + JMP I (DONCOR + +OTYPE, 0 + CDF 10 + TAD I [7600 /DETERMINE WHAT TYPE OF DEVICE + AND [17 +DCB=7760 + TAD (DCB-1 + DCA Q + TAD I Q /CHECK DEVICE CONTROL BLOCK + CDF 0 + JMP I OTYPE +Q, 0 + *400 + +/MAIN IS THE START OF CREF.(IF SABR, NXTLIN IS START). +/AT MAIN WE SCAN A LINE OF TEXT FOR BINARY DATA. IF NONE IS FOUND, +/THE LINE IS WRITTEN OUT AND A NEW LINE READ. IF BINARY IS FOUND, +/THE SEQUENCE NUMBER OF THE LINE IS PLACED IN THE OUTPUT +/BUFFER AND THE ANALYSIS BEGINS AT ANALYZ. + +MAIN, JMS I [FORM /FORM FEED (CR/LF) + JMS I [HEADER /SKIP HEADER + JMS I (GETLIN /AND ONE CR/LF +NOTBIN, JMS WRTLIN +NXTLIN, JMS I (GETLIN + TAD I XRLINE + DCA CHAR + JMS I [CHECK /CHECK FOR ALPHA LINE + 301 + -336 + JMP NOALPH +NOFIRM, ISZ LNPRPG /NEED A FORM FEED YET? + JMP NOTBIN /NOT YET + JMS I [FORM /NOW!!! + JMP NOTBIN +NOALPH, TAD CHAR + TAD MCTLD /IF RUB OUT, USED /D + SNA + JMP I [ENDPAS /CAN'T OUTPUT SYM TABLE + TAD (163 /CHECK FOR FORM FEED + SNA + JMP MAIN /YES.. + TAD (-41 /IF ------, HE USED /T(DUMMY!) + SNA CLA + JMP MAIN /GIVE HIM A FORM FEED +NOFORM, ISZ LNPRPG /=0 AFTER PASS1 NEW PAGE? + SKP /SKIP A FORM FEED + JMS I [FORM + ISZ SEQNO /BUMP SEQUENCE + JMP MAIN2 + TAD [140 + DCA CONST +MAIN2, JMS I [PASTST /STILL PASS ONE? + JMP MAIN3 + TAD SEQNO + JMS CVTSEQ + TAD [-3 /3 SPACES + JMS I [SPACE +MAIN3, TAD CHAR + TAD [-215 + SNA CLA + JMP NOTBIN + JMP I [ANALYZ +MCTLD, -377 /RUB OUT + +/THIS ROUTINE CONVERTS SEQUENCE NUMBERS TO DECIMAL NUMBERS AND +/PUTS THEM INTO THE OUTPUT BUFFER. IT IS USED WHEN PRINTING +/THE CREF TABLE ALSO +/THE CALLING SEQUENCE IS: AC=OCTAL NUMBER TO BE CONVERTED. +/THE OUTPUT IS AUTOMATICALLY 4 DIGITS. + + +POSPT=TEMP1 +DIGPT=MASKF + +CVTSEQ, 0 + TAD CONST + DCA SAVE /TEMP STORE + TAD CONST + SZA CLA + TAD [4 + DCA DIGIT1 + DCA DIGIT1+1 + DCA DIGIT1+2 + DCA DIGIT1+3 /ZERO CONVERSION AREA + TAD [-4 + DCA COUNT + TAD SAVE + CLL /SEE IF SEQUENCE IS ABOVE 8000(10) + TAD CONST /EITHER 0 OR 140(8) + SNL + JMP CVT2 /O.K. + DCA SAVE /CORRECTED NUMBER + TAD [10 + DCA DIGIT1 /PUT AN 8 INTO THERE FOR PRINTING +CVT2, CLA + TAD (DIGIT1 + DCA DIGPT + TAD (THOUS + DCA POSPT + TAD SAVE +RPEAT, CLL + TAD I POSPT /POINTS TO -1000,-100,-10, OR -1 + SNL /IF LINK ON,WE DID TOO MUCH + JMP ADDUP /COLLECT THE CONVERTED DIGIT + ISZ I DIGPT /BUMP THE COUNTER DIGIT1-DIGIT1+3 + JMP RPEAT + +ADDUP, CIA /RESTORE THE LAST ONE + TAD I POSPT + CIA + ISZ POSPT + ISZ DIGPT + ISZ COUNT /DONE ALL 4? + JMP RPEAT + TAD [-4 /YES..OUTPUT THE CONVERTED NUMBERS + DCA COUNT + TAD (DIGIT1 + DCA DIGPT +SPCLUP, TAD I DIGPT + TAD ZSPRES /LEADING ZERO SUPPRESSION + DCA ZSPRES + TAD ZSPRES + SNA CLA /ZSPRES IS 0 UNTIL A VALID # IS FOUND + TAD (-20 + TAD I DIGPT + TAD [260 + JMS I [OCHAR + ISZ DIGPT + ISZ COUNT + JMP SPCLUP + DCA ZSPRES + JMP I CVTSEQ + +DIGIT1, 0 + 0 + 0 + 0 +ZSPRES, 0 + /WRTLIN TRANSFERS INPUT LINE TO OUTPUT BUFFER + +WRTLIN, 0 + TAD MARGIN + DCA XRLINE /RESET MARGIN TO LEFT +OLINE, TAD I XRLINE /PICK UP TEXT CHARACTER + DCA CHAR + TAD CHAR + SNA /IF NULL,WAS PREMATURE TERMINATOR + JMP FLUSH /YES. READ AND WRITE THE REST + JMS I [OCHAR /OUTPUT THE CHARACTER + TAD CHAR + TAD MLF /WAS THIS END OF LINE? + SZA CLA + JMP OLINE /NO..LOOP AGAIN + JMP I WRTLIN + +FLUSH, JMS I [HEADER + JMP I WRTLIN /OVERFLOW NOT IN BUFFER + + *600 +/ANALYZ IS A WORK HORSE. IN IT CHARACTERS ARE EXAMINED AND +/SYMBOLS ARE BUILT UP. IF A SYMBOL OR A REFERENCE TO A +/SYMBOL IS FOUND,THE APPROPRIATE ACTION IS TAKEN;I.E. +/EITHER ENTERING A NEW SYMBOL, BUMPING THE RFERENCE COUNTER, +/OR BOTH. + +ANALYZ, TAD SEMISV /IF #0, LAST WAS SEMICOLON + SNA + TAD TXTBEG /IF=0, START NORMALLY + DCA XRLINE + +SCAN, TAD I XRLINE + DCA CHAR + JMS I [CHECK /ALPHANUMERIC CHECK + 301 + -332 + SKP /NONE..TEST FOR SPECIAL CHARS + JMP PAKIT /FOUND A LETTER PACK AWAY + JMS I [CHECK /TEST FOR 0-9 + 260 + -271 + SKP /NOPE..COULD BE SABR + JMP SCAN1 +SCAN3, JMP TSTIT /IF SABR, THIS LOC IS AND 0 + JMS I [CHECK /TEST FOR [,],\,AND ^ + 333 + -336 + SKP + JMP PAKIT /VALID SABR CHARACTERS + +TSTIT, JMS REPACK + TAD CHAR /IS THIS A ;? + TAD (-273 /IF SO, SAVE PLACE ON LINE + SZA CLA + JMP .+3 /IF ; SAVE PLACE ON LINE + TAD XRLINE + DCA SEMISV + TAD SYM1 /IS THERE A LEGAL SYMBOL? + SNA CLA + JMP TSTEND /NO..LOOK FOR A LINE FEED + TAD CHAR + TAD (-257 + SNA CLA /A COMMENT? + IAC /YES..NEED SPECIAL RETURN + DCA SLSWIT + + JMS I [SYMCHK /THIS IS EITHER A REFERENCE OR A + /DEFINITION OR A PERMANENT SYMBOL,PSEUDO + PSEUDO /CHECK PSEUDOS FIRST +HC1, JMP USSYM /NOT A PSEUDO-OP + /BECOMES JMP PATCH IF /M USED + TAD SYMADD + TAD [3 + DCA SAVE /SYMCHK RETURNS ADDRESS OF SYMBOL IN SYMADD + CDF 10 + TAD I SAVE + DCA SAVE + CDF 0 + JMS I (CLEAR /WIPE OUT PSEUDO OP + JMP I SAVE /PERFORM THE NECESSARY OP FOR PSEUDO +PATCH, TAD SYM1 + RTL +PATCH1, CLA SZL SPA /LG-LH SPLIT + JMP B + +USSYM, JMS I [PASTST + JMP I PASN2 + JMS I [SYMCHK + USER /CHECK PERMANENT AND USER SYMBOLS + JMP NTER /DIDN'T FIND IT; SO WE HAVE TO ENTER IT + JMS I (TSTPRM /FOUND;TEST FOR PERMANENT SYMBOL + JMP B /WAS A PERMANENT SYMBOL + JMP BMPIT /FOUND AND NOT PERMANENT;INCREASE THE + /REFERENCE COUNTER BY ONE + +NTER, JMS I [ENTRY /ENTER THE SYMBOL BY PUSHING DOWN ALL + /THE ONES BELOW IT +BMPIT, JMS I [BUMP /AND INCREASE THE REFERENCE COUNT +B, JMS I (CLEAR /SETUP FOR NEXT + TAD SLSWIT /WAS LAST A /? + SZA CLA + JMP I (NOTBIN + JMP SCANER + +TSTEND, TAD CHAR + TAD MLF /ARE WE DONE WITH THIS LINE? + SZA CLA + JMP .+3 /IF LF, CLEAR OUT SEMICOLON +CLRSEM, DCA SEMISV + JMP I (NOTBIN + TAD CHAR + TAD (-257 + SNA /COMMENT LINE? + JMP CLRSEM + TAD (15 /A "? + SNA + ISZ XRLINE /YES..SKIP NEXT LETTER + TAD [-2 /A $? + SNA + JMP I DOLLAR + TAD [-4 + SNA /TEST FOR ( + JMP I (LIT1 + TAD (-63 + SZA CLA /TEST FOR [ + JMP SCANER /NONE OF THEM KEEP GOING + JMP I (LIT2 + +SCAN1, TAD SYM1 /IF WE DON'T HAVE A SYMBOL + SNA CLA /DON'T PACK THIS CHARACTER + JMP SCAN +PAKIT, TAD CHAR + JMS I [PACK /PACK A CHARACTER + JMP SCAN + +REPACK, 0 /RESET SYMBOL AREA + TAD [-6 + DCA SYMCNT /SYMBOL COUNTER..6 CHARS + TAD (SYM1 + DCA ISYM + DCA PSWCH + JMP I REPACK + +SEMISV, 0 +SLSWIT, 0 + +SCANER, TAD CHAR /IF LAST WAS ; READ IN OVERLAY + TAD (-273 + SNA CLA + JMP I (NOTBIN + JMP SCAN + +SUB3, 0 /SUBTRACTS 3 FROM CTPTR + TAD [-3 + TAD CTPTR + DCA CTPTR + JMP I SUB3 + *1000 + + +/THE PACKING SCHEME IS THE SAME AS THAT USED IN PAL8. THAT IS +/IN EACH WORD WE HAVE 2 CHARS. CHAR1-300^45+CHAR2-300. +/PERMANENT SYMBOLS HAVE THE FIRST WORD SET TO A NEGATIVE. + +PACK, 0 + DCA BLAH + TAD SYMCNT + SMA CLA /OVERFLOW PROTECT + JMP I PACK + TAD BLAH + AND [77 /STRIP IT + TAD (-37 /INCLUDE VALID SABR CHARS + SMA SZA + TAD (-20 /NUMBERS GET MAPPED: 40-51 + TAD (37 /LETTERS ARE MAPPED:01-37 + ISZ PSWCH /WHICH HALF? + JMP LEFT + TAD I ISYM + DCA I ISYM + ISZ ISYM + JMP PCKOUT +LEFT, CLL RAL /*2 + DCA TLOW + TAD TLOW + CLL RTL + DCA SAVE /*10 + TAD SAVE + CLL RTL /*40 + TAD SAVE + TAD TLOW /*52!! + DCA I ISYM + CLA CMA /RESET FLIP FLOP + DCA PSWCH +PCKOUT, ISZ SYMCNT + NOP + JMP I PACK +BLAH, 0 + + + + +/SYMCHK IS THE BINARY SEARCH ROUTINE FOR CREF. SYMBOLS +/ARE A GROUP OF FOUR ENTRIES:THE FIRST THREE WORDS ARE +/THE STRIPPED-40 REPRESENTATION OF THE SYMBOL. THE LAST +/IS THE REFERENCE COUNTER (IN THE CASE OF A USER SYMBOL) OR +/A -1 (IN THE CASE OF A PERMANENT SYMBOL). IN PSEUDO OPS +/THE FOURTH WORD DESCRIBES THE DESTINATION OR ACTION +/TO BE PERFORMED BY THAT PSEUDO OP. +/THE TABLE USER,0 HAS ENTRIES WHICH ARE THE SYMBOL NUMBER +/AND NOT THE ABSOLUTE CORE LOCATION OF A SYMBOL. + +/CALLING SYMCHK: +/ JMS SYMCHK +/ TABLE /FIRST WORD OF TWO WHICH GIVES THE LIMITS +/MOD 4 OF THE APPROPRIATE TABLE +/SYMCHK RETURNS WITH THE NUMBER OF THE SYMBOL IN SYMNUM +/AND THE CORE ADDRESS OF THE SYMBOL IN SYMADD. IF THE +/SYMBOL IS NOT FOUND, THESE WORDS CONTAIN THE PROPER LOCATION +/FOR THE SYMBOL. + +SYMCHK, 0 + TAD I SYMCHK + DCA THI + DCA LAST + TAD I THI /GET LIMITS OF TABLE + DCA TLOW /LOW LIMIT + ISZ THI + TAD I THI + DCA THI /HIGH LIMIT + +COMP, TAD TLOW + CIA + TAD THI + CLL RAR /HALF DIFFERENCE BETWEEN THE LIMITS + SNA /IF THIS IS ZERO, WE'RE DONE + ISZ LAST /THIS WILL BE LAST TRY + TAD TLOW /FORM THE NUMBER OF THE ENTRY + DCA SYMNUM /WE ARE GOING TO TEST NOW + JMS SETXR /SET UP INDICES FOR TEST + ISZ COUNT /WE ONLY WANT -3 IN COUNT! + +S1, CLL + CDF 10 + TAD I XRSYM2 /SYMBOL TABLE ENTRY + CDF 0 + AND [3777 /MASK PERMANENT SYMBOL BIT + CMA /USE ONE'S COMPLEMENT + TAD I XRSYM1 /OUR COLLECTED SYMBOL + CMA /0 AC IF EQUAL + SZA CLA /WATCH THE LINK!! + JMP COMPR /NOW TEST FOR HI OR LOW COMPARISON + ISZ COUNT + JMP S1 + ISZ SYMCHK /TAKE FOUND ENTRY + JMP OUT1 + + +COMPR, TAD LAST /LAST GASP? + SZA CLA + JMP OUT2 /YEP + TAD SYMNUM /LINK TELLS THE TALE! + SNL + JMP COMP-1 /ADJUST HIGH LIMIT + DCA TLOW + JMP COMP + + +OUT2, TAD SYMNUM + SZL + IAC + DCA SYMNUM +OUT1, TAD SYMNUM /ADDING THE FIRST ENTRY AFTER + SZA /AN EXPUNGE WILL CAUSE SYMNUM TO BE 0 + /AUTOMATICALLY IT HAS TO BE 1 + JMP .+3 + ISZ SYMNUM + JMP OUT1 + CLL RTL /FORM SYMADD FROM SYMNUM + DCA SYMADD /CORE ADDRESS OF THE SYMBOL + ISZ SYMCHK + JMP I SYMCHK + +THI, 0 +TLOW, 0 + +LAST, 0 + + + +/THESE TABLES DEFINE THE LIMITS OF CORE STORAGE IN CREF. +/BASTBL GIVES THE START LOC WHERE REFERENCES WILL BE STORED. +/LTTBL GIVES THE LO CORE LIMIT OF THOSE REFS. THERE IS ONE ENTRY FOR +/EACH FIELD + +BASTBL, 7174 /THIS TABLE GIVES THE BASE + 7424 /LOCATIONS INEACH FIELD WHERE THE + 7574 /REFERENCES BEGIN + 7574 /REFS START HERE AND BUILD TOWARD LOWER + 7574 /CORE ADDRESSES + 7574 + 7574 + 7574 +LTTBL, DOLL1 /THIS TABLE GIVES THE LOW + 10 /CORE ADDRESS OF THE REFS IN EACH FIELD + 4 /NOTE:ENDPAS JUGGLES THESE AROUND + 4 /TO OPTIMIZE CREF STORAGE + 4 + 4 + 4 + 4 + +DIVE, 0 + SNA /IF 0, PRODUCE A SPACE + JMP DIVSPC + TAD (-37 + SMA SZA + TAD [-60 + TAD [77 +DIVSPC, TAD [240 + JMP I DIVE + +SETXR, 0 /SETUP INDEX REGS FOR SEARC,ENTRY + TAD SYMNUM /SETUP WHEN FOUND SYMBOL + CLL RTL /CORE ADDRESS OF SYMBOL + TAD M1 + DCA XRSYM2 + TAD [SYM1-1 + DCA XRSYM1 + TAD [-4 + DCA COUNT + JMP I SETXR + + *1200 +/ENTRY IS SLOW! IT ENTERS A SYMBOL BY PUSHING DOWN WHAT IS +/BELOW THE PROPER ENTRY.ENTRY CAN ONLY BE USED IN MAKING +/ENTRIES IN THE PERMANENT (USER) SYMBOL TABLE. +/ENTRY CONDITIONS:AC SHOULD BE CLEAR! +/ SYMNUM SHOULD HAVE THE SYMBOL NUMBER OF THE +/ PROPOSED ENTRY. SYMCHK RETURNS THIS WHEN THE +/ SEARCH IS UNSUCCESSFUL. + +ENTRY, 0 + JMS I (SETXR /SETUP INDEX REGISTERS + TAD USER+1 /CHECK FOR POSSIBLE OVERFLOW + CMA /WE DON'T WANT TO WIPE PSEUDO TABLE + TAD PSEUDO + SPA SNA CLA + JMP NMOR /BAD!OVERFLOW HAS OCCURRED + ISZ USER+1 /OK..BUMP SYMBOL COUNT + TAD USER+1 + CLL RTL /CORE ADDRESS OF ENTRY + DCA TEMP1 + TAD TEMP1 + TAD [-4 /GIVES BOTTOM OF TABLE NOW + DCA SAVE + TAD SAVE /TEST FOR AN 'ADD-ON' ENTRY + CMA + TAD SYMADD + DCA COUNT /-# OF WORDS TO MOVE + + CDF 10 +NTR1, TAD I SAVE + DCA I TEMP1 /THE BAD LOOP! + CMA + TAD SAVE + DCA SAVE /I WISH WE HAD A DSZ!(DECREMENT &SKIP ON 0 + CMA + TAD TEMP1 + DCA TEMP1 + ISZ COUNT /DONE? + JMP NTR1 /UNFORTUNATELY NOT + + CDF 0 +ENTER, CLA /NOW PUT IN OUR ENTRY + TAD [-4 + DCA COUNT /THE 4TH IS A 0 WORD (USER FOLLOWS SYM3) +NTR2, TAD I XRSYM1 + CDF 10 + DCA I XRSYM2 + CDF 0 + ISZ COUNT + JMP NTR2 + JMP I ENTRY + +NMOR, JMS I [ERROR /SYMBOL OVERFLOW + SYMERR + + +TXT, JMS GETC + TAD (-240 /IGNORE SPACES + SNA CLA + JMP TXT + TAD CHAR + CIA /STRING DELIMITER + DCA DELMIT +TXT2, JMS GETC + TAD DELMIT /REACHED END OF STRING? + SNA CLA + JMP I [B /YES + TAD CHAR /NO..END OF LINE? + TAD [-215 + SNA CLA + JMP I [B + JMP TXT2 + +GETC, 0 + TAD I XRLINE + DCA CHAR + TAD CHAR + JMP I GETC /GET A CHAR;STORE IT, RETURN IN AC +DELMIT, 0 + + + + +BUMP, 0 /ROUTINE TO BUMP REFERENCE COUNTERS + TAD SYMADD + TAD [3 + DCA SAVE /ADDRESS OF REFERENCE COUNTER + CDF 10 + TAD I SAVE + SPA CLA /IF 4000 BIT ON, AN EXTRA ENTRY HAS + /ALREADY BEEN MADE FOR THIS SYMBOL + JMP ONEISZ + TAD CONST + SNA CLA /IS SEQNO >4095? + JMP ONEISZ /NOT YET + TAD [4000 + TAD I SAVE + DCA I SAVE /MARK IT AS BEING NOTED + CMA +ONEISZ, TAD M1 /EITHER -1 OR -2 + DCA COUNT +BUMP2, TAD [3777 /THIS CODE PROTECTS AGAINST + AND I SAVE />2048 REFS. IF SIGN BIT EVER BECOMES + ISZ I SAVE /NEG. ON THE ISZ,KILL IT!! + NOP /USELESS PROTECTION + TAD [3 /IF AC GOES NEG. HE DIES!! + SPA CLA + JMP ERR7 + ISZ COUNT + JMP BUMP2 + CDF 0 + JMP I BUMP + +ERR7, CDF 0 + JMS I [ERROR + REFERR + +PTRSET, 0 /THIS ROUTINE TAKES + TAD [3 /THE SYMBOL TABLE THAT + DCA BUFFER /PRODUCED AND SETS UP EACH REFERENCE + DCA SYMNUM /AREA WITH A POINTER INTO THE AREA + CLA CMA + TAD USER+1 /AND A 0 LOCATION TO HOLD THE DEFINITION + CIA /SEQUENCE NO. + DCA COUNT +PTRST1, TAD [4 /START PICKING UP POINTERS + TAD BUFFER + DCA BUFFER + ISZ SYMNUM /CORRESPONDING SYMBOL NUMBER + JMS I (GETFLD /FORM CDF N FOR REFERENCE AREA + DCA CDTFLD + CDF 10 + TAD I BUFFER /IF PERMANENT SYMBOL, THIS LOC=0 + SNA /IF SO, SKIP IT + JMP PTRST2 + TAD M1 + DCA SAVE +CDTFLD, HLT + DCA I SAVE + ISZ SAVE /POINT TO INDEX WORD + TAD [2 + DCA I SAVE +PTRST2, CDF 0 + ISZ COUNT + JMP PTRST1 + JMP I PTRSET + + *1400 +/ENDPAS IS ARRIVED AT WHEN A PASS THROUGH THE INPUT HAS BEEN +/COMPLETED.SOME COMPLICATED DIDDLING GOES ON HERE. + +ENDPAS, ISZ PASSG1 + JMP I (DUMP /DUMP WHAT WE HAVE + JMS I (ENDFIX + IAC /POINT TO END OF NEW TABLE + DCA USER+1 /YES..THAT BECOMES THE TOTAL NO. + /OF SYMBOLS IN OUR NEW TABLE + TAD [3777 /O.K...NOW READ IN A SEGMENT + AND CNTROL /NOW FORMING READ CONTROL + DCA CNTROL + TAD [4 /READ SYMBOLS INTO F1 AT LOC.4 + DCA CTPTR + JMS IOSR /DO THE READ +NDPS1, DCA FLDPTR /INITIALLY AT FIELD 0 + TAD [6034 + DCA I [OUTSW +END2, DCA ADDER /ADDER HOLDS THE COUNT OF THE NUMBER + /OF REFERENCES TO THE SYMBOLS THUS FAR + /EXAMINED. THIS IS COMPARED TO THE AVAILABLE + /CORE IN A PARTICULAR FIELD. WHEN THAT OVER- + /FLOWS WE HAVE TO EITHER MOVE TO ANOTHER FIELD + /FOR THE REFERENCES OR WRITE PART OF THE SYMBOL + /TABLE ONTO SYS. + TAD (BASTBL + TAD FLDPTR + DCA TEMP1 /INITIAL BASE OF REFS + TAD I TEMP1 + DCA BASE + TAD FLDPTR /NOW GET MASK FOR QUESTION.. + CMA /DOES THIS FIELD HAVE SYMBOLS? + DCA COUNT + CLL CML + RAL + ISZ COUNT + JMP .-2 + DCA MASKF + TAD FLDPTR /GET ADDRESS OF UPPER LIMIT + TAD (LTTBL /FOR LATER + DCA SYMLIM + TAD FLDPTR /SET NEW LIMIT IN FIELD 1 + TAD [BREAK + DCA NUSER /THE NEW LIMIT FOR REFS IS + DCA I NUSER /ZERO SYMBOL IN CURRENT FIELD LOC. + TAD I SYMLIM +FUJ1, TAD CTPTR /IF MORE THAN 2 FIELDS EXIST + /THIS BECOMES A NOP. THE LIMIT IN + /FIELD 1 IS AT THE BOTTOM OF THE + /SYMBOL TABLE + DCA LIMIT +NDPS2, TAD CTPTR /CTPTR HOLD THE CORE ADDRESS OF THE + /THE 4TH LOCATION OF A GIVEN SYMBOL. THIS + /IS ALSO THE REFERENCE COUNTER FOR THAT SYMBOL + CLL RTR /FORM SYMBOL NUMBER + AND [1777 + DCA COUNT /SAVE FOR LATER + TAD ADDER + CIA + TAD BASE /NEXT REFERENCE AREA + DCA SAVE /IF IT FITS IN THIS AREA + /USED WHEN WE MAKE ACTUAL REF ENTRIES + CDF 10 + TAD I CTPTR /# REFS FOR THIS SYMBOL + DCA TEMP + TAD [3 + TAD CTPTR + DCA CTPTR + TAD TEMP + SPA CLA /PERMANENT SYMBOL + JMP PRMSYM /YES + TAD I CTPTR + AND [3777 /MASK GT 4095 BIT + TAD ADDER + DCA ADDER /SEE IF THIS SYMBOL WILL FIT IN THE + /CURRENT FIELD HOLDING REFS + CDF 10 /MUST ADD UP NEW REFS ALSO + TAD I CTPTR + AND [3777 + CDF 0 + CLL + TAD LIMIT /IF LINK GOES ON, REFS WON'T FIT + SZL + JMP CUTSYM + CMA CLL /WHEN UPPER MEETS LOWER,QUIT + TAD SAVE + SNL CLA + JMP CUTSYM /OK..QUIT! + CDF 10 + TAD SAVE /FITS..PUT IN BASE WHERE THIS SYMBOL'S + /REFS BEGIN + DCA I CTPTR + ISZ ADDER + ISZ ADDER /2 EXTRA FOR BOOKKEEPING +PRMSYM, CDF 0 + TAD COUNT /SYMBOL NUMBER..REMEMBER? + DCA I NUSER + TAD SYMFLD /BUT..IF THIS FIELD HAS SYMBOLS, + AND MASKF /LET'S REDUCE HIS AVAILABLE SPACE + SNA CLA + JMP .+4 /NO SYMBOLS + TAD [4 + TAD LIMIT + DCA LIMIT + TAD COUNT /SEE IF WE ARE DONE + CMA + TAD USER+1 + SNA + JMP I (DONE /YES!! PROBABLY FORGOT SOMETHING + DCA SYSM /BECOMES # SYMBOLS TO WRITE OUT IN CASE + /WE RUN OUT OF ROOM + ISZ CTPTR + JMP NDPS2 /CYCLE FOR NEXT SYMBOL + +CUTSYM, CLA + ISZ FLDPTR /GO TO ANOTHER FIELD + TAD FLDPTR /DOES IT EXIST? + CLL + TAD MAXFLD + SNL CLA + JMP END3 /YES..GROOVY + TAD SYSM /NOPE..HAVE TO WRITE REMAINDER OUT + CLL RAL /CONVER TO PAGES + AND (3700 /FORM CONTROL WORD FOR WRITE + TAD [4110 + DCA CNTROL + JMS I (SUB3 /RESET CTPTR + TAD I NUSER + IAC /FUDGE LAST ENTRY IN TABLE + DCA USER+1 /NEW END OF TABLE + JMS IOSR /WRITE THE SEGMENT + CDF 10 /PUT A 7777 AT END OF CURRENT SEG. + CLA CMA + DCA I CTPTR + CDF 0 + JMP I (DONE+1 /NOT DONE YET!! + +END3, JMS I (SUB3 + JMP END2 /AND RESUME THY WORK!! +NUSER, 0 +LIMIT, 0 + *1600 + +/PASSN2 IS ENTERED WHEN WE HAVE COLLECTED SOME SORT OF A +/SYMBOL AND IT IS NOT PASS ONE. WE HAVE TO MAKE SURE IT +/IS A USER SYMBOL OR LITERAL. IF IT IS, WE HAVE TO ENTER +/THE SEQUENCE # IN THE AREA SET UP FOR REFERENCES TO THIS +/SYMBOL. ALSO, IF THE REFERENCE IS A DEFINITION, THE SECOND +/LOCATION IN THE REFERENCE AREA IS LOADED WITH THE SEQUENCE +/NO. OF THE LINE WE ARE DOING. + +PASSN2, JMS I [SYMCHK + USER /IS IT KNOWN TO US? + JMP I [B /NO..BUT IT MIGHT BE IN A SEGMENT EITHER + /ALREADY DONE OR YET TO BE DONE!! + JMS TSTPRM /TEST FOR A PERMANENT SYMBOL + JMP I [B /PERMANENT SYMBOL +/NOTE:SAVE IS SET UP IN TSTPRM TO CONTAIN THE ADDRESS OF THE +/INDEX WORD. WE USE THIS LATER ON + + JMS GETFLD + DCA CDFN /DETERMINE WHAT FIELD THIS SYMBOL HAS ITS + /REFS IN AND FORM A CDF N + TAD CHAR + TAD MCOMMA /IS THIS A DEFINITION? + SZA + TAD MEQ /AN= MAYBE? + SNA CLA + IAC /ONE OR OTHER..MARK AS DEFINITION + DCA DEF + CDF 10 + TAD I SAVE /PICK UP POINTER TO REFERENCE AREA + DCA SAVE + TAD CDFN + DCA .+1 + HLT /I HATED TO DO THIS!!! + TAD I SAVE + SPA CLA /IF THIS IS NEGATIVE, IT MEANS THAT THE + /SEQUENCE NUMBER HAS WRAPPED AROUND, BUT WE HAVE + /ALREADY MADE A 0 ENTRY TO SHOW THAT + JMP P2 + TAD CONST /HAS THE SEQUENCE # WRAPPED? + SNA CLA + JMP P2 /NOT YET + JMS REFENT /YES..MAKE A 0 ENTRY + TAD CDFN + DCA .+1 + HLT + TAD I SAVE /MARK AS HAVING A 0 ENTRY + TAD [4000 + DCA I SAVE +P2, CDF 0 + TAD SEQNO /NOW MAKE A REAL ENTRY + JMS REFENT + TAD DEF + SNA CLA /SHOULD WE FILL IN THE DEFINITION LOC? + JMP I [B /NO + CLA CMA + TAD SAVE /YES..POINT TO IT + DCA SAVE + TAD CDFN + DCA .+1 + HLT /THIS IS SLOPPY, BUT SO AM I + TAD SEQNO + CIA + DCA I SAVE +CDFZ, CDF 0 + JMP I [B +DEF, 0 +MEQ, -21 +MCOMMA, -254 + +/REFENT, MAKES REFERENCES IN THE SYMBOLS AREA AND BUMPS THE +/FIRST LOCATION TO POINT TO THE NEXT LOC. + +REFENT, 0 + DCA TEMP1 /SAVE SEQNO +CDFN, HLT + TAD I SAVE + AND [3777 /MASK OFF WRAP AROUND BIT + CIA + TAD SAVE /FORM ADDRESS OF THIS REFERENCE + DCA TEMP + TAD TEMP1 + DCA I TEMP + ISZ I SAVE /BUMP POINTER + CDF 0 + JMP I REFENT + +/TSTPRM TESTS THE SYMBOL WE HAVE FOUND FOR BEING A PERMANENT SYMBOL +/PERMANENT SYMBOLS ARE DISTINGUISHED BY HAVING THE 4000 BIT ON. + +TSTPRM, 0 + TAD SYMADD + TAD [3 + DCA SAVE /WE USE THIS ON RETURN!! + CDF 10 + TAD I SYMADD + CDF 0 + SMA CLA /IS IT MINUS? + ISZ TSTPRM + JMP I TSTPRM + +/GETFLD DETERMINES WHAT FIELD A PARTICULAR SYMBOL HAS ITS +/REFS IN. IT DOES IT BY COMPARING THE CURRENT SYMBOLS NUMBER +/WITH THE ENTRIES IN THE BREAK TABLE. + +GETFLD, 0 + DCA FLDPTR +GF1, TAD [BREAK + TAD FLDPTR /GET BREAK TABLE ENTRY + DCA TEMP + TAD I TEMP + CIA + TAD SYMNUM /SYMNUM WAS SET UP WHEN WE FOUND THE SYMBOL + SPA SNA CLA + JMP GF2 /FIRST NEG. VALUE GIVE FLDPTR + ISZ FLDPTR /TRY NEXT + JMP GF1 +GF2, JMS CHDF /FORM THE CDF N + JMP I GETFLD + +CHDF, 0 + TAD FLDPTR + CLL RTL + RAL + TAD CDFZ + JMP I CHDF + +SPACE, 0 /GENERATES AS MANY SPACES AS ARE IN AC + DCA CHDF + TAD [240 + JMS I [OCHAR + ISZ CHDF + JMP SPACE+2 + JMP I SPACE + +CHECK, 0 + TAD I CHECK /SUBROUTINE TO TEST CHAR + CIA /AGAINST PRESCRIBED LIMITS + TAD CHAR + CLL + TAD I CHECK + ISZ CHECK + TAD I CHECK + ISZ CHECK + SNL + SKP CLA /VERY UNESTHETIC..BUT IT WORKS! + SNA CLA + ISZ CHECK + JMP I CHECK + +DONE, ISZ FINI /SET COMPLETION FLAG + JMS I (IOPEN /SET FOR REREAD + JMS I (PTRSET /PREPARE REFERENCE AREAS + DCA SEQNO /BACK TO BASICS + DCA CONST + JMP I (FIRST /READ FIRST RECORDS + + *2000 +/DUMP DOES A LITTLE FORMATTING OF THE OUTPUT, AND DUMPS THE +/CROSS REFERENCING TABLE ONTO THE OUTPUT DEVICE. +/ANY FIDDLING WITH THE BUFFERS OR DEVICE HANDLERS WILL HAVE TO +/BE DONE IN DUMP + + +COUNTR=BASE +REFBUF=IOSR +SCHAR=ADDER + +DUMP, CLA CMA + DCA PASSG1 /FORCES ANOTHER PASS AT ENDPAS +DMP7, SKP /V3C + JMP DMP8 /SKIP FIRST-TIME STUFF + ISZ LINES /V3C + ISZ LINES /DIF NO. LINES PER PAGE NOW + JMS I [FORM /FIRST TIME THRU GETS A FORM FEED + DCA DMP7 /FUTURE PASSES DON'T +DMP8, TAD USER+1 + CIA + DCA COUNTR /# SYMBOLS TO PROCESS NOW + TAD [3 + DCA BUFFER /FIRST SYMBOL IS HERE + JMP DMP6 /GET NO. LINES RIGHT FIRST TIME +DMP5, JMS I [CRLF /V3C +DMP, ISZ LNPRPG /IS FORM FEED NEEDED? + SKP /NOT YET + JMS I [FORM +DMP6, TAD [-3 + DCA SYMCNT /2 CHARACTERS PER PASS + DCA CONST /RESET FOR <4096 + TAD M12 + DCA LINENO +NXTDV, ISZ BUFFER + CDF 10 + TAD I BUFFER /PICK UP PACKED WORD + CDF 0 + SPA /PERMANENT SYMBOL? + JMP DPERM /YES + JMS I [DIVIDE /CONVERT 2 CHARS AND PRINT + ISZ SYMCNT + JMP NXTDV+1 + TAD [-4 + JMS I [SPACE /GENERATE(AC) SPACES + TAD BUFFER + CLL RTR /GET SYMBOL NUMBER + AND [1777 + DCA SYMNUM + JMS I (GETFLD + DCA CDFNA /CDF N + CDF 10 + TAD I BUFFER + DCA REFBUF /BASE OF REFS FOR SYMBOL +CDFNA, HLT + TAD I REFBUF /IF THIS IS NEGATIVE, + SPA CLA /WE LEFT A REF FOR A 0 ENTRY + TAD M1 /IN THAT CASE,DON'T INCLUDE THAT ONE AS + TAD [-2 /A REAL ENTRY. + DCA SYMCNT + TAD I REFBUF + AND [3777 /NOW CALCULATE REAL NO. ENTRIES + TAD SYMCNT + CIA + DCA SYMCNT + CLA CMA + TAD REFBUF + DCA REFBUF + TAD I REFBUF /SEQUENCE # OF DEF. + DCA DEFSEQ +DMP2, CLA CMA + TAD REFBUF + DCA REFBUF + TAD CDFNA + DCA .+1 + HLT + TAD I REFBUF /PICK UP A REFERENCE + TAD DEFSEQ /IS THIS THE DEF? + SZA CLA + JMP NODEF + DCA DEFSEQ /ONLY 1 DEF PER LINE + TAD [3 /YES..PRINT # AFTER SEQ # +NODEF, TAD [240 /IF NO, PRINT 2 SPACES + DCA SCHAR + TAD I REFBUF + SZA CLA /IF A 0, ALL FOLLOWING REFS ARE >4095 + JMP .+4 + TAD [140 + DCA CONST + JMP DMP2 /IGNORE ZERO ENTRY!! + TAD I REFBUF + CDF 0 + JMS I (CVTSEQ /WRITE THE DECIMAL SEQUENCE # + TAD SCHAR + JMS I [OCHAR /EITHER # OR SPACE + CLA CMA + JMS I [SPACE + ISZ SYMCNT /MORE TO DO? + JMP DMP0 /NO, BUT IS CR/LF REQUIRED? +GETMOR, ISZ COUNTR /EXHAUSTED ALL SYMBOLS? + JMP DMP5 + TAD FINI /YES..ARE WE ALL DONE + SNA CLA + JMP I [ENDPAS /NO..READ IN NEXT SEGMENT + JMP I (OCLOSE + +DMP0, ISZ LINENO /A CR/LF NEEDED? + JMP DMP2 + TAD M12 + DCA LINENO /RESET ENTRIES PER LINE + JMS I [CRLF /V3C + ISZ LNPRPG /FORM FEED? + SKP + JMS I [FORM + TAD M12 /AND INDENT NEXT LINE + JMS I [SPACE + JMP DMP2 + +DPERM, CLA + TAD [3 /PERMANENT SYMBOL + TAD BUFFER + DCA BUFFER /LOOK AT NEXT + ISZ COUNTR + JMP NXTDV + JMP GETMOR+2 + +FIRST, JMS I (ASHDLR /RESET INPUT FOR READ + JMS I (RDREC /AND READ SOME RECORDS + JMP I (NXTLIN /START READING TEXT + + +DEFSEQ, 0 +LINENO, -12 +PASTST, 0 /SR WHICH DETERMINE IF PASS > 1 + TAD PASSG1 + SPA CLA /IF >0=> PASS >1 + ISZ PASTST + JMP I PASTST + *2200 + +/I/O ROUTINES FOR OS/8 + +OUSETP, 0 + TAD (OUCTL&3700 + CIA + DCA OUDWCT /SIZE OF BUFF IN DOUBLEWORDS + TAD XOUBUF + DCA OUPTR /INITIALIZE POINTER + TAD OUJMPE + DCA OUJMP /RESET 3 WAY SWITCH + JMP I OUSETP + +OCHAR, 0 + AND (377 /CALLED WITH CHARACTER IN AC + DCA OUTEMP + JMS I [PASTST + JMP I OCHAR +OUTSW, KRS /TEST FOR ^C WITH FLAG OR + /JMP I OCHAR IF /P,/U OR PASS 2 /M + TAD (-203 + SNA CLA + KSF + JMP .+2 + JMP I [7600 /SAVE CORE FOR SOME REASON + ISZ OUJMP /BUMP 3 WAY SWITCH +OUJMP, HLT + JMP OCHAR1 + JMP OCHAR2 +OCHAR3, TAD OUTEMP /PICK UP CHARACTER + CLL RTL + RTL + AND (7400 /3RD WORD MERGED INTO 2 BUFFER WORDS + TAD I OUPOLD + DCA I OUPOLD + TAD OUTEMP + CLL RTR + RTR + RAR + AND (7400 + TAD I OUPTR + DCA I OUPTR + TAD OUJMPE + DCA OUJMP /RESET FOR NEW SET OF 3 CHARS + ISZ OUPTR /BUMP BUFFER POINTER + + ISZ OUDWCT + JMP OUCOMN + TAD OUCT /YEP + JMS OUTDMP /WRITE IT + JMS OUSETP /RESET OUT BUFFER + JMP I OCHAR +OCHAR2, TAD OUPTR + DCA OUPOLD /FOR LATER + ISZ OUPTR /SECOND WORD GOES HERE +OCHAR1, TAD OUTEMP + DCA I OUPTR +OUCOMN, JMP I OCHAR + + +OUTEMP, 0 /TEMP STORE +OUPOLD, 0 /HOLDS OLD POINTER +OUPTR, 0 +OUJMPE, JMP OUJMP +OUDWCT, 0 +OUCT, OUCTL + + +OOPEN, 0 /OPEN AN OUTPUT FILE;FETCH HANDLER + TAD (OFILE + DCA OUBLK /POINT TO FILE NAME + TAD XOUDEV + DCA OUHNDL /LEAVE ROOM FOR 2 PAGE HANDLER + CDF 10 + TAD I [7600 /OUTPUT DEVICE # + CDF 0 + CIF 10 + JMS I USR /ASSIGN,FETCH HANDLER + 1 +OUHNDL, HLT /GETS ENTRY POINT OF HANDLER + JMP HIOERR /HANDLER FAILURE +OUENTR, JMS I (P2ADJ + CDF 10 + TAD I [7600 + CDF 0 + CIF 10 + JMS I USR + 3 /ENTER OUTPUT FILE +OUBLK, OFILE +OUELEN, 0 /RETURNS WITH LENGTH OF HOLE + JMP OEFAIL +MP2, DCA I (OUCCNT + TAD OUBLK /STARTING RECORD + DCA OUREC + JMS OUSETP /SETUP OUTPUT AREA + JMP I OOPEN +XOUDEV, 4001 /MAY BE ALTERED + +OEFAIL, CDF 10 + TAD I [7600 + AND (7760 /GET LENGTH PART + SNA CLA /WAS IT 0? + JMP ERR3 /YEP..HE LOSES + TAD I [7600 + AND [17 /TRY WITH INDETERMINATE LENGTH + DCA I [7600 + JMP OUENTR + +OUTDMP, 0 /WRITE ACTUAL OUTPUT + DCA OUCTLW + JMS I (OUNREC /FIGURE # RECS TO WRITE + TAD I (OUCCNT + DCA I (OUCCNT /UPDATE CLOSE LENGTH + TAD I (OUCCNT + CLL CML + TAD OUELEN /ROOM FOR THIS WRITE? + SNL CLA + JMP ERR4 /HE LOSES + JMS I OUHNDL /NJ WRITE IT +OUCTLW, 0 +XOUBUF, OUBUF +OUREC, 0 + JMP HIOERR /A HANDLER BADNESS + JMS I (OUNREC + TAD OUREC /UPDATE OUTPUT RECORD # + DCA OUREC + JMP I OUTDMP + +ERR4, JMS I [ERROR + FULERR +ERR3, JMS I [ERROR + ENTERR + + *2400 +OCLOSE, TAD HCREF + SZA CLA /IF NOT LAST PASS + JMP NOVERS /NO NEED FOR VERSION NO. + JMS CRLF + TAD ("V-300^R+VERSN-"0+40 + JMS I [DIVIDE + TAD (PATCHL /PATCH NO.-ON PAGE + JMS I [OCHAR + JMS CRLF + JMS FORM /V3C +NOVERS, + TAD HCREF + SNA CLA /IF /M PASS 1 + TAD (232 + JMS I [OCHAR /NO 232 + JMS I [OCHAR +FILLIP, JMS I [OCHAR /FILL WITH 0'S + TAD (177 + AND I (OUDWCT + SZA CLA /TO BOUNDARY YET? + JMP FILLIP /NO..KEEP FILLING + TAD I (OUDWCT + TAD (OUCTL&3700 + SNA /FULL WRITE LEFT? + JMP NODUMP /YES..BUT ^Z IS OUT + TAD (4000+OUFLD /FORM WRITE + JMS I (OUTDMP +NODUMP, CIF 10 + JMS I USR + 10 /LOCK IN MONITOR + TAD I (OUREC + CDF 10 + DCA I OUSAVX + CDF 0 + TAD I (OUELEN + CDF 10 + DCA I OUSAVX + TAD LNPRPG + DCA I OUSAVX + TAD OUCCNT + DCA I OUSAVX + TAD I [7600 + CDF 0 + ISZ HCREF + JMP NOD1 + CIF 10 + JMS I [200 + 6 +BLK, 0 + 0 +NOD1, CIF 10 + JMS I [200 + 4 /CLOSE OUTPUT FILE + OFILE /POINTER TO FILE NAME +OUCCNT, 0 /CLOSING LENGTH + JMP ERR5 /SORRY +/FOR LONG FILES(/M), IT WILL CHAIN TO ITSELF ON FIRST PASS. +/ON SECOND PASS,IT WILL DELETE FILE CREFTM.LS(IF NO E) + ISZ SLSWH /DELETE TEMP FILE SWITCH + JMP ALDONE + CLA IAC /SYS + CDF 0 + CIF 10 + JMS I [200 + 4 /DELETE CREFLS.TM + CHANNM + 0 + CLA +ALDONE, JMP I [7605 +HCREF, 0 +SLSWH, 0 + +ERR5, JMS I [ERROR + CLSERR +ERR6, JMS I [ERROR + INPERR + + +OFILE, ZBLOCK 4 /OUTPUT FILE NAME GOES HERE + +FORM, 0 /GENERATE 214 IF NOT TTY + JMS I [PASTST /IF PASS>1, NO FORM FEED + JMP I FORM + TAD TTYSWT + SZA CLA + JMP FORM2 + TAD LNPRPG /FILL TO END OF PAGE + SNA /IF 0, GENERATE 8 LINE FEEDS + TAD [-4 + DCA COUNT + JMS CRLF + ISZ COUNT + JMP CRLF1 /HA! GENERATE EXTRA LINE FEED!! + TAD [-6 + DCA COUNT + TAD ("- /GENERATE ------ + JMS I [OCHAR + ISZ COUNT + JMP .-3 + TAD [-4 + DCA COUNT +FORM3, JMS CRLF + ISZ COUNT + JMP CRLF1 + TAD LINES /V3C + NOP + DCA LNPRPG /RESET TO TOP OF PAGE + JMP I FORM + +FORM2, CLA CMA + DCA COUNT + CMA + JMP FORM3 /USE [215 TO GENERATE A 214 + +CRLF, 0 /GENERATE CRRIAGE RET AND LINE FEED + TAD [215 + JMS I [OCHAR +CRLF1, TAD [212 + JMS I [OCHAR + JMP I CRLF + +TTYSWT, 0 + + + *2600 +IOPEN, 0 + CLA CMA + DCA INCHCT /FORCE READ OF NEW FILE + ISZ INEOF + TAD (7617 + DCA INFPTR + JMP I IOPEN + +INPTR, INBUF + +ICHAR, 0 +INCHAR, ISZ INJMP /PACKING SWITCH + ISZ INCHCT /BUFFER EXHAUSTED? +INJMPP, JMP INJMP /NOPE + TAD INEOF /WAS LAST AN EOF? + SNA CLA + JMP INGBUF /NO..GET NEXT INPUT + CDF 10 + TAD I INFPTR + CDF 0 + SNA CLA /MORE INPUT? + JMP I ICHAR /NO..EOF RETURN + + JMS ASHDLR /SET UP STRT RECORD +INGBUF, JMS RDREC /AND READ SOME RECORDS + JMP INCHAR + /THIS IS DONE TO OPTIMIZE THE DECTAPE + /ROCKING. INITIALIZATION DOES THESE + /THE FIRST TIME. + + +INJMP, JMP . /3 WAY SWITCH + JMP ICHAR1 + JMP ICHAR2 +ICHAR3, TAD INJMPP + DCA INJMP + TAD I INPTR + AND (7400 /CONTENTS OF BUFFER + CLL RTR + RTR + TAD INCTLW + RTR + RTR /GETS THIRD WORD FROM 1 AND 2 + ISZ INPTR /NEXT BUFFER LOC + JMP INCOMN +ICHAR2, TAD I INPTR + AND (7400 + DCA INCTLW /TEMP SAVE + ISZ INPTR +ICHAR1, TAD I INPTR +INCOMN, AND (177 /PARITY TEST + SNA /IF 200 CODE..IGNORE IT + JMP INCHAR + TAD [200 + TAD (-232 /IS IT ^Z? + SNA + JMP I ICHAR /YES..NOMMORE!! + TAD (232 + ISZ ICHAR /SKIP EOF RETURN + DCA CHAR + JMP I ICHAR +INCHCT, 0 +INFPTR, 7617 +INEOF, 0 +INCTR, 0 +INHAND, 0 + +ASHDLR, 0 + + CDF 10 + TAD I INFPTR + AND (7760 /LENGTH PART OF WORD + SZA /0 IMPLIES .GTE. 256 + TAD [17 + CLL CML RTR + RTR + DCA INCTR + ISZ INFPTR /BUMP TO NEXT + TAD I INFPTR /GET STARTING RECORD + DCA INREC + ISZ INFPTR + DCA INEOF + CDF 0 + JMP I ASHDLR +XINREC, 2 /DEFAULT CONDITIONS +XINCL1, 401 + +RDREC, 0 + TAD INCTR + CLL + TAD XINRECS /LINK ON IF OVERFLOW AND LAST READ + SNL + DCA INCTR /UPDATE IF NO OVERFLOW + SZL + ISZ INEOF + CLL CML CMA RTR /CONTROL WORD FROM OVERFLOW + RTR + RTR + TAD XINCL1 + DCA INCTLW + CDF 0 + JMS I INHAND +INCTLW, 0 +INBUFP, INBUF +INREC, 0 + JMP INERRX /FATAL OR EOF +INBREC, TAD INREC + TAD XINREC + DCA INREC /UPDATE # READ + TAD INCTLW + AND [7600 + CLL RAL + TAD INCTLW + AND [7600 + CMA + DCA INCHCT /NEW CHARACTER COUNT + TAD INJMPP + DCA INJMP + TAD INBUFP + DCA INPTR + JMP I RDREC + +INERRX, ISZ INEOF /FATAL OR EOF + SMA CLA + JMP INBREC /EOF..NEXT FILE + JMS I [ERROR + INPERR + +TTYPRT, 0 /SIMPLE TTY OUTPUT ROUTINE + TLS + TSF + JMP .-1 + CLA + JMP I TTYPRT + + + *3000 +HNDERR, "H-300^R+"A-300 /HANDLER FAIL + "N-300^R+"D-300 + "L-300^R+"E-300 + "R-300^R + "F-300^R+"A-300 + "I-300^R+"L-300 + +SYMERR, "S-300^R+"Y-300 + "M-300^R + "O-300^R+"V-300 + "E-300^R+"R-300 + "F-300^R+"L-300 + "O-300^R+"W-300 + +LPTERR, "D-300^R+"E-300 /DEV LPT BAD + "V-300^R + "L-300^R+"P-300 + "T-300^R + "B-300^R+"A-300 + "D-300^R + +ENTERR, "E-300^R+"N-300 + "T-300^R+"E-300 + "R-300^R + "F-300^R+"A-300 + "I-300^R+"L-300 + "E-300^R+"D-300 + +FULERR, "O-300^R+"U-300 + "T-300^R + "D-300^R+"E-300 + "V-300^R + "F-300^R+"U-300 + "L-300^R+"L-300 + +CLSERR, "C-300^R+"L-300 + "O-300^R+"S-300 + "E-300^R + "F-300^R+"A-300 + "I-300^R+"L-300 + "E-300^R+"D-300 + +INPERR, "I-300^R+"N-300 + "P-300^R+"U-300 + "T-300^R + "E-300^R+"R-300 + "R-300^R+"O-300 + "R-300^R + +REFERR, 2664 /2045 REFS + 3015 + "R-300 + "E-300^R+"F-300 + "S-300^R + 0 + +/LITERAL PROCESSORS. LITERALS ARE HANDLED ACCORDING TO THEIR +/BINARY DEFINITION. A CURRENT PAGE LITERAL AT,SAY, 0377 WILL +/BE CALLED _L0377. A PAGE ZERO LITERAL AT LOCATION 0100 WILL +/BE CALLED _L0100 +/IF ASSEMBLED WITH NEW PAL8, LITERAL INCLUDES FIELD +/SO 00377 IS _00377, 10377 IS _10377 + +LIT2, TAD (2540 /PAGE 0..FIRST NUMBER ALWAYS 0 + DCA SYM2 /_L GOES IN SYM1 FOR BOTH + JMS LCHK + ISZ ISYM + ISZ ISYM /POINT TO SYM3 FOR LAST 2 DIGITS + JMP LIT3 /COMMON CODE +LIT1, JMS LCHK + ISZ ISYM /POINT TO SECOND WORD + TAD I XRLIT /FIRST BINARY DIGIT + JMS I [PACK + TAD I XRLIT + AND (266 /THIS KNOCKS OFF RELATIVE ADDRESS BIT + JMS I [PACK /GOES INTO RIGHT HALF OF SYM2 +LIT3, TAD DSWIT /IF /D, DON'T CREF LITERALS + SZA CLA + JMP LITEX /DON'T DO ANYTHING BUT CLEAR COUNTERS + TAD (LITBUF+1 /NOW PICK UP RELATIVE ADD BIT FROM INSTRUCT. + DCA XRLIT + TAD I XRLIT + AND (1 + TAD SYM2 + DCA SYM2 /FORMING ADDRESS OF LITERAL! + TAD I XRLIT + JMS I [PACK + TAD I XRLIT + JMS I [PACK /LOAD UP SYM3 + TAD ENDFIX /WILL PRINT FIELD WITH LIT IF NEW PAL8 + AND (57 + TAD [2426 + DCA SYM1 /PUT IN _ (NEGATIVE!) + JMS I (REPACK + + JMP I XUSSYM /DO THE BOOKKEEPING +LITEX, JMS I (REPACK + JMP I [B +XUSSYM, USSYM /WILL BE CHANGED TO PATCH IF /L +LCHK, 0 + TAD MARGIN + DCA XRLIT + TAD I XRLIT + DCA ENDFIX + TAD ENDFIX + TAD (-240 + SNA CLA + JMP LITEX + JMP I LCHK + +GLIN5, TAD CRCNT + SNA CLA + JMP CROUT /NEED THIS CR + ISZ CRCNT + JMP CROUT /NEED CR AFTER HEADER + JMP I (GETLIN +CROUT, TAD [212 + JMS I FPUT + TAD MARGIN + DCA XRLINE + JMP I (GLIN6 +CRCNT, 0 +CHANNM, FILENAME CREFLS.TM +ENDFIX, 0 /TEMP ALSO + JMS I (DOLOT2 + DCA .-1 /ONCE ONLY + TAD SYSM + SNA + JMP I (NDPS1 + JMP I ENDFIX + *3200 +OUNREC, 0 /ESTIMATE # RECS + TAD I XOCTLW + CLL RTL + RTL + RTL /ITS NOT AN ESTIMATE, BUT EXACT!! + AND [17 + JMP I OUNREC +XOCTLW, OUCTLW + +DIVIDE, 0 + DCA DIV45B + DCA DIV45C + JMP DIV45D /START UP HERE + +DIV45A, ISZ DIV45C /BUMP THE QUOTIENT + DCA DIV45B /NEW DIVIDEND +DIV45D, TAD DIV45B + TAD (-52 /DIVIDE BY 52 + SMA + JMP DIV45A /STILL +; KEEP LOOPING + TAD (52 /REMAINDER IN AC AFTER ADD + JMS I (DIVE /LETTER OR NUMBER? + DCA DIV45B + TAD DIV45C + JMS I (DIVE + JMS I [OCHAR + TAD DIV45B + JMS I [OCHAR + ISZ BUFFER + JMP I DIVIDE + + +DIV45B, 0 +DIV45C, 0 + + GETLIN, 0 /GET A LINE OF INPUT AND STORE + TAD MARGIN /IT AT LINBUF + DCA XRLINE +INLINE, JMS I (ICHAR + JMP EN + TAD RLSKIP /IF RALF HEADER,ELIM 2 LF + SNA CLA + JMP REGULR /NOT RALF + ISZ RLSKIP /CATCH 2ND LINE + JMP INLINE + TAD [7776 /ELIM EXTRA CR AFTER HEADER + DCA I (CRCNT +REGULR, TAD CHAR /LINE FEED TERMINATES THIS ROUTINE + TAD MLF + SNA + JMP INLINE /IGNORE LF'S ON INPUT + TAD [212-215 /LF-CR + SNA CLA + JMP GLIN3 + TAD XRLINE + TAD (-375 + SMA CLA + JMP .+3 + TAD CHAR + JMS I FPUT + TAD CHAR + TAD [-214 + SZA CLA + JMP INLINE +GLIN3, TAD [215 + JMS I FPUT +GLIN4, JMP I (GLIN5 +GLIN6, TAD [200 /TEST FOR ^C + KRS + TAD (-203 + SNA CLA + KSF + JMP I GETLIN + JMP I [7605 /FOUND ^C +RLSKIP, 0 + +ALLOCT, 0 + JMS I (DEVCHK + 7617 /CHECK INPUT DEVICE + SPA CLA + IAC /2 PAGE HANDLER + DCA BUFCNT + JMS I (DEVCHK + 7600 /CHECK SIZE OF OUTPUT DEV HANDLER + SPA CLA + TAD [2 /2 PAGES + TAD BUFCNT + DCA BUFCNT + CLL + TAD BUFCNT + RAR + CLA + SZL CLL /IF 1 OR 3,IN DEV IS 2 PGS + TAD [200 + TAD (3601 + DCA I (XOUDEV + TAD [-2 + TAD BUFCNT + SMA SZA CLA + JMP I ALLOCT /2 2PAGERS IS DEFAULT + TAD (4200 /IF NOT 2 2PAGERS,INBUF AT 4200 + DCA I (INBUFP + TAD I (INBUFP + DCA I (INPTR + TAD [3 + DCA I (XINREC + TAD (601 + DCA I (XINCL1 + JMP I ALLOCT +BUFCNT, 0 +CLEAR, 0 /ROUTINE TO CLEAN OUT OLD SYMBOL + DCA SYM1 + DCA SYM2 + DCA SYM3 + JMP I CLEAR + +EN, JMS DPAT /V3D + JMP I [ENDPAS + + + /THIS INITIALIZATION CODE IS DESTROYED WHEN DATA IS READ +/INTO THE BUFFER. FOR THAT REASON, CREF IS NOT RESTARTABLE + + *4200 +ST1, CDF 0 +KLUD, CIF 10 + JMS I USR + 5 + 1423 /DEFAULT EXTENSION IS .LS +CHAIN, CDF 10 + TAD I (7617 /IF NO INPUT, RESTART CD + SNA CLA + JMP ST1 + TAD I [7600 /IF NO OUTPUT, GIVE HIM LPT!! + SZA CLA + JMP ST2 + CDF 0 + CIF 10 + JMS I [200 + 12 /ASSIGN-NO FETCH + 1420 +DEVS, 2400 + 0 + JMP ERRTWO /DEFAULT DEVICE IS BAD + TAD DEVS + CDF 10 + DCA I [7600 +ST2, CDF 0 + JMS I (SWITCH + CDF 10 + TAD I OUSAVX + CDF 0 + DCA PASS2 +BLUE0, TAD [-4 + DCA COUNT +BLUE, CDF 10 + TAD I XNAME + CDF 0 + DCA I (OFILE + ISZ XNAME + ISZ (OFILE + ISZ COUNT + JMP BLUE + JMS I (ALLOCT + JMS I (OTYPE + AND (770 /CHECK FOR TTY AS OUTPUT (CAN CLA IF DEBUGGING) + DCA I (TTYSWT + TAD I (TTYSWT /IF LPT IS OUTPUT, + SZA CLA /NO INTERNAL FORM FEEDS GENERATED + DCA I (NOFORM + + + +/NOW WE MOVE UP THE PERMANENT AND PSEUDO-OP TABLES. +/THE Y WERE ASSEMBLED IN FIELD 0 TO SAVE DECTAPE MOTION +/WHEN LOADING. + JMS I (FTEST /GET MACHINE SIZE + TAD MAXFLD + CIA + DCA MAXFLD /- NO.FIELDS + CDF 10 /ASSIGN THE INPUT HANDLER + TAD I (7617 + CDF 0 + CIF 10 + JMS I USR + 1 +INHNDL, INDEVH+1 + HLT /YECH!!! + TAD INHNDL + DCA I (INHAND /SETUP ENTRY POINT + JMS I (ASHDLR /SET UP FIRST READ + TAD (7700 + DCA USR /SAVE SYMBOL TABLE + TAD I (7746 + AND KLUD + TAD [1000 /MARK NOT RESTARTABLE + DCA I (7746 /SAVE CORE BIT + TAD I XRLINE + DCA COUNT /INITIAL LOAD PROVIDES PARAMETERS FOR + /THE SYMBOL TABLE. THIS IS # WORDS TO MOVE + JMS MOVEM + TAD RSWIT + SNA CLA /DETERMINE WHICH PSEUDO-OPS + TAD (PPSEUD-SPSEUD + TAD (SPSEUD-1 + DCA XRLINE + TAD I XRLINE + DCA PSEUDO /TABLES INITIALLY HAVE A SHORT HEADER + /WHICH CONTAINS INFORMATION ABOUT THEM + /PSEUDO CONTAINS STARTING # OF FIRST + + + + TAD I XRLINE + DCA PSEUDO+1 /LAST ENTRY # + TAD I XRLINE + DCA COUNT /# ENTRIES TO MOVE + TAD I XRLINE + DCA XRLIT /WHERE THEY GO IN FIELD 1 + JMS MOVEM + JMP I (XFIRST /READ FIRST RECORDS + + +MOVEM, 0 + TAD I XRLINE + CDF 10 + DCA I XRLIT + CDF 0 + ISZ COUNT + JMP .-5 + JMP I MOVEM +ERRTWO, JMS I [ERROR /THIS IS AN IMPOSSIBLE ERROR + LPTERR +CHANCK, 0 + CLL RTL /CHECK FOR /C+/E + RAL + SNL + JMP I CHANCK //C IS MINIMUM CONDITION + RTR /V3C USE /1 TO MEAN KEEP CREFLS.TM + SNL CLA + CMA /-1 IF NO E (I.E. DO ELIMINATE) + DCA I (SLSWH + JMP I CHANCK +XNAME, 7601 +PASS2, 0 + +PATCHA, TAD (35 + DCA USER+1 + JMP BLUE0 + *4400 +SWITCH, 0 + JMS I (FILEXT + CLA IAC + CDF 10 + AND I (7644 /TEST FOR /X + DCA DSWIT + TAD I (7643 + CDF 0 + JMS I (CHANCK + CDF 10 + CLA CLL + TAD I (7644 + AND (410 /P OR /U USED? + SNA + JMP ST3 + CDF 0 + AND [10 + SNA CLA + JMP TXONLY /JUST /P + TAD XDOLL + DCA I (DOLL12 /NO SYMBOL TABLE +TXONLY, TAD KILOUT /YES..DISABLE PASS ONE OUTPUT + DCA I [OUTSW +ST3, CLA + CDF 10 + TAD I (7644 + CDF 0 + AND (300 /IF SABR (Q), SET RSWIT AND DSWIT + SNA + JMP HCR1 /PAL8 + AND [200 /CHECK FOR RALF + SNA CLA + JMP RALFCD /Y + ISZ RSWIT + ISZ DSWIT + DCA I (SCAN3 /ENABLE CHECK FOR SABR CHARS +HCR1, CLA + CDF 10 + TAD I (7644 /CHECK FOR M- MAMMOTH FILE(HCREF) + CDF 0 + SMA CLA + JMP I (BLUE0 /NOT LONG FILE +/PUT IN NECESSARY PATCHES + CLL + TAD XPATCH + DCA I (HC1 + TAD XPTCH1 + DCA I (XUSSYM + CDF 10 + TAD I (7645 + RAR /CHECK IF PASS1 OR 2 FOR /M + SNL + JMP CHNPS1 /PASS 1 + RAL CLL /IT'S PASS 2 + DCA I (7645 /RESTORE TBL + CDF 0 + CIF 10 + JMS I (7700 /RESTORE USR + 10 + TAD KILOUT + DCA I [OUTSW /NO LIST + TAD XDOLL + DCA I (DOLL12 + TAD [7720 + DCA I (PATCH1 /ANOTHER PATCH + JMP I SWITCH +CHNPS1, CLL CML RAL + DCA I (7645 /SET /9 SWITCH + CDF 0 + CLA CMA + DCA I (HCREF /7777 DURING PASS1 + JMS I (CHNSET /LOOKUP CREF.SV + JMP I (PATCHA +XPATCH, PATCH&177+5200 +XPTCH1, PATCH +XDOLL, DOLL13&177+5200 +RALFCD, TAD [7776 /FOR 2 EXTRA LINE FEEDS + DCA I (RLSKIP + JMP HCR1 +KILOUT, OCHAR&177+5600 /JMP I OCHAR + + +/SUBROUTINE TO DETERMINE CORE SIZE +FTEST, 0 + JMS I (MORCOR +COR0, CDF 0 + TAD MAXFLD /GET FIELD TO TEST + RTL + RAL + AND COR70 + TAD COREX + DCA .+1 +COR1, CDF /FIELD TO TEST + TAD I CORLOC +COR2, NOP + DCA COR1 + TAD COR2 + DCA I CORLOC +COR70, 70 + TAD I CORLOC +CORX, 7400 + TAD CORX + TAD CORV + SZA CLA + JMP COREX /NON-EXISTENT FIELD + TAD COR1 + DCA I CORLOC + ISZ MAXFLD + JMP COR0 +COREX, CDF 0 +DONCOR, JMP I FTEST +CORLOC, CORX +CORV, 1400 + + FIELD 0 +/THESE ARE THE PERMANENT AND PSEUDO OP TABLES FOR CREF +/RAD IS THE BASE USED TO PACK THE CHARACTERS. FOR SABR IT MAY +/HAVE TO BE MOVED TO 51 RATHER THAN 45. + +RAD=52 + + *4600 + +SYMTAB, -453 /INITIAL ENTRIES + + NOPUNCH + *0 + ENPUNCH + ZBLOCK 4 /DUMMY ENTRY..SYMCHK NEEDS IT + + + "A-300^RAD+"N-300+4000 /AND + "D-300^RAD + ZBLOCK 2 + + "B-300^RAD+"S-300+4000 /BSW + "W-300^RAD + ZBLOCK 2 + + "C-300^RAD+"A-300+4000 /CAF + "F-300^RAD + ZBLOCK 2 + + "C-300^RAD+"D-300+4000 /CDF + "F-300^RAD + ZBLOCK 2 + + "C-300^RAD+"I-300+4000 /CIA + "A-300^RAD + ZBLOCK 2 + + "C-300^RAD+"I-300+4000 /CIF + "F-300^RAD + ZBLOCK 2 + + "C-300^RAD+"L-300+4000 /CLA + "A-300^RAD + ZBLOCK 2 + + "C-300^RAD+"L-300+4000 /CLL + "L-300^RAD + ZBLOCK 2 + + "C-300^RAD+"M-300+4000 /CMA + "A-300^RAD + ZBLOCK 2 + +R=52 + + "C-300^R+"M-300+4000 /CML + "L-300^R + ZBLOCK 2 + + "D-300^R+"C-300+4000 /DCA + "A-300^R + ZBLOCK 2 + "G-300^R+"L-300+4000 /GLK + "K-300^R + ZBLOCK 2 + + "G-300^R+"T-300+4000 /GTF + "F-300^R + ZBLOCK 2 + + "H-300^R+"L-300+4000 /HLT + "T-300^R + ZBLOCK 2 + + "I-300^R+"A-300+4000 /IAC + "C-300^R + ZBLOCK 2 + + "I-300^R+"O-300+4000 /IOF + "F-300^R + ZBLOCK 2 + + "I-300^R+"O-300+4000 /ION + "N-300^R + ZBLOCK 2 + + "I-300^R+"O-300+4000 /IOT + "T-300^R + ZBLOCK 2 + + "I-300^R+"S-300+4000 /ISZ + "Z-300^R + ZBLOCK 2 + + "J-300^R+"M-300+4000 /JMP + "P-300^R + ZBLOCK 2 + + "J-300^R+"M-300+4000 /JMS + "S-300^R + ZBLOCK 2 + + "K-300^R+"C-300+4000 /KCC + "C-300^R + ZBLOCK 2 + + "K-300^R+"C-300+4000 /KCF + "F-300^R + ZBLOCK 2 + + "K-300^R+"I-300+4000 /KIE + "E-300^R + ZBLOCK 2 + + "K-300^R+"R-300+4000 /KRB + "B-300^R + ZBLOCK 2 + + "K-300^R+"R-300+4000 /KRS + "S-300^R + ZBLOCK 2 + + "K-300^R+"S-300+4000 /KSF + "F-300^R + ZBLOCK 2 + + "L-300^R+"A-300+4000 /LAS + "S-300^R + ZBLOCK 2 + + "M-300^R+"Q-300+4000 /MQA + "A-300^R + ZBLOCK 2 + + "M-300^R+"Q-300+4000 /MQL + "L-300^R + ZBLOCK 2 + + "N-300^R+"O-300+4000 /NOP + "P-300^R + ZBLOCK 2 + + "O-300^R+"P-300+4000 /OPR + "R-300^R + ZBLOCK 2 + + "O-300^R+"S-300+4000 /OSR + "R-300^R + ZBLOCK 2 + + "P-300^R+"C-300+4000 /PCE + "E-300^R + ZBLOCK 2 + + "P-300^R+"C-300+4000 /PCF + "F-300^R + ZBLOCK 2 + + "P-300^R+"L-300+4000 /PLS + "S-300^R + ZBLOCK 2 + + "P-300^R+"P-300+4000 /PPC + "C-300^R + ZBLOCK 2 + + "P-300^R+"S-300+4000 /PSF + "F-300^R + ZBLOCK 2 + + "R-300^R+"A-300+4000 /RAL + "L-300^R + ZBLOCK 2 + + "R-300^R+"A-300+4000 /RAR + "R-300^R + ZBLOCK 2 + + "R-300^R+"D-300+4000 /RDF + "F-300^R + ZBLOCK 2 + + "R-300^R+"F-300+4000 /RFC + "C-300^R + ZBLOCK 2 + + "R-300^R+"I-300+4000 /RIB + "B-300^R + ZBLOCK 2 + + "R-300^R+"I-300+4000 /RIF + "F-300^R + ZBLOCK 2 + + "R-300^R+"M-300+4000 /RMF + "F-300^R + ZBLOCK 2 + + "R-300^R+"P-300+4000 /RPE + "E-300^R + ZBLOCK 2 + + "R-300^R+"R-300+4000 /RRB + "B-300^R + ZBLOCK 2 + + "R-300^R+"S-300+4000 /RSF + "F-300^R + ZBLOCK 2 + + "R-300^R+"T-300+4000 /RTF + "F-300^R + ZBLOCK 2 + + "R-300^R+"T-300+4000 /RTL + "L-300^R + ZBLOCK 2 + + "R-300^R+"T-300+4000 /RTR + "R-300^R + ZBLOCK 2 + + "S-300^R+"G-300+4000 /SGT + "T-300^R + ZBLOCK 2 + + "S-300^R+"K-300+4000 /SKON + "O-300^R+"N-300 + ZBLOCK 2 + + "S-300^R+"K-300+4000 /SKP + "P-300^R + ZBLOCK 2 + + "S-300^R+"M-300+4000 /SMA + "A-300^R + ZBLOCK 2 + + "S-300^R+"N-300+4000 /SNA + "A-300^R + ZBLOCK 2 + + "S-300^R+"N-300+4000 /SNL + "L-300^R + ZBLOCK 2 + + "S-300^R+"P-300+4000 /SPA + "A-300^R + ZBLOCK 2 + + "S-300^R+"R-300+4000 /SRQ + "Q-300^R + ZBLOCK 2 + + "S-300^R+"T-300+4000 /STA + "A-300^R + ZBLOCK 2 + + "S-300^R+"T-300+4000 /STL + "L-300^R + ZBLOCK 2 + + "S-300^R+"W-300+4000 /SWP + "P-300^R + ZBLOCK 2 + + "S-300^R+"Z-300+4000 /SZA + "A-300^R + ZBLOCK 2 + + "S-300^R+"Z-300+4000 /SZL + "L-300^R + ZBLOCK 2 + + "T-300^R+"A-300+4000 /TAD + "D-300^R + ZBLOCK 2 + + "T-300^R+"C-300+4000 /TCF + "F-300^R + ZBLOCK 2 + + "T-300^R+"F-300+4000 /TFL + "L-300^R + ZBLOCK 2 + + "T-300^R+"L-300+4000 /TLS + "S-300^R + ZBLOCK 2 + + "T-300^R+"P-300+4000 /TPC + "C-300^R + ZBLOCK 2 + + "T-300^R+"S-300+4000 /TSF + "F-300^R + ZBLOCK 2 + + "T-300^R+"S-300+4000 /TSK + "K-300^R + ZBLOCK 2 + -1 + -1 + -1 + -1 /DUMMY LOW ENTRY + + +/PSEUDO OP TABLES. ENTRIES ARE SAME FORMAT AS PAL8 +/SYMBOLS. + + *.+SYMTAB + +SPSEUD, 1706 /SABR PSEUDOS. BEGINS AT 1706*4 + 1737 /ENDS AT 1737*4 + -150 /150 LOCATIONS LONG + 7427 /STARTS LOADING AT 17430 + + NOPUNCH + *7430 + ENPUNCH + + ZBLOCK 4 + + + "A-300^R+"B-300 /ABSYM + "S-300^R+"Y-300 + "M-300^R + B /RETURN POINT + + "A-300^R+"R-300 /ARG + "G-300^R + 0 + B + + "B-300^R+"L-300 /BLOCK + "O-300^R+"C-300 + "K-300^R + B + + "C-300^R+"A-300 /CALL + "L-300^R+"L-300 + 0 + B + + "C-300^R+"O-300 /COMMON + "M-300^R+"M-300 + "O-300^R+"N-300 + B + + "C-300^R+"P-300 /CPAGE + "A-300^R+"G-300 + "E-300^R + B + + "D-300^R+"E-300 /DECIM + "C-300^R+"I-300 + "M-300^R + B + + "D-300^R+"U-300 /DUMMY + "M-300^R+"M-300 + "Y-300^R + B + + "E-300^R+"A-300 /EAP + "P-300^R + 0 + B + + "E-300^R+"N-300 /END + "D-300^R + 0 +EPASS, DOLL1 /BECOMES ENDPAS + + "E-300^R+"N-300 /ENTRY + "T-300^R+"R-300 + "Y-300^R + B + + "F-300^R+"O-300 /FORTR + "R-300^R+"T-300 + "R-300^R + B + + "I-300^R + 0 + 0 + B /I + + "I-300^R+"F-300 /IF + 0 + 0 + B + + "I-300^R+"N-300 /INC + "C-300^R + 0 + B + + "L-300^R+"A-300 /LAP + "P-300^R + 0 + B + + "O-300^R+"C-300 /OCTAL + "T-300^R+"A-300 + "L-300^R + B + + "O-300^R+"P-300 /OPDEF + "D-300^R+"E-300 + "F-300^R +FXR2, FXMR + + "P-300^R+"A-300 /PAGE + "G-300^R+"E-300 + 0 + B + + "P-300^R+"A-300 /PAUSE + "U-300^R+"S-300 + "E-300^R + B + + "R-300^R+"E-300 /REORG + "O-300^R+"R-300 + "G-300^R + B + + "R-300^R+"E-300 /RETRN + "T-300^R+"R-300 + "N-300^R + B + + "S-300^R+"K-300 /SKPDF + "P-300^R+"D-300 + "F-300^R +FXR3, FXMR + + "T-300^R+"E-300 /TEXT + "X-300^R+"T-300 + 0 + TXT + + -1 + -1 + -1 + -1 + + + +/PAL8 PSEUDOS. SAME FORMAT AS OTHERS + + *5424 + ENPUNCH + +PPSEUD, 1706 + 1737 + -150 + 7427 + + NOPUNCH + *7430 + ENPUNCH + + ZBLOCK 4 + + + "D-300^R+"E-300 /DECIMAL + "C-300^R+"I-300 + "M-300^R+"A-300 + B + + "D-300^R+"E-300 /DEVICE + "V-300^R+"I-300 + "C-300^R+"E-300 + B + + "D-300^R+"T-300 /DTORG + "O-300^R+"R-300 + "G-300^R + B + + "E-300^R+"J-300 /EJECT + "E-300^R+"C-300 + "T-300^R + NOTBIN /SKIP ANY MORE TEXT + + "E-300^R+"N-300 /ENPUNCH + "P-300^R+"U-300 + "N-300^R+"C-300 + B + + "E-300^R+"X-300 /EXPUNGE + "P-300^R+"U-300 + "N-300^R+"G-300 +XPJ, XPUNJ + + "F-300^R+"I-300 /FIELD + "E-300^R+"L-300 + "D-300^R + B + + "F-300^R+"I-300 /FILENAME + "L-300^R+"E-300 + "N-300^R+"A-300 + B + + "F-300^R+"I-300 /FIXMRI + "X-300^R+"M-300 + "R-300^R+"I-300 +FXR, FXMR + + "F-300^R+"I-300 /FIXTAB + "X-300^R+"T-300 + "A-300^R+"B-300 +FXT, FXTAB + + "I-300^R /I + ZBLOCK 2 + B + + "I-300^R+"F-300 /IFDEF + "D-300^R+"E-300 + "F-300^R + B + + "I-300^R+"F-300 /IFNDEF + "N-300^R+"D-300 + "E-300^R+"F-300 + B + + "I-300^R+"F-300 /IFNZRO + "N-300^R+"Z-300 + "R-300^R+"O-300 + B + + "I-300^R+"F-300 /IFZERO + "Z-300^R+"E-300 + "R-300^R+"O-300 + B + + "N-300^R+"O-300 /NOPUNCH + "P-300^R+"U-300 + "N-300^R+"C-300 + B + + "O-300^R+"C-300 /OCTAL + "T-300^R+"A-300 + "L-300^R + B + + "P-300^R+"A-300 /PAGE + "G-300^R+"E-300 + 0 + B + + "P-300^R+"A-300 /PAUSE + "U-300^R+"S-300 + "E-300^R + B + + "R-300^R+"L-300 /RELOC + "L-300^R+"O-300 + "C-300^R + B + + "T-300^R+"E-300 /TEXT + "X-300^R+"T-300 + 0 + TXT + + "X-300^R+"L-300 /XLIST + "I-300^R+"S-300 + "T-300^R + B + + "Z-300^R /Z + ZBLOCK 2 + B + + "Z-300^R+"B-300 /ZBLOCK + "L-300^R+"O-300 + "C-300^R+"K-300 + B + + -1 + -1 + -1 + -1 + + + + *5600 +/THIS CODE IS EXECUTED DURING PASS ONE ONLY. LATER PASSES +/USE THIS AREA TO BUILD A REFERENCE TABLE. + + +HEADER, 0 /HEADER SWITCHES FPUT TO JMS I [OCHAR + TAD CPCHIT + DCA FPUT /ADDRESS OF PUNCH ROUTINE + JMS I CGTLIN /CALL GETLIN + TAD CSTRIT /RESTORE FPUT + DCA FPUT + JMP I HEADER +CPCHIT, PNCHIT +CGTLIN, GETLIN +CSTRIT, STORIT + +PNCHIT, 0 + JMS I COCHAR + JMP I PNCHIT + +STORIT, 0 + DCA I XRLINE + JMP I STORIT +COCHAR, OCHAR + +DOLL1, TAD (ENDPAS + DCA DOLLAR + JMS DPAT +DOLL12, TAD (KRS /BECOMES JMP .+2 IF /M PASS 2 OR /U + DCA I (OUTSW /RE ENABLE OUTPUT +DOLL13, CDF 10 + TAD RSWIT + SNA CLA + JMP DOLL2 /PAL8 PSEUDOS + TAD (B + DCA I (FXR2 + TAD (B + DCA I (FXR3 + TAD (ENDPAS + DCA I (EPASS /END PSEUDO NOW TO ENDPAS + JMP DOLOUT +DOLL2, TAD (B + DCA I (XPJ + TAD (B + DCA I (FXR + TAD (B + DCA I (FXT +DOLOUT, CDF 0 + JMS DOLOT2 + JMP I (NOTBIN +FUDGE, NOP + + +XPUNJ, DCA COUNT + CLA CMA + TAD USER+1 /SKIP LAST ENTRY (7777) + CLL RTL +XPUNJ3, DCA BUFFER /POINTER INTO SYMBOLS + CDF 10 + TAD I BUFFER + TAD (5336 /IS THIS A LITERAL? + SNA CLA + JMP XPUNJ1 /YES..NEXT ENTRY + TAD COUNT /NO..NOW PUSH ALL LITERALS UP + CLL RTL /BUT IF COUNT =0, THERE ARE NONE + CMA + DCA SAVE + TAD (3 + TAD BUFFER /SETTING UP TO DO TRANSFER. IF COUNT=0 + DCA XRSYM1 /ONLY THE 7777 GETS TRANSFERRED + TAD (3 + DCA XRSYM2 + TAD I XRSYM1 + DCA I XRSYM2 + ISZ SAVE /ALL COMPLETED? + JMP .-3 + TAD COUNT + IAC /INCLUDE 7777 ENTRY! + DCA USER+1 + CDF 0 + JMP I (B +XPUNJ1, TAD (-4 + TAD BUFFER + ISZ COUNT + JMP XPUNJ3 + +XFIRST, JMS I (OOPEN + JMP I (FIRST+1 + +DOLOT2, 0 + STL RTL /IF WE HAVE MORE THAN 2 FIELDS, + TAD MAXFLD /WE SHALL LEAVE THE SYMBOL TABLE IN ONE + /PIECE. THAT ALLOWS US TO USE THE UPPER + SZL CLA /CORE PROFITABLY + JMP I DOLOT2 + TAD USER+1 + CLL RTL + TAD (4 /CLEARS SYMBOL TABLE + DCA I (LTTBL+1 /FIX PERMANENT LIMIT IN FIELD 1 + DCA SYMFLD /AND FAKE THAT FLD 1 HAS NO SYMBOLS + TAD FUDGE /DISABLE RESET OF FIELD 1 LIMIT + DCA I (FUJ1 + JMP I DOLOT2 + +CHNSET, 0 + CLA IAC /SYS DEV ONLY + CIF 10 + JMS I (200 + 2 /LOOKUP +STBLK, CREFNM /GET CREF STARTING BLK + 0 + JMP I (ERR6 + TAD STBLK + DCA I (BLK + JMP I CHNSET +CREFNM, FILENAME CREF.SV + PAGE + +FXMR, TAD I XRLINE /SHOULD CONTAIN FIRST CHAR IN INSTR. + DCA CHAR + JMS I (CHECK /CHECK IT + 301 + -332 + JMP .+4 /NOPE;A NUMBER MAYBE? +FX2, TAD CHAR + JMS I (PACK + JMP FXMR + JMS I (CHECK + 260 + -271 /CHECK FOR DIGIT 0-9 + SKP /NOPE. IF THERE IS A SYMBOL, THIS IS TERMINATOR + JMP FX2 + JMS I (REPACK + TAD SYM1 + SNA CLA + JMP FXMR + CDF 10 + TAD I (7644 /M RULES FOR FIXMRI TOO + CDF 0 + SMA CLA + JMP FXNTR /NO M + TAD I (PATCH1 + DCA PATCH2 /APPROPRIATE SWITCH + TAD SYM1 + RTL +PATCH2, HLT /SPA SZA OR SMA SNL + CLA + JMP I (B +FXNTR, JMS I (SYMCHK + USER + JMS I (ENTRY /ENTER AS USER SYMBOL + JMS I (BUMP + JMP I (B +FXTAB, CLA CMA /DON'T INCLUDE 7777 ENTRY + TAD USER+1 + CIA + DCA COUNT /# ENTRIES TO EXAMINE + DCA SAVE +FXTB2, TAD (4 + TAD SAVE + DCA SAVE +FXTB9, CDF 10 + TAD I SAVE /STOP AS SOON AS LITERAL FOUND + TAD (5336 + SNA CLA + JMP FXTB3 + TAD I SAVE /IF ALREADY NEG. ITS A PERM SYMBOL + SMA + TAD (4000 /MAKE IT PERMANENT + DCA I SAVE + ISZ COUNT + TAD (3 + TAD SAVE + DCA SAVE + DCA I SAVE + ISZ SAVE + JMP FXTB9 /LOOP FOR DURATION +FXTB3, CDF 0 + JMP I (B + +DEVCHK, 0 + TAD I DEVCHK + DCA T2 /SAVE TBL START + ISZ DEVCHK + CDF 10 + TAD I T2 /HANDLER NUMBER + AND (17 + DCA T2 + CLA CMA + TAD I (37 /TBL LOCN IN 10037 + TAD T2 + DCA T2 + TAD I T2 + CDF 0 + JMP I DEVCHK +T2, 0 +/THAT'S ALL FOLKS!! +$$$$$$$$$$$$$$$$$$ + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/EPIC.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/EPIC.PA new file mode 100644 index 0000000..0fe9959 --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/EPIC.PA @@ -0,0 +1,1983 @@ +/EPIC PROGRAM, V5A +/ +/ +/ +/ +/ +/ +/ +// +/ +/ +/ +/ +/COPYRIGHT (C) 1973, 1975, 1977 +/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. +/ +/ +/ +/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A +/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- +/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER +/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE +/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO +/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE +/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. +/ +/ +/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT +/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL +/EQUIPMRNT COROPATION. +/ +/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS +/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. +/ +/ +/ +/ +/ +/ + /EPIC PROGRAM +/COPYRIGHT 1973,1977 +/DIGITAL EQUIPMENT CORP. +/MAYNARD, MASS.01754 + + PTAPE=1 + *0 +VERS, 10 + *10 +NDX0, 0 +NDX1, 0 +NDX2, 0 + *20 +BCC1, 0 +BCC2, 0 +BLKLEN, 13 +BUFFLD, 10 +BUFPTR, 0 +BYTCNT, 0 + CLOC=BYTCNT +CHKC, CTRLC +CRLF, TYCRLF +DATBUF, HDATA +DOCRC, CRC +EBLKHI, 0 +EFLG, -1 +EOTFLG, 0 +EQBLK, 0 +ERCODE, 0 + EOLWD=ERCODE +FLEN, 0 +FNPTR, 0 +FRMPTR, 0 + MODF=FRMPTR +GETCD, DECOD +HANADR, 0 +IDOFLG, 0 + MODB=IDOFLG +IMPFLG, 0 +INCHR, 0 +INPTR, 0 +IOERR, PHYSIO +LPWT, LPWAIT +LSPFLG, 0 +MAXCNT, 0 +MAXLEN, -MXPBLK +MIFLG, 0 +M4, -4 +NAME, 0 +OCNT, 0 +OUDEV, 0;0;0 +OUTCHR, 0 +OUTPTR, 0 +PARCHR, 0 + MSKWD=PARCHR +PARPTR, PARADR +PATFLG, 0 +P17, 17 +P200, 200 +RDCHR, 0 + SRWD=RDCHR +RDPBLK, PREAD +RDSWIT, SWITCH +RELBLK, HDATA+5 +RBLK, 0 +SATOL, 0 +SBLK, 0 +SLPTR, 0 +SMTOX, 0 +SYTO9, 0 +TMP0, 0 +TMP1, 0 +TMP2, 0 +TMP3, 0 +TMP4, 0 +TNAME, TYPNAM +TYDEV, TYPDEV +TYPTXT, TTOTXT +USR, DOUSR +USRDEV, 0 +WRCHR, 0 + + PAGE + +START, NOP + CIF 10 /START OF PROG + JMS I (7700 + USRIN + TAD MAXLEN + DCA MAXCNT + TLS + PLS + RFC +DECOD, TAD (-PTAP + TAD MODE + SZA CLA + JMP .+4 + TAD LSPFLG + SZA CLA + JMS I LPWT + JMS I CRLF + TSF + JMP .-1 + CIF 10 + JMS I P200 + DECODE + 0 + TLS /INIT. TTY + JMS I (SETDV + JMS I (CHKMI + CDF 10 + TAD I (MTOX + CDF 0 + CLL RTR + RAR + SNL + JMP NOVERS + JMS I CRLF + JMS I TYPTXT /IF /V,TYPE VERSION NUMBER + VERSON + JMS I CRLF +NOVERS, TAD (FNAME + DCA NAME + TAD (7600 /GET NAME + DCA NDX0 + TAD NAME + DCA TMP2 + TAD DATBUF + DCA TMP3 + TAD VERS + DCA I TMP3 + ISZ TMP3 + TAD M4 + DCA TMP0 + CDF 10 + TAD I (YTO9 + RAL /CHK /Z + SMA CLA + JMP .+3 + DCA EQBLK + DCA EBLKHI + TAD I (ATOL + AND (20 /H ? + SZA CLA + FOURK /YES + DCA TMP1 + CLA CLL CMA RAR /=3777 + AND I (7642 /HI EQUALS N + TAD TMP1 + SZA + DCA EBLKHI + TAD I (7642 + DCA TMP1 + TAD I (7646 + SZA + DCA EQBLK /=N LO ORD + TAD I (ATOL + DCA SATOL + TAD I (YTO9 + DCA SYTO9 + TAD I (MTOX + DCA SMTOX + JMS I (DODFN + TAD TMP1 + SMA CLA + JMP GOTMOD + TAD (MODTBL-1 /GET NEW MODE + DCA TMP1 + TAD SYTO9 + RAL CLL CML + RAL + ISZ TMP1 + SMA /FOUND IT ? + JMP .-3 + CLA + TAD I TMP1 + DCA MODE + JMS I CRLF +GOTMOD, JMP I MODE +MODTBL, PTAP + FED + COMPAR + IFNZRO PTAPE < + DECOD + > + DECOD + DECOD + DECOD + DECOD + DECOD + DECOD +MODE, DECOD + +VERSON, TEXT "V 5A " + 0 + PAGE + +DODFN, 0 + TAD I (7601 + SZA CLA + JMP LOP0 + TAD SYTO9 + SPA CLA + JMP LOP0 + ISZ TMP2 + ISZ TMP3 + ISZ TMP0 + JMP .-3 + CDF + JMP I DODFN +LOP0, CDF 10 + TAD I NDX0 + CDF + DCA I TMP2 + TAD I TMP2 + DCA I TMP3 + ISZ TMP2 + ISZ TMP3 + ISZ TMP0 + JMP LOP0 + JMP I DODFN + +HSPRDR, 0 + JMS IOWAIT + RSF + RRB + DCA INCHR + RFC + TAD INCHR + JMP I HSPRDR + +HSPPCH, 0 + DCA OUTCHR + JMS IOWAIT + PSF + TAD OUTCHR + PLS + CLA + JMP I HSPPCH + +LSPRDR, 0 + JMS IOWAIT + KSF + KRB + DCA INCHR + TAD INCHR + JMP I LSPRDR + +LSPPCH, 0 + DCA OUTCHR + JMS IOWAIT + TSF + TAD OUTCHR + TLS + CLA + JMP I LSPPCH + +IOWAIT, 0 + TAD I IOWAIT + DCA IOTSKP + ISZ IOWAIT + TAD IOTSKP + RTL + RAL + AND (700 + TAD VERS +IOTSKP, 0 + JMP .-1 + CLA + JMP I IOWAIT + +CTRLC, 0 + KSF + JMP I CTRLC + TAD [200 /FORCE BIT 8 ON + KRS + TAD (-203 + SZA CLA + JMP I CTRLC + KCC +CTRLC0, JMS I CRLF + TAD (336 + JMS I (LSPPCH + TAD (303 + JMS I (LSPPCH + JMS I CRLF + TSF + JMP .-1 + JMP I .+1 + 7605 + + PAGE + +/HERE FOR SYS: + + + $ + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/FLOAT.SB b/sw/os8/v3d/sources/system/dectapes/dectape1/FLOAT.SB new file mode 100644 index 0000000..81078aa --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/FLOAT.SB @@ -0,0 +1,746 @@ +/ FLOATING POINT MATH PACKAGE +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + / VERSION 5A +/ APRIL 28, 1977 +/ VERSION NUMBER IS AVAILABLE AT ENTRY POINTS +/ ENTRIES +/ + ENTRY FAD + ENTRY FSB + ENTRY FMP + ENTRY FDV + ENTRY STO + ENTRY FLOT + ENTRY FLOAT + ENTRY FIX + ENTRY IFIX + ENTRY IFAD + ENTRY ISTO + ENTRY ABS + ENTRY CHS + +/THE FOLLOWING DEFINITIONS ENABLE LIBRARY OPTIMIZATIONS +/WHERE CRITICAL TIMING CONSIDERATIONS EXIST. +/THEY SHOULD BE USED WITH EXTREME CAUTION, AND MUST +/REFERENCE CURRENT PAGE AND PAGE ZERO SYMBOLS ONLY. + +OPDEF TADI 1400 +OPDEF DCAI 3400 +OPDEF JMSI 4400 +OPDEF JMPI 5400 +SKPDF JMSKP 4000 +/ +/ +ABSYM HAC 20 +ABSYM MAC 21 +ABSYM LAC 22 +ABSYM SRH 23 +ABSYM SRM 24 +ABSYM SRL 25 +ABSYM ACS 26 +ABSYM ACX 27 +ABSYM SRS 30 +ABSYM SRX 31 +ABSYM MQH 30 +ABSYM MQM 31 +ABSYM MQL 32 + +// ADDITION AND SUBTRACTION ROUTINE +// + + LAP /LEAVE AUTO PAGING + +ADSRAD, ADSRAC /SOME INDIRECTS TO SAVE CORE... +ARSAB, ARS +GTSPLA, GTSPLT +NORMAD, NORMAC +COMAD, COM + +FSB, BLOCK 1 + 5 /FLOATING POINT SUBTRACT + TAD FSB / CALL 1,FSB + DCA FAD / ARG + TAD FSB# + DCA FAD# + CLA CLL CML RAR + JMP ED1 +/ +ER1, FAD +FAD, BLOCK 1 + 5 /FLOATING POINT ADD SUBROUTINE +ED1, DCA FSB / CALL 1,FAD + TAD FAD / ARG + DCA FAD1 +FAD1, NOP /CDF TO PICK UP ARGUMENT + TADI FAD# + INC FAD# + DCA 7 + CLA CMA + TADI FAD# + INC FAD# + DCA 10 +FADENT, TAD ER1 + DCA ER0 + TAD ACH /EXAMINE THE FLOATING AC + SNA CLA + JMP FADLD /IT'S ZERO, DO A LOAD... + JMSI GTSPLA + JMP FADEND + TAD SRS + TAD FSB + DCA SRS + TAD ACX + SNA + JMP SHFAC + CIA + TAD SRX + SMA + JMP SHFAC + DCA FSB +SHFSR, TAD SRH + CLL RAR + DCA SRH + TAD SRM + RAR + DCA SRM + TAD SRL + RAR + DCA SRL + ISZ FSB + JMP SHFSR + JMP JD1 +/ +SHFAC, CMA + DCA FSB + TAD SRX + DCA ACX + JMP ED3A +ED3, JMSI ARSAB +ED3A, ISZ FSB + JMP ED3 +/ +JD1, TAD ACS + SMA CLA + JMP ED4 + CLA CLL CMA RTL / GENERATE -3 + JMSI COMAD +ED4, TAD SRS + SPA CLA + JMSI COMAD + JMSI ADSRAD + TAD HAC + SMA CLA + JMP ED5 + CLA CLL CMA RTL + JMSI COMAD + CLA CLL CML RAR +ED5, DCA ACS + DCA RSW +FADEND, JMSI NORMAD + JMP FADEX + + +FADLD, TAD 7 /FLOATING LOAD WHEN AC=0 + DCA FADSB# + JMS FADSB + SZA /CHECK FOR 0.-0. DON'T GIVE -0. + TAD FSB + AND ABSSW + DCA ACH + JMS FADSB + DCA ACM + JMS FADSB + DCA ACL +FADEX, CLA CMA + DCA ABSSW + DCA FSB /FOR IFAD AFTER SUBTRACT + CLA STL RTL /=0002 + TAD FAD /HIGH SPEED RETURN + DCA FAD3 +FAD3, NOP + JMPI FAD# + +ABSSW, 7777 /ABSOLUTE VALUE SWITCH + +FADSB, 0 /TIME SAVING SUBROUTINE + NOP /CHANGED TO CDF + TADI 10 + JMPI FADSB + +/ FLOATING POINT ABSOLUTE VALUE FUNCTION + +ABS, BLOCK 1 + 5 / CALL 1,ABS + TAD ABS / ARG + DCA FAD + TAD ABS# + DCA FAD# + CLL STA RAR /=3777 + DCA ABSSW + JMP ED1 /GO INTO ADD ROUTINE... + + PAGE + + +/ ROUTINE TO GET OPERAND INTO SR, SEPARATE SIGNS AND +/ EXPONENTS OF AC AND SR, AND MOVE GLOBAL AC TO LOCAL AC. +/ + +GTSPLT, 0 + TAD 7 + DCA GTS1 +GTS1, NOP + TADI 10 /PICK UP HIGH ORDER WORD + JMS SPLIT /MUST NOT CHANGE DATA FIELD**** + DCA SRH + TAD ACX + SZA + INC GTSPLT + DCA SRX + TAD ACS + DCA SRS + TADI 10 /PICK UP WORD 2 + DCA SRM + TADI 10 /PICK UP WORD 3 + DCA SRL + TAD ACH + JMS SPLIT /EXPAND THE FLOATING AC... + DCA HAC + DCA RSW +GTS2, TAD ACM /NEEDS LABEL TO FORCE CDF! + DCA MAC + TAD ACL + DCA LAC + JMPI GTSPLT +/ + +SPLIT, 0 /BREAK UP SIGN, EXPON, AND HI-ORD BITS + DCA TMP /ROUTINE MUST NOT CHANGE DATA FIELD**** + TAD TMP + RAR + RTR + AND (377 + DCA ACX + CLA CLL CML RAR / = 4000 + AND TMP + DCA ACS + TAD TMP + AND (7 + JMPI SPLIT +TMP, 0 +/ +/ + +ALS, 0 /LOCAL AC SHIFT LEFT SUBROUTINE + TAD LAC + CLL RAL + DCA LAC + TAD MAC + RAL + DCA MAC + TAD HAC + RAL + DCA HAC + JMPI ALS +/ +/ ADD SR TO AC +/ + +ADSRAC, 0 /ADD LOCAL SR TO LOCAL AC + CLL + TAD LAC + TAD SRL + DCA LAC + CLA RAL + TAD MAC + TAD SRM + DCA MAC + CLA RAL + TAD HAC + TAD SRH + DCA HAC + JMPI ADSRAC +/ +/ ROUTINE TO NORMALIZE AND RECOMBINE ACCUMULATOR, +/ AND PLACE LOCAL ACC. IN GLOBAL ACC. +/ +ARSAD, ARS /SOME CORE SAVING INDIRECTS +ERRAD, ERR +RSW, 0 /ROUNDING BIT + +NORMAC, 0 /NORMALIZE AND PACKING SUBROUTINE +ED6, TAD HAC + TAD (7770 + SPA CLA + JMP RUND + JMSI ARSAD + ISZ ACX + JMP ED6 +/ +/ ROUNDOFF ROUTINE +/ +RUND, TAD RSW + SNA CLA + JMP LEFTST + ISZ LAC + JMP LEFTST + ISZ MAC + JMP LEFTST + ISZ HAC + DCA RSW + JMP ED6 +/ +LEFTST, TAD ACX + SNA SPA + JMP ZEROUT + DCA ACX + CLA CLL CMA RTL / = -3 + TAD HAC + SMA SZA CLA + JMP COMBIN + JMS ALS + CLA CMA + JMP LEFTST +/ +COMBIN, TAD ACX + CLL RAL + RTL + SPA + JMPI ERRAD + TAD HAC + TAD ACS +ED7, DCA ACH + TAD MAC + DCA ACM + TAD LAC + DCA ACL + JMPI NORMAC + +ZEROUT, CLA + DCA LAC + DCA MAC + JMP ED7 + + PAGE + / +/ INDIRECT STORE +/ + +ISTO, BLOCK 1 + 5 /FLOATING POINT INDIRECT STORE + TAD ISTO / CALL 1,ISTO + DCA IST1 / ARG <2WORD ADDRESS> +IST1, NOP + TADI ISTO# + INC ISTO# + DCA IST2 + TADI ISTO# + DCA 7 + TAD ISTO + DCA STO + TAD ISTO# + DCA STO# +IST2, NOP + TADI 7 + INC 7 + DCA ISTO + CLA CMA + TADI 7 + DCA 10 + TAD ISTO + DCA STOSB# + JMP STOX +/ +/ +/ ROUTINE TO STORE CONTENTS OF FL. PT. ACC AND CLEAR IT +/ +STO, BLOCK 1 + 5 / CALL 1,STO + TAD STO / ARG + DCA STO1 +STO1, NOP /REPLACED BY CDF + TADI STO# + INC STO# + DCA STOSB# + CLA CMA + TADI STO# + DCA 10 +STOX, TAD ACH + JMS STOSB + DCA ACH + TAD ACM + JMS STOSB + DCA ACM + TAD ACL + JMS STOSB + DCA ACL + INC STO# + CLA STL RTL /=0002 + TAD STO /SOME TIME SAVING CODE... + DCA STO3 +STO3, NOP /REPLACED BY CIF CDF + JMPI STO# + +STOSB, 0 /TIME SAVING SUBROUTINE + NOP /CHANGED TO A CDF DESTINATION + DCAI 10 + JMPI STOSB +/ +/ FLOATING POINT TO FIXED POINT CONVERSION +/ +FXER, 4611 + 3040 /"FIX" ERROR +FIX, BLOCK 1 + 5 +FIXX, TAD ACH + JMS SPLIT + DCA HAC + TAD ACM + DCA MAC + TAD ACX + TAD (-214 + SMA + JMP FIXERR + TAD (-3 + DCA SRM +RSH, JMS ARS + ISZ SRM + JMP RSH + TAD ACS + RAL + TAD MAC + SZL + CIA +FIXRTN, DCA ACS + DCA ACH + DCA ACM + DCA ACL + TAD ACS + RETRN FIX +/ +IFIX, BLOCK 1 + 5 + TAD IFIX + DCA ADDR + TAD IFIX# + DCA ADDR# + CALL 1,IFAD +ADDR, ARG 0 + TAD IFIX + DCA FIX + CLA CLL CML RTL / = 2 + TAD IFIX# + DCA FIX# + JMP FIXX + +FIXERR, CALL 1,ERROR + ARG FXER + CLA CLL CMA RAR + JMP FIXRTN /RETURN WITH 2047 IN FIXED AC + + PAGE + +/ +/ FLOATING POINT MULTIPLICATION +/ + +ADSRAE, ADSRAC /SOME TIME SAVING INDIRECTS +ARSAE, ARS +COMAF, COM +GTSPLB, GTSPLT +NORMAG, NORMAC +ER4, FDV +ER01, ER0 +ER3, FMP +FMP, BLOCK 1 + 5 + TAD ER3 + DCAI ER01 + TAD FMP + DCA FMP1 +FMP1, NOP /CDF TO FIELD OF CALLING PROGRAM + TADI FMP# + INC FMP# + DCA 7 + CLA CMA + TADI FMP# + INC FMP# + DCA 10 + JMSI GTSPLB /WARNING ***THIS INSTRUCTION SKIPS*** + JMP MULZRO + TAD ACS + TAD SRS + DCA ACS + TAD ACX + TAD SRX +MULZRO, TAD (-201 + DCA ACX + TAD HAC + DCA MQH + TAD MAC + DCA MQM + TAD LAC + DCA MQL + DCA HAC + TAD (-33 + DCA FMP1 +/ +MULT, JMSI ARSAE + TAD MQH + RAR + DCA MQH + TAD MQM + RAR + DCA MQM + TAD MQL + RAR + DCA MQL + SZL + JMSI ADSRAE + ISZ FMP1 + JMP MULT + JMSI NORMAG + RETRN FMP +/ +/ +/ FLOATING POINT DIVISION +/ +DIVZ, 4411 + 2632 +FDV, BLOCK 1 + 5 + TAD ER4 + DCAI ER01 + TAD FDV + DCA FDV0 +FDV0, NOP /CDF TO FIELD OF CALLING PROGRAM + TADI FDV# + INC FDV# + DCA 7 + CLA CMA + TADI FDV# + INC FDV# + DCA 10 + JMSI GTSPLB + JMP DIVERR + TAD ACS + TAD SRS + DCA ACS + TAD SRX + CIA + TAD ACX + TAD (177 + DCA ACX + DCA MQL + TAD (-35 + DCA FDV0 +DVID, CLA CLL CML RAR / = 4000 + AND SRH + TAD HAC + SPA CLA + JMP FDV1 + JMSI COMAF +FDV1, JMSI ADSRAE + TAD MQL + RAL + DCA MQL + TAD MQM + RAL + DCA MQM + TAD MQH + RAL + DCA MQH + JMS ALS + ISZ FDV0 + JMP DVID +/ + TAD MQH + DCA HAC + TAD MQM + DCA MAC + TAD MQL + DCA LAC + JMSI NORMAG +FDVRET, RETRN FDV + +DIVERR, CALL 1,ERROR + ARG DIVZ + CLA CLL CMA RAR + DCA ACH + JMP FDVRET + + PAGE + / +/ ROUTINE TO GET TWO'S COMPLEMENT OF TRIPLE WORD NUMBER +/ IF NO ADDRESS IN AC UPON ENTRY, SR IS ASSUMED. +/ +COM, 0 + TAD (25 /ADDRESS OF SRL + DCA PTR2 + CLA CLL CMA RTL / = -3 + DCA CTR2 +ED8, TAD I PTR2 + CMA + SZL + CLL IAC + DCA I PTR2 + CLA CMA CML + TAD PTR2 + DCA PTR2 + ISZ CTR2 + JMP ED8 + JMP I COM +PTR2, 0 +CTR2, 0 +/ +/ CONVERT FIXED POINT TO FLOATING POINT +/ + CPAGE 14 + +FLOAT, BLOCK 1 + 5 /FLOAT FUNCTION + TAD FLOAT / CALL 1,FLOAT + DCA FLO1 / ARG +FLO1, NOP + TADI FLOAT# + INC FLOAT# + DCA FLO2 + TADI FLOAT# + INC FLOAT# + DCA 7 + TAD FLOAT + DCA FLOT + TAD FLOAT# + DCA FLOT# +FLO2, NOP /CDF TO FIELD OF ARGUMENT + TADI 7 + JMP FLOTX +/ +/ INTEGER TO FLOATING POINT CONVERSION +/ +FLOT, BLOCK 1 + 5 / CALL 0,FLOT +FLOTX, CLL /ASSUMES INTEGER VARIABLE IN AC + SPA + CIA CML + DCA MAC + DCA HAC + DCA LAC + RAR + DCA ACS + TAD (217 + DCA ACX + DCA RSW + JMS NORMAC + RETRN FLOT + +/ INDIRECT FLOATING POINT ADD + + CPAGE 36 +IFAD, BLOCK 1 + 5 / CALL 1,IFAD + TAD IFAD / ARG <2WORD ADDRESS> + DCA IFA1 +IFA1, NOP + TADI IFAD# + INC IFAD# + DCA IFA2 + CLA CMA + TADI IFAD# + INC IFAD# + DCA 10 +IFA2, NOP + TADI 10 + DCA 7 + CLA CMA + TADI 10 + DCA 10 + TAD IFAD + DCA FAD + TAD IFAD# + DCA FAD# + JMP FADENT + + +ARS, 0 /LOCAL AC SHIFT RIGHT SUBROUTINE + TAD HAC + CLL RAR + DCA HAC + TAD MAC + RAR + DCA MAC + TAD LAC + RAR + DCA LAC + CLA RAL + DCA RSW + JMPI ARS + +FPER, 5726 + 0614 /"OVFL" ERROR +CHS, BLOCK 1 + 5 /FLOATING POINT NEGATION + TAD ACH / CALL 0,CHS + SZA + TAD (4000 +CHSRET, DCA ACH + RETRN CHS +/ +/ ERROR ROUTINES +/ +ER0, 0 /CONTAINS ADDRESS OF CURRENT ENTRY PT +ERR, CLA + TAD I ER0 /BANK CALL IS FROM + DCA CHS + ISZ ER0 /INDEX TO ADDRESS + TAD I ER0 /ADDRESS + DCA CHS# + CALL 1,ERROR + ARG FPER + CLA CLL CMA RAR + JMP CHSRET + + END + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/LIBSET.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/LIBSET.PA new file mode 100644 index 0000000..866e8ad --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/LIBSET.PA @@ -0,0 +1,688 @@ +/LIBSET - LIBRARY BUILDER PROGRAM +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + FIELD 1 + HILOC=20 + INFPTR=21 + IFPTR=22 + TEMP=23 + NAMPTR=24 +/VERSION=3 +/PATCH="A + + *2600 +START, SKP + JMP .+4 +CALLCD, JMS I (200 + 5 +RL, 2214 + 0 /DON'T RESET OUTPUT FILES + ISZ FIRST + JMP NOTFST + TAD I (7604 + SNA + TAD RL + DCA I (7604 + TAD I (7600 + SZA CLA /IS THERE AN OUTPUT FILE? + JMP OUTYES /YES + CLA IAC + DCA I (7600 /NO - MAKE SYS:LIB8.RL THE OUTPUT FILE + TAD (1411 + DCA I (7601 + TAD (0270 + DCA I (7602 + TAD I (7617 + SNA CLA /HOW ABOUT INPUT FILES? + TAD I (MPARAM+1 + AND (40 /IF NO INPUT FILES, + SNA CLA /AND /S OPTION IS ON, + JMP OUTYES + DCA PTRCOD /USE PTR: FOR INPUT + JMS I (200 + 12 + 4224 +PTRCOD, 0 + 0 + JMP I PERROR /NO PTR - BAD + TAD PTRCOD + DCA I (7617 +OUTYES, JMS I (XOPEN + JMS I (OCHAR + JMS I (DMPREC /PUT OUT NOTHIN IN FIRST RECORD + TAD (7000 + DCA NAMPTR + TAD (7376 + DCA INFPTR +NOTFST, TAD (7617 + DCA IFPTR +FILELP, TAD I IFPTR + SNA CLA + JMP NEXTCD + TAD IFPTR + JMS I (IOPEN +READLP, CLA CMA + TAD I (OUCCNT + DCA FLEN + DCA HILOC + JMS I (IREAD /READ AND COPY A RELOCATABLE PROGRAM + SZA CLA /TEST CHECKSUM + JMP I PERROR + TAD HILOC + AND (7600 + TAD FLEN + DCA I INFPTR + JMS I (DMPREC + ISZ INFPTR + DCA I INFPTR + CLA CLL CMA RTL + TAD INFPTR + DCA INFPTR + TAD I (MPARAM+1 + AND (40 + SZA CLA + JMP READLP /IF /S SWITCH ON , CONTINUE READING TAPES UNTIL A ^Z +NXFIL, ISZ IFPTR + ISZ IFPTR + JMP FILELP +NEXTCD, TAD I (MPARAM-1 + SMA CLA + JMP CALLCD + DCA I NAMPTR + ISZ NAMPTR + ISZ NAMPTR + ISZ NAMPTR + DCA I NAMPTR + TAD NAMPTR + CMA IAC + TAD INFPTR + SMA CLA + JMP I (FINISH + JMP I .+1 + TOOBIG + +FIRST, -1 +FLEN, 0 + +JTABL, DATAWD + DATAWD + ERROR + SYMDEF + ORIGIN + DATAWD + DATAWD +PERROR, ERROR + ENDTAP + ERROR + COMMON + ERROR + ERROR + ERROR + ERROR + TRANVC + +VERSON, 6301 /VERSION AND PATCH LEVEL + *3000 +IREAD, 0 + TAD (200 + DCA LOC +ILEADR, JMS I (ICHAR + DCA CKSM + TAD CKSM + AND (177 + SNA CLA + JMP ILEADR + TAD CKSM + TAD (-232 + SNA CLA + JMP I (NXFIL + TAD (200 + JMS I (OCHAR + TAD CKSM + JMS I (OCHAR + TAD CKSM + SKP +NXTFRM, JMS RCHAR + CLL RTR + RTR + RAR + DCA CHAR1 + TAD CHAR1 + RAL + AND (17 + TAD JMPTAB + DCA BTMP + TAD I BTMP + DCA BTMP + JMP I BTMP +JMPTAB, JTABL + +RCHAR, 0 + JMS I (ICHAR + DCA CHAR + TAD CKSM + TAD CHAR + DCA CKSM + TAD CHAR + JMS I (OCHAR + TAD CHAR + JMP I RCHAR + +DATAWD, JMS RCHAR + CLA CLL + TAD LOC + CMA + TAD HILOC + SZL CLA + JMP .+3 + TAD LOC + DCA HILOC + ISZ LOC + JMP NXTFRM + +SYMDEF, JMS RCHAR + CLA CLL CMA RTL + DCA CHAR1 +GTNMLP, JMS RCHAR + AND (77 + CLL RTL + RTL + RTL + DCA BTMP + JMS RCHAR + AND (77 + TAD BTMP + DCA I NAMPTR + ISZ NAMPTR + ISZ CHAR1 + JMP GTNMLP + TAD INFPTR + AND (377 + DCA I NAMPTR + ISZ NAMPTR + TAD NAMPTR + CIA + TAD INFPTR + SPA SNA CLA + JMP I (TOOBIG + JMP NXTFRM + +ORIGIN, JMS RCHAR + CLA + TAD CHAR1 + AND (7400 + TAD CHAR + DCA LOC + JMP NXTFRM + +COMMON, JMS RCHAR + CLA + JMP NXTFRM + +TRANVC, JMS RCHAR + CLL RAL + TAD CHAR + CLL RAL + CIA + DCA BTMP + JMS RCHAR + CLA + ISZ BTMP + JMP .-3 + JMP NXTFRM + +ENDTAP, TAD CKSM + CIA + TAD CHAR + DCA BTMP + JMS RCHAR + CLA + TAD CHAR1 + AND (7400 + TAD CHAR + TAD BTMP + JMP I IREAD + +LOC, 0 +CHAR1, 0 +CHAR, 0 +BTMP, 0 +CKSM, 0 + + *3200 +XOPEN, 0 + TAD (7577 + DCA 10 + TAD (FILENM-1 + DCA 11 + TAD (-5 + DCA 12 + TAD I 10 + DCA I 11 + ISZ 12 + JMP .-3 + JMS I (OOPEN + TAD I (OUBLK + DCA CTLWRI + TAD I (OUHNDL + DCA ODVH + JMP I XOPEN + +DMPREC, 0 + JMS I (OCHAR + JMS I (OCHAR + TAD I (OUDWCT + TAD (200 + SZA CLA + JMP .-4 + JMP I DMPREC + +FINISH, JMS I (OCLOSE + CIF 0 + JMS I ODVH + 4210 + 7000 +CTLWRI, 0 + JMP OUTERR + CDF CIF 0 + JMP I (7605 +FILENM, ZBLOCK 5 +ODVH, 0 + +TOOBIG, ISZ ERRNO +ERROR, ISZ ERRNO +OUTERR, ISZ ERRNO +INERR, ISZ ERRNO +ERR, TAD ERRNO + TAD (ERR0 + DCA EPCH + DCA ERRNO + TAD I EPCH + DCA ODVH +ERRLP, TAD I ODVH + RTR + RTR + RTR + JMS EPCH + TAD I ODVH + JMS EPCH + ISZ ODVH + JMP ERRLP +ERXIT, CDF CIF 0 + JMP I .+1 + 7605 + +EPCH, 0 + AND (77 + SNA + JMP ERXIT + TAD (-40 + SPA + TAD (100 + TAD (240 + 6046 + 6041 + JMP .-1 + CLA + JMP I EPCH + +ERRNO, 0 + *3400 + /ERROR MESSAGES +ERR0, HELP + INPER + OUPER + RELER + BIGER + +HELP, TEXT /HELP!/ /THIS ERROR CANNOT OCCUR +INPER, TEXT /INPUT ERROR/ +OUPER, TEXT /ERROR WHILE WRITING OUTPUT FILE/ +RELER, TEXT /BAD FORMAT OR CHECKSUM - TRY AGAIN./ +BIGER, TEXT /LIBRARY DIRECTORY OVERFLOW - TOUGH/ + INBUF=0 + INCTL=2400 + OUBUF=6000 + OUCTL=4200 + INDEVH=6400 + OUDEVH=7000 + INRECS=12 + MPARAM=7643 + DCB=7760 + INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER + OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER + *2000 +IN7400, 7400 +IOPEN, 0 + DCA INXPTR + CLA CMA + DCA INCHCT /SET INCHCT TO FORCE A READ + ISZ INEOF /SET END-OF-FILE FLAG TO FORCE A NEW FILE + RDF + TAD INCDIF + DCA .+1 +INPTR, HLT /RESTORE CALLING FIELDS + JMP I IOPEN + +ICHAR, 0 +IN7600, 7600 + RDF + TAD INCDIF + DCA INRTRN /SAVE CALLING FIELDS +INCHAR, CDF INFLD + ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH + ISZ INCHCT +INJMPP, JMP INJMP + TAD INEOF + SNA CLA /DID LAST READ YIELD END-OF-FILE? + JMP INGBUF /NO - DO ANOTHER +GETNEW, JMS INNEWF /OPEN A NEW INPUT FILE + JMP I (ERROR +INGBUF, TAD INCTR + CLL + TAD (INRECS + SNL + DCA INCTR /RESTORE INCTR IF IT HASN'T OVERFLOWED + SZL /IS THIS THE LAST READ? + ISZ INEOF /YES - SET END-OF-FILE FLAG + CLL CML CMA RTR /CONSTRUCT A CONTROL WORD FOR THE READ + RTR /FROM THE AMOUNT OF THE OVERFLOW + RTR /(IF ANY) AND THE STANDARD CONTROL WORD + TAD (INCTL+1 + DCA INCTLW +INCDIF, CDF CIF 0 + CDF 10 + JMS I INHNDL /CALL THE DEVICE HANDLER +INCTLW, 0 +INBUFP, INBUF +INREC, 0 + JMP INERRX /SOME KIND OF HANDLER ERROR +INBREC, TAD INREC + TAD (INRECS + DCA INREC /UPDATE THE RECORD NUMBER + TAD INCTLW + AND IN7600 + CLL RAL + TAD INCTLW + AND IN7600 + CMA + DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT + TAD INJMPP + DCA INJMP /RESET THE CHARACTER SWITCH + TAD INBUFP + DCA INPTR /AND THE WORD POINTER + JMP INCHAR /GO BACK AND MAKE BELIEVE THIS NEVER HAPPENED +INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE + SMA CLA /WHICH TYPE WAS IT? + JMP INBREC /END OF FILE - RESUME THY PROCESSING + JMP I (INERR +INJMP, HLT /THIS IS THE THREE - WAY CHARACTER SWITCH + JMP ICHAR1 + JMP ICHAR2 +ICHAR3, TAD INJMPP + DCA INJMP + TAD I INPTR +IN200, AND IN7400 + CLL RTR + RTR /COMBINE THE HIGH-ORDER FOUR BITS OF + TAD INCTLW + RTR /THE TWO WORD TO FORM THE THIRD CHARACTER + RTR + ISZ INPTR + JMP INCOMN +ICHAR2, TAD I INPTR + AND IN7400 + DCA INCTLW /SAVE THE HIGH-ORDER BITS FOR THE THIRD CHAR + ISZ INPTR /BUMP THE WORD POINTER +ICHAR1, TAD I INPTR +INCOMN, AND (377 +INRTRN, 0 /RESTORE CALLING FIELDS + JMP I ICHAR /AND RETURN +INXPTR, 0 +INEOF, 1 /THESE PARAMETERS ARE SET UP SO THAT + /IOPEN IS UNNECESSARY. +INNEWF, -1 + INCHCT=INNEWF + CDF 10 + TAD (INDEVH+1 + DCA INHNDL /INITIALIZE HANDLER ADDRESS + TAD I INXPTR + SNA /ANY MORE? + JMP I INNEWF /NO - OUT OF INPUT + JMS I IN200 + 1 /ASSIGN, FETCH HANDLER +INHNDL, 0 + HLT /HUH? + TAD I INXPTR + AND (7760 /GET LENGTH PART OF WORD + SZA /LENGTH OF 0 MEANS LENGTH >=256 + TAD (17 /ADD HIGH-ORDER BITS + CLL CML RTR + RTR + DCA INCTR /STORE LENGTH OF FILE + ISZ INXPTR + TAD I INXPTR + DCA INREC /STORE STARTING RECORD NUMBER OF FILE + ISZ INXPTR + DCA INEOF /ZERO END-OF-FILE FLAG + ISZ INNEWF + JMP I INNEWF + INCTR=IOPEN + PTP=20 + *2200 +OOPEN, 0 +OU7600, 7600 + RDF + TAD OUCDIF + DCA OORETN + JMS OUASGN +OUENTR, TAD I OU7600 + JMS I (200 + 3 /ENTER OUTPUT FILE +OUBLK, FILENM+1 +OUELEN, 0 /REPLACED WITH LENGTH OF HOLE + JMP OEFAIL /FAILED - MAYBE WE ASKED TOO MUCH + DCA OUCCNT + JMS I (OUSETP +OORETN, HLT /RESTORE CALLING FIELDS + JMP I OOPEN +OEFAIL, TAD I OU7600 + AND (7760 /GET REQUESTED LENGTH + SNA CLA /WAS IT AN INDEFINITE REQUEST + JMP I (OUTERR + TAD I OU7600 + AND (17 /MAKE THE REQUESTED LENGTH ZERO + DCA I OU7600 + JMP OUENTR /TRY, TRY AGAIN +OUASGN, 0 + TAD (OUDEVH+1 + DCA OUHNDL + CDF 10 + TAD I (FILENM + AND (17 /STRIP OFF ANY LENGTH INFO + SNA /IS THERE AN OUTPUT DEVICE? + JMP I (OUTERR + JMS I (200 + 1 /ASSIGN, FETCH HANDLER +OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY + HLT /HUH? + JMP I OUASGN +OUTDMP, 0 + DCA OUCTLW /STORE THE CONTROL WORD + TAD OUCCNT + SNA + ISZ OUCTLW + TAD OUBLK + DCA OUREC /COMPUTE THE STARTING BLOCK NUMBER OF THIS TRANSFER + TAD OUCTLW + CLL RTL + RTL + RTL + AND (17 /COMPUTE THE NUMBER OF RECORDS + TAD OUCCNT /UPDATE THE NUMBER OF BLOCKS IN THE FILE + DCA OUCCNT + TAD OUCCNT + CLL CML + TAD OUELEN + SNL SZA CLA /DOES THE LENGTH EXCEED THE GIVEN LENGTH? + JMP I (OUTERR +OUCDIF, CDF CIF 0 + CDF 10 + JMS I OUHNDL +OUCTLW, 0 + OUBUF +OUREC, 0 + JMP I (OUTERR + JMP I OUTDMP +OCLOSE, 0 + RDF + TAD OUCDIF + DCA OCRET + JMS I (OCHAR + JMS I (OCHAR +FILLLP, JMS I (OCHAR + JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE + SPA CLA + TAD (100 /IF ITS A DIRECTORY DEVICE FORCE A RECORD + TAD (77 /BOUNDARY - OTHERWISE A HALF-RECORD + AND I (OUDWCT + SZA CLA /UP TO THE BOUNDARY YET? + JMP FILLLP /NO - FILL WITH ZEROS + TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT + TAD (OUCTL&3700 + SNA /A FULL WRITE LEFT? + JMP NODUMP /YES - DON'T DO IT - THE ^Z IS ALREADY OUT + TAD (4000+OUFLD /PUT IN THE FIELD BITS AND THE WRITE BIT + JMS OUTDMP +NODUMP, JMS OUASGN /REASSIGN OUTPUT HANDLER + TAD I (FILENM + JMS I (200 + 4 /CLOSE THE OUTPUT FILE +OU7601, FILENM+1 +OUCCNT, 0 + JMP I (OUTERR +OCRET, HLT /RESTORE CALLING FIELDS + JMP I OCLOSE + *2400 +OUSETP, 0 /ROUTINE TO INITIALIZE CHARACTER POINTERS + TAD (OUCTL&3700 /GET SIZE OF BUFFER IN DOUBLEWORDS + CIA /NEGATE IT + DCA OUDWCT + TAD (OUBUF + DCA OUPTR /INITIALIZE WORD POINTER + TAD OUJMPE + DCA OUJMP /INITIALIZE THREE-WAY CHARACTER SWITCH + JMP I OUSETP + +OCHAR, 0 + AND (377 + DCA OUTEMP + RDF + TAD (CDF CIF 0 + DCA OUCRET +OUCHAR, CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD + ISZ OUJMP /BUMP THE CHARACTER SWITCH +OUJMP, HLT /THREE WAY CHARACTER SWITCH + JMP OCHAR1 + JMP OCHAR2 +OCHAR3, TAD OUTEMP + CLL RTL + RTL + AND (7400 + TAD I OUPOLD + DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH + /ORDER 4 BITS OF THIRD CHAR + TAD OUTEMP + CLL RTR + RTR + RAR + AND (7400 + TAD I OUPTR + DCA I OUPTR /UPDATE SECOND WORD FROM LOW ORDER 4 BITS + TAD OUJMPE + DCA OUJMP /RESET SWITCH + ISZ OUPTR + ISZ OUDWCT /BUMP DOUBLEWORD COUNTER EVERY 3 CHARS + JMP OUCOMN + TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE + JMS I (OUTDMP /DUMP THE BUFFER + JMS OUSETP /RE-INITIALIZE THE POINTERS + JMP OUCOMN +OCHAR2, TAD OUPTR + DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO + ISZ OUPTR /BUMP WORD POINTER TO SECOND WORD +OCHAR1, TAD OUTEMP + DCA I OUPTR +OUCOMN, +OUCRET, HLT /RESTORE CALLING FIELDS + JMP I OCHAR +OUTEMP, 0 +OUPOLD, 0 +OUPTR, 0 +OUJMPE, JMP OUJMP +OUDWCT, 0 +OUTINH, 0 + +OTYPE, 0 + RDF + TAD (CDF CIF 0 + DCA OTRTN + CDF 10 + TAD I (7600 + AND (17 + TAD (DCB-1 + DCA OUTEMP + TAD I OUTEMP +OTRTN, HLT + JMP I OTYPE +CTCTST, 0 + KRS + TAD (-203 + SNA CLA /IS THE TELETYPE BUFFER A ^C + KSF /WITH THE TELETYPE FLAG ON? + JMP I CTCTST /NO + CDF CIF 0 /YES - GO TO MONITOR + JMP I (7605 /THROUGH THE "DON'T SAVE CORE" RETURN + $ + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/LOADER.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/LOADER.PA new file mode 100644 index 0000000..56c7901 --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/LOADER.PA @@ -0,0 +1,2171 @@ +/OS8 FORTRAN II RELOCATING LOADER V4 +/ +/ +/ +/ +/ +/ +/ +// +/ +/ +/ +/ +/COPYRIGHT (C) 1973, 1975 +/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. +/ +/ +/ +/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A +/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- +/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER +/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE +/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO +/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE +/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. +/ +/ +/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT +/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL +/EQUIPMRNT COROPATION. +/ +/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS +/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. +/ +/ +/ +/ +/ +/ + /LOADER.07 DECEMBER 5, 1973 +/ +/ +/CHANGES MADE FOR V4 J.K. 1975 +/ +/ .VERSION NUMBER PRINTED ON MAP +/ .BIT ZERO OF 17645 IS USED INSTEAD OF THE WHOLE +/ WORD TO INDICATE THAT THE LOADER WAS CHAINED +/ TO FROM SABR +/ .CORE ROUTINE STANDARIZED +/ .CHECK FOR BATCH CORRECTED +/ +/ +/FIELD 0, PAGE 0 + + VERSION=6400 /PRINTS ON MAP + PATCH=01 + JSTFLD= 7744 + JSTADR= 7745 + JSBITS= 7746 + MOFILE= 7600 + MIFILE= 7617 + MPARAM= 7643 + DCB= 7760 + MSTCDF= 7772 + MSTADR= 7775 + SHNDLR= 7607 + MGET= 7667 + MTEMP= 27 + OLDT9= 7 /LOCATION OF HANDLER ENTRY OF DEVICE + /WITH DIRECTORY IN CORE + + *0 +ZERO, JMS I XSHNDLR +ONE, 2010 + 3600 + MTEMP+11 + HLT +FIVE, JMP I .+1 + 7600 +XSHNDLR,SHNDLR +X1, 0 +X2, 0 +X3, 0 +X4, 0 + + *16 + NOPUNC + *100 + ENPUNC + +DFRSTR, CIF 10 + JMS I DF200 + 11 /KICK OUT MONITOR +DFSAVE, 0 /RESTORE CALLING FIELD + JMP I CDZSKP /AND EXIT + +SAVEDF, 0 /COMMON SAVE-FIELD PROCESSOR FOR FORTRAN I/O + DCA CDZSKP /CALLING ADDRESS + RDF + TAD .+2 + DCA DFSAVE /CALLING FIELD + CDF CIF 0 + JMP I SAVEDF +DF200, 200 + /RUN-TIME SYSTEM PAGE 0 - PROPAGATED TROUGH ALL FIELDS + +*33 + BNK=00 +/ +/ COMMON SUBROUTINE CALL LINKAGE ROUTINE +/ +LINK, 0 +K6201, CDF BNK /SET DATA FIELD TO THIS BANK +K6202, CIF 00 /SET INSTRUCTION FIELD TO ZERO + JMP I MLINKP /EXIT TO MASTER LINKAGE ROUTINE +MLINKP, MLINK +/ +/ COMMON SUBROUTINE RETURN LINKAGE ROUTINE +/ +RTN, 0 + CDF BNK /SET DATA FIELD TO THIS BANK + CIF 00 /SET INSTRUCTION FIELD TO ZERO + JMP I MRTNP /EXIT TO MASTER RETURN ROUTINE +MRTNP, MRTN +/ +/ CHANGE DATA FIELD TO CURRENT AND SKIP +/ +CDFSKP, 0 + ISZ CDFSKP /INDEX ADDRESS FOR SKIPPING + CDF BNK /CHANGE DATA FIELD TO CURRENT BANK + JMP I CDFSKP /EXIT +/ +/ CHANGE DATA FIELD TO ZERO AND SKIP +/ +CDZSKP, 0 + ISZ CDZSKP /INDEX RETURN ADDRESS FOR SKIPPING + CDF 10 /CHANGE DATA FIELD TO ZERO + JMP I CDZSKP /EXIT +/ +/ OFF BANK INDIRECT SUBROUTINE +/ +OBISUB, 0 + CDF BNK /SET DATA FIELD TO THIS BANK + CIF 00 /SET INSTRUCTION FIELD TO ZERO + JMP I MOBIP /EXIT TO MASTER OFF BANK INDIRECT SUBROUTINE +MOBIP, MOBI +/ +/ OFF PAGE INDIRECT SUBROUTINE +/ +OPISUB, 0 + CDF BNK /SET DATA FIELD TO THIS BANK + CIF 00 /SET INSTRUCTION FIELD TO BANK 0 + JMP I MOPIP /EXIT TO MASTER OFF PAGE INDIRECT SUBROUTINE +MOPIP, MOPI + / +/ ROUTINE TO HANDLE DUMMY ARGUMENTS +/ +DUMSUB, 0 + CDF BNK /SET DATA FIELD TO THIS BANK + CIF 00 /SET INSTRUCTION FIELD TO BANK 0 + JMP I MDUMP /EXIT TO MASTER DUMMY ARGUMENT ROUTINE +MDUMP, MDUM + +/ PAGE 0 CELLS FOR FORTRAN EXECUTION TIME I/O +/ CELLS SET UP BY LINKING LOADER - CANNOT GO PAST 77 + +INHNDL, 0 /PAGE FOR INPUT HANDLER IF /I SWITCH WAS ON +OUHNDL, 0 /PAGE FOR OUTPUT HANDLER IF /O SWITCH WAS ON +ELENGT, 0 /"DESIRED LENGTH" FOR FORTRAN OUTPUT FILES - USUALLY 0 + + *DF200+1 +/OTHER PAGE 0 LOCATIONS + +FOPOLD, 0 +FINPTR, 0 +FICHCT, 0 /MUST BE INIT. TO -1 AT LOOKUP +FINTMP, 0 /MUST BE INIT. TO 10 AT LOOKUP +OHNDLR, 0 /SET BY FENTER - CLEARED BY FCLOSE +IHNDLR, 0 /SET BY FLUKUP - NEVER CLEARED +FOUPTR, 0 +FOCHCT, 0 + *200 +LSTART, JMP I (LDRZZ1 +SSTART, CDF 10 + TAD I (MPARAM+2 + SMA CLA + JMP NOTSBR + TAD I (MPARAM+2 + AND (3777 + DCA I (MPARAM+2 + TAD I (MOFILE + SNA CLA + JMP LDRYYY + TAD (MOFILE+11 + DCA X1 + TAD (MOFILE + DCA SEVEN + TAD (-5 + DCA SIX + TAD (TEMP-1 + DCA X2 +MOVLP1, TAD I SEVEN + CDF 0 + DCA I X2 + CDF 10 + TAD I X1 + DCA I SEVEN + ISZ SEVEN + ISZ SIX + JMP MOVLP1 + TAD TEMP+1 /GET BLOCK NUMBER WHICH SABR PLACED HERE + DCA I (MIFILE+1 + DCA I (MIFILE+2 + CLA CLL CMA RAL + AND I (MPARAM + DCA I (MPARAM /REMOVE /L SWITCH FROM SABR INPUT + CDF 0 + CIF 10 + CLA IAC + JMS I (200 + 4 /DELETE + FORTRL /THE FILE "FORTRL.TM" IF IT EXISTS + 0 + NOP /IT DIDN'T EXIST - BIG DEAL + TAD TEMP +LDRYYY, CDF 10 + DCA I (MIFILE +NOTSBR, CIF 10 + CDF 0 + JMS I (200 + 12 /GET DEVICE NUMBER WITHOUT HANDLER + 2424 /TT +TTYNUM, 3100 /Y + 1000 /RANDOM NUMBER + JMP LWOWIE /WHAT - NO TELETYPE??? + CIF 10 + CLA IAC /DEVICE "SYS" + JMS I (200 + 2 +PTSLIB, SYSLIB + 0 /USELESS LENGTH WORD + CLA SKP + TAD PTSLIB + CDF 10 + DCA I (PSYSLB + TAD TTYNUM + DCA I (TTYNO /STORE AWAY TTY DEVICE NUMBER + JMS I (BATCK +CORO, TAD CORSIZ /GET FLD OF TEST + RTL + RAL + AND COR70 + TAD COREX /MASK USEFUL BITS + DCA .+1 +COR1, CDF + TAD I CORLOC /SAVE CURRENT CONTENTS +COR2, NOP + DCA COR1 + TAD COR2 + DCA I CORLOC +COR70, 70 + TAD I CORLOC /TRY TO READ BACK +CORX, 7400 + TAD CORX + TAD CORV /TAD (1400) + SZA CLA + JMP COREX /NON-EXISTENT FLD EXIT + TAD COR1 + DCA I CORLOC /RESTORE LOC + ISZ CORSIZ + JMP CORO +COREX, CDF 0 + TAD CORSIZ + CIA +FOUNDX, CDF CIF 10 + DCA I (WROVLY /POSTPONE SPREADING FIELD ZERO RESIDENT + TAD (TTYOUT / THRU FIELDS UNTIL /I,/O AND /H ARE TESTED + DCA I (TYPE + JMP I .+1 + LDRXXX + SIX, 0 +SEVEN, 0 + +LWOWIE, CDF CIF 10 + JMP I (SIOERR +CORLOC, CORX +CORV, 1400 +CORSIZ, 1 +TEMP, 0;0;0;0 + PAGE + /FULL LINKAGE ROUTINES FOR RUN-TIME SYSTEM + + *400 +K77A, 0077 /MUST BE FIRST LOC ON PAGE +/ +/ MASTER OFF PAGE INDIRECT ROUTINE +/ +MOPI, DCA AC /SAVE AC + TAD I OPIP /PICK UP ADDRESS OF PARAMETER + DCA DUMSUB + TAD I DUMSUB /ACTUAL PARAMETER + DCA 7 /TO A TEMP + TAD I 7 /PICK UP FINAL DATA + DCA I K7 /TO LOCATION 7 IN FROM BANK + RDF /FROM BANK +ATVX, TAD K6202 /MAKE A CIF FROM INSTRUCTION + DCA ATV /SAVE IN THIS SEQUENCE + JMP ATV-1 +/ +/ MASTER OFF BANK INDIRECT ROUTINE +/ +MOBI, DCA AC /SAVE AC + TAD I OBIP /ADDRESS OF PARAMETER + DCA DUMSUB + TAD I DUMSUB /ACTUAL COMMON ADDRESS + DCA 7 /SAVE IT + RDF /FROM BANK + TAD K6201 /MAKE A CDF FROM INSTRUCTION + DCA .+3 /PLACE IN THIS SEQUANCE + CDF 10 /CHANGE DATA FIELD TO COMMON + TAD I 7 /ACTUAL DATA + NOP /BECOMES CDF AND CIF FROM INSTRUCTION + DCA I K7 /TO LOCATION 7 IN FROM BANK + RDF + CDF 10 + JMP ATVX + / MASTER INDIRECT DUMMY ARGUMENT SUBROUTINE + +MDUM, DCA AC /SAVE AC + TAD I DUMP /PICK UP ADDRESS OF PAR + DCA DUMSUB + TAD I DUMSUB /PICK UP POINTER TO 2 WORD VECTOR + DCA DUMTEM /TO A TEMPORARY + TAD I DUMTEM /FIELD DATA IS IN AS A CDF + DCA ABCRT /TO THIS SEQUANCE + RDF /FROM FIELD + TAD K6202 /MAKE A CIF INSTRUCTION + DCA ATV /TO THIS SEQUANCE FOR EXIT + ISZ DUMTEM /POINT TO LOCATION IN FIELD + TAD I DUMTEM /ACTUAL LOCATION IN UNKNOWN FIELD + DCA I K7 /TO FROM FIELD LOCATION 7 +ABCRT, NOP /BECOMES CDF UNKNOWN + ISZ DUMSUB /BUMP RETURN ADDRESS +ATV, NOP /BECOMES CIF FROM + TAD AC /RESTORE AC + JMP I DUMSUB /EXIT +AC= CDZSKP +DUMTEM= OBISUB +OPIP, OPISUB +OBIP, OBISUB +DUMP, DUMSUB +/ +/ MASTER LINKAGE ROUTINE +/ +MLINK, DCA AC /SAVE AC + RDF + TAD K6201 /MAKE A CDF + DCA DUMTEM + TAD I LINKP /ADDRESS OF CODE WORD + JMS RTS1 + TAD DUMTEM /CDF FROM INSTRUCTION + DCA I DUMSUB /TO FIRST WORD OF 2 WORD VECTOR + ISZ DUMSUB /POINT TO DISPLACEMENT + TAD LINK /ADDRESS OF CODE WORD + IAC /INCR. TO FIRST ARG + DCA I DUMSUB /TO SECOND WORD OF 2 WORD VECTOR + JMP ATVX-1 +/ +/ MASTER RETURN ROUTINE +/ +MRTN, DCA AC /SAVE AC + TAD I RTNP /ADDRESS OF CODE WORD + JMS RTS1 + TAD I DUMSUB /FIELD TO RETURN TO AS A CDF INSTRUCTION + TAD K2 + DCA ATV + ISZ DUMSUB + TAD I DUMSUB + DCA DUMSUB + JMP ATV + /DATA + +K100A, 100 +K7700A, 7700 +LINKP, LINK +RTNP, RTN +/ +/SUBROUTINE 1 +/ +RTS1, 0 + DCA LINK + TAD I LINK /CODE WORD +K200A, AND K77A /MASK OUT NUMBER OF ARGUMENTS + TAD K200A /+DISPLACEMENT + DCA ABCRT /GIVES ADDRESS OF BCRT ENTRY + TAD ABCRT + TAD K100A /+DISPLACEMENT + DCA ATV /GIVES ADDRESS OF TV DISPLACEMENT + CDF CIF 0 /(TABLES IN FIELD 0!) + TAD I ABCRT /TO CDF INSTRUCTION + DCA RTSCDF /TO FIRST WORD OF 2 WORD VECTOR + TAD I ATV /TO BANK DISPLACEMENT + SNA /WAS IT LOADED? + JMP NOTIN /NO + + DCA DUMSUB /TO SECOND WORD OF 2 WORD VECTOR +RTSCDF, 0 + JMP I RTS1 + +NOTIN, CIF 10 + JMS I K7700A +K7, 7 + 1 /USER ERROR 1 - PROGRAM NOT LOADED + FASIGN, 0 /CALLED FROM SABR - DOES ASSIGN AND + DCA CDFSKP /EITHER LOOKUP,ENTER OR CLOSE + TAD FASIGN + JMS SAVEDF + CIF 10 + JMS I K7700A + 10 /CALL USR IN + CIF 10 + JMS I K200A + 1 /ASSIGN HANDLER +ASDEV, 0;0 /SET UP BY SABR +ASPAGE, 0 /DITTO + JMP ASERR /ASSIGN FAILURE +ZRONAM, DCA FLUNAM /ZERO FILENAME FOR LOOKUP + TAD ASDEV+1 /PUT DEVICE NUMBER IN AC + JMP I CDFSKP /JUMP TO APPROPRIATE ROUTINE + + *567 /MUST CROSS PAGE BOUNDARY JUST SO +FLUKUP, CIF 10 + JMS I K200A +K2, 2 /LOOKUP FILE +FLUNAM, 0 /REPLACED BY BLOCK NUMBER +FLUCNT, 0 /REPLACED BY LENGTH (UNUSED) +ASERR, ISZ CDZSKP /SKIP RETURN IF ERROR + TAD ASPAGE + DCA IHNDLR /SET UP INPUT HANDLER ENTRY AND FLAG + TAD FLUNAM +FINRXX, DCA FINREC /***** THIS SHOULD BE AT LOC 600! ***** + CLA CMA + DCA FICHCT + TAD FIN10 + DCA FINTMP + JMP FRESET /RESET I/O AND RETURN FROM FASIGN + IFNZRO FINRXX-600 + /GET A CHARACTER ROUTINE. + /RETURNS TO .+1 IF ERROR, .+2 IF NORMAL + /CHAR IN AC ON OUTPUT + /DOES NOT HANDLE END-OF-FILE VERY WELL + +FICHAR, 0 + TAD FICHAR + JMS SAVEDF /SAVE RETURN FIELD AND ADDRESS +FNXTCH, ISZ FICHCT /BUMP CHAR COUNT + JMP FIGET + JMS I IHNDLR /IT OVERFLOWED - READ IN A NEW BUFFER +FI200, 200 +FINBUF, 1200 +FINREC, 0 +FI7700, SMA CLA + SKP /END - OF - FILE ERROR - IGNORE + JMP DFSAVE /ERROR RETURN + ISZ FINREC + CLA CMA + TAD FINBUF + DCA FINPTR + TAD FI7200 + DCA FICHCT /INITIALIZE FOR NEW RECORD +FIGET, TAD FINTMP /GET HIGH-ORDER-BIT BUFFER + SPA /IS IT FULL? + JMP FITHRD /YES - OUTPUT COMBINED HIGH-ORDER BITS +FI7200, CLA + ISZ FINPTR + TAD I FINPTR /GET A LOC FROM THE BUFFER + AND FI7400 + RAL CLL + TAD FINTMP /PUT THE HIGH ORDER BITS ONTO THE HOB BUFFER +FINXX, RTL + RTL + DCA FINTMP + TAD I FINPTR + JMP DFEXIT /RETURN WITH SKIP +FITHRD, DCA I FINPTR /FUDGE THIRD CHAR INTO BUFFER + CLL CML + JMP FINXX /RESET FINTMP TO 10 + /PUT A CHARACTER + /RETURNS TO .+1 IF ERR, .+2 IF NORMAL + /CALLED WITH CHAR IN AC + +FOCHAR, 0 + DCA FOUTMP /SAVE CHAR + TAD FOCHAR + JMS SAVEDF /SAVE CALLING FIELD AND LOC +FOLOOP, ISZ FOUJMP + ISZ FOCHCT /BUMP CHAR COUNT +FOJMP, JMP FOUJMP /TAKE A BRANCH OF THE THREE-WAY JUMP + JMS I OHNDLR + 4200 +FOUBUF, 1200 +FOUREC, 0 + JMP DFSAVE /OUTPUT ERROR + ISZ FOUREC + JMS FOSETP + ISZ FOCCNT /BUMP FILE LENGTH + ISZ FOOCNT /ALSO ENTER COUNT + JMP FOLOOP /NOW GO PUT THE CHAR INTO THE NEW BUFFER + JMP DFSAVE /ENTER COUNT OVERFLOWED - ERROR RETURN + +FOUJMP, JMP . /THREE-WAY SWITCH + JMP FOUCH1 + JMP FOUCH2 +FOUCH3, TAD FOUTMP + RTL + RTL + DCA FOUTMP + TAD FOUTMP + AND FI7400 + TAD I FOPOLD /PUT HIGH ORDER BITS OF CHAR3 + DCA I FOPOLD /INTO HIGH ORDER BITS OF CHAR 1 + TAD FOUTMP + RTL + RTL + AND FI7400 + TAD I FOUPTR /PUT LOW ORDER BITS OF CHAR 3 + DCA I FOUPTR /INTO HIGH ORDER BITS OF CHAR 2 + TAD FOJMP + DCA FOUJMP + ISZ FOUPTR + JMP DFEXIT /RETURN NORMALLY +FOUCH2, TAD FOUPTR + DCA FOPOLD /SAVE POINTER TO CHAR 1 + ISZ FOUPTR +FOUCH1, TAD FOUTMP + DCA I FOUPTR /STORE CHAR 1 OR 2 +DFEXIT, ISZ CDZSKP /INCREMENT RETURN ADDR + JMP DFSAVE /AND GO THERE + FOSETP, 0 + TAD FO7177 + DCA FOCHCT + TAD FOUBUF + DCA FOUPTR + TAD FOJMP + DCA FOUJMP + JMP I FOSETP + +FO7177, 7177 +FIN10, 10 + +FENTER, TAD ELENGT /ELENGT=0 UNLESS SOME KLUDGE SETS IT UP + CIF 10 /FENTER JUMPED TO BY FASIGN + JMS I FI200 + 3 +FOONAM, 0 /FILE NAME IN LOCS 0-3 +FOOCNT, 0 + ISZ CDZSKP /FOR ENTER, ERROR RETURN IS SKIP RETURN + TAD FOONAM + DCA FOUREC /INITIALIZE OUTPUT RECORD # + JMS FOSETP /SET UP CHARACTER POINTERS + DCA FOONAM /SET FOONAM FOR NEXT ENTER + TAD I PASPAG + JMP STOHND /GO TO COMMON CODE WITH "FCLOSE" +PASPAG, ASPAGE + +FCLOSE, CIF 10 /JUMPED TO BY FASIGN + JMS I FI200 /CALL I/O MONITOR + 4 +FOCNAM, 0 /FILE NAME IN 0-3 +FOCCNT, 0 /CLOSING LENGTH + ISZ CDZSKP /ERROR - BUMP RETURN +STOHND, DCA OHNDLR + DCA FOCCNT /INITIALIZE CLOSING COUNT FOR NEXT FILE +FRESET, CIF 10 + JMS I FI200 + 13 /RESET ALL DEVICE HANDLER ENTRIES + 0 /BUT RETAIN ANY OPEN OUTPUT FILES + JMP DFRSTR /RETURN FROM FASIGN AFTER KICKING MONITOR OUT +FOUTMP= FICHAR +FI7400, 7400 + PAGE + *1000 +PROPGT, 0 /CALLED FROM FIELD 1 LOADER WHEN 1ST + CDF 10 /CHECKING FOR I/O SWITCHES. + DCA I LTOPCOR /-# OF CORE FIELDS IN AC + TAD I LTOPCOR + DCA I LFCTR + TAD I LTOPCOR + CDF 0 + CMA /GET # OF HI CORE FIELD +PROPLP, DCA FC + CLA CMA + TAD FC + SNA CLA + JMP FIELD1 + TAD FC + JMS CHGBNK + JMS STOBNK + CLA CMA + TAD FC + JMP PROPLP +FIELD1, CLA IAC + JMS CHGBNK + JMS I LSHNDLR + 4100 + 0 + MTEMP + JMP I LLWOWIE + JMS I LSHNDLR + 4201 + 400 + MTEMP+21 /WRITE OUT RUN-TIME ROUTINES + JMP I LLWOWIE + JMS CHGBNK + TAD L6001 + DCA I LJSBITS + TAD L6213 + DCA I LJSTFLD + TAD LLRSTRT + DCA I LJSTADR + CDF CIF 10 /PROPGT IS CALLED FROM FIELD 1 ONLY + JMP I PROPGT +FC, 0 + CHGBNK, 0 + CLL RTL + RAL + TAD LCDF + DCA X1 + TAD X1 + DCA LINK+1 + TAD X1 + DCA RTN+1 + TAD X1 + DCA CDFSKP+2 + TAD X1 + DCA OBISUB+1 + TAD X1 + DCA OPISUB+1 + TAD X1 + DCA DUMSUB+1 + JMP I CHGBNK + +STOBNK, 0 + TAD LLINK1 + DCA X2 + TAD X2 + DCA X3 + TAD LLINK2 + DCA X4 + TAD X1 + DCA STOCDF +STOLUP, CDF 0 + TAD I X2 +STOCDF, HLT + DCA I X3 + ISZ X4 + JMP STOLUP + CDF 0 + JMP I STOBNK +SYSLIB, TEXT /LIB8/ + 2214 /.RL + +LTOPCOR,TOPCOR +LSHNDLR,SHNDLR +LFCTR, FCTR +LLWOWIE,LWOWIE +L6001, 6001 +LJSBITS,JSBITS +LJSTADR,JSTADR +LJSTFLD,JSTFLD +L6213, 6213 +LCDF, CDF +LLINK1, LINK-1 +LLINK2, LINK-MDUMP-2 + LDRZZ1, CDF 10 /COME HERE IF NOT CHAINED TO + DCA I LMOFIL + ISZ LMOFIL + ISZ LMOCNT + JMP .-3 + CLA CLL CMA RAL /-2 + DCA I LDOPRP + CDF 00 + JMP I .+1 + LDRYYY +LMOFIL, 7600 +LMOCNT, -47 +LLRSTRT,LRSTRT +LDOPRP, DOPROP +FORTRL, FILENAME FORTRL.TM + PAGE + *1200 /LINKING LOADER SUBROUTINES FOR /I AND /O OPTIONS +INPENB, 0 + ISZ INPFLG + JMP INRTRN /ALREADY HAVE A /I + JMS TWOPAG /HAS USER SPECIFIED 2-PG. HNDLRS? + TAD OUPFLG + SPA CLA + JMP INVRGN + TAD K2200 + DCA INHNDL + TAD (FINBUF + DCA I (ST1600 /MARK THE INPUT BUFFER IN PAGE 1600 + TAD K2377 + JMS SETHLA +INRTRN, CDF CIF 10 + JMP I INPENB + +INVRGN, TAD K1000 + DCA INHNDL + TAD K1577 + JMP INRTRN-1 + +OUPENB, 0 + ISZ OUPFLG + JMP OURTRN + JMS TWOPAG /HAS USER SPECIFIED 2 PG. HNDLRS? + TAD INPFLG + SPA CLA + JMP OUVRGN + TAD K2200 + DCA OUHNDL + TAD (FOUBUF + DCA I (ST1600 /MARK OUTPUT BUFFER IN 1600 + TAD K2377 + JMS SETHLA +OURTRN, CDF CIF 10 + JMP I OUPENB + +OUVRGN, TAD K1000 + DCA OUHNDL + TAD K1577 + JMP OURTRN-1 + +INPFLG, -1 +OUPFLG, -1 +K1000, 1000 /SET TO 1001 FOR 2 PAGE HANDLERS +K2200, 2200 /SET TO 2401 FOR 2 PAGE HANDLERS. +K2377, 2377 /SET TO 2577 FOR 2 PAGE HANDLERS. +K1577, 1577 /SET TO 1777 FOR 2 PAGE HANDLERS. + /SUBROUTINE TO CHECK FOR /H SWITCH MEANING USER +/WANTS RUN TIME DEVICE INDEPENDENT I/O TO +/BE ABLE TO USE 2 PAGE DEVICE HANDLERS +/ +TWOPAG, 0 + CDF 10 + TAD I (MPARAM + AND (20 /IS /H SWITCH SET? + SNA CLA + JMP I TWOPAG /NO-RETURN (DATA FLD=1) + TAD (1001 /YES-RESET HANDLR FETCH TO ACCEPT + DCA K1000 /TWO PAGE HANDLERS + TAD (2401 /RESET FETCH FOR SECOND HANDLER + DCA K2200 + TAD (2777 + DCA K2377 /RESET HLA CONSTANT FOR 2 PG HANDLRS + TAD (1777 + DCA K1577 /RESET 2ND HLA CONSTANT FOR 2 PG + TAD (2000 + DCA I (K1600 /RESET BUFR. ADDRESS-SEE *LDRXIT* + CDF 00 + TAD (1400 + DCA I (FINBUF /RESET IN AND OUT BUFFER ADDRESSES + TAD (1400 /TO MAKE ROOM FOR 2 PG HANDLR + DCA I (FOUBUF + CDF 10 + JMP I TWOPAG /RETN. DATA FLD=1 + +SETHLA, 0 + DCA I (HLAZ + TAD I (HLAZ + CIA + DCA I (HLAIO + CDF 0 + JMP I SETHLA +BATCK, 0 + CDF 0 + TAD I (7777 + AND (70 + SNA + JMP I BATCK + CLL RTR + RAR + CMA + DCA TMPC + TAD I (7777 + RAL + SPA CLA + IAC + TAD TMPC + JMP I (FOUNDX +TMPC, 0 + PAGE + FIELD 1 +/FIELD 1 PAGE 0 EQUIVALENCES - FIT INTO USR CRACKS + + DEVHND=20 + BANK=21 + TM1=22 + TM2=23 + RECNO=24 + OVLYFG=25 + CUR=26 + WORD=27 + HLAPTR=30 + HLA=31 + RCON=32 + COML=33 /HI COMMON LOC, 0 IF NONE + TYPE=34 + CSUM=35 + NSUB=36 + + *3600 +LRSTRT, DCA I (MIFILE +LDRZZZ, JMS I (IONULL +LDRXXX, TAD (MIFILE + DCA FILPTR + DCA OVLYFG + DCA I (WRBFSW + JMS I (START + JMP IOCHEK /GO TEST FOR /I, /O ALD /0-7 +LDRLP, DCA BANK + TAD I FILPTR + SNA + JMP GETCD + JMS GETHND + TAD I FILPTR + ISZ FILPTR + DCA RECNO + TAD I (MPARAM + RAR + SZL CLA + JMP I (LBRY + JMS I (LOAD + JMP LDRLP +GETCD, TAD I (MPARAM+3 + SNA + JMP LKATMP + DCA I (LSTADR + TAD I (MPARAM-1 + CLL RAL + AND (17 + CLL RTL + TAD (CDF CIF 0 + DCA I (LSTFLD /FALL INTO NEXT PAGE + LKATMP, JMS I (WRPGBF + TAD I (MPARAM + AND (40 + SZA CLA + JMP BUILD + TAD I (MPARAM-1 + SPA CLA + JMP BUILD + JMS MAP +CDCALL, JMS I (200 + 5 + 2214 + TAD I (MPARAM+1 + AND (100 + SZA CLA + JMP LDRZZZ +IOCHEK, JMS I (IOTEST + DCA TM1 + TAD (MIFILE + DCA FILPTR + TAD I (MPARAM+2 + AND (1774 + SNA + JMP LDRLP + RAL + ISZ TM1 + SNL + JMP .-3 + CLA CMA CLL RTL + TAD TM1 + JMP LDRLP +FILPTR, 0 +MAP, 0 + TAD I (MPARAM+1 + AND (4410 /"M","P" AND "U" OPTIONS + SNA +MAPRTN, JMP I MAP + CLL RTR + RTR + AND (200 + SZA CLA + CLL CML IAC + CML RAL /FORM 0 IF /U, 1 IF /P AND 2 IF /M + DCA TM1 + JMP I (MAPIO + BUILD, TAD (SHNDLR + DCA DEVHND + TAD PSYSLB + SZA + JMS I (LBSRCH + JMS MAP + JMP I (BUILDX +PSYSLB, 0 + +GETHND, 0 + AND (17 + DCA I (EASGN + TAD (401 + DCA LASGN + TAD I (EASGN + ISZ FILPTR + JMS I (200 + 1 /ASSIGN +LASGN, 401 + JMP I (HNDERR /BAD HANDLER + TAD LASGN + DCA DEVHND + JMP I GETHND + PAGE + BUILDX, TAD LSTADR + SZA CLA + JMP ALREDY + TAD (MAIN-1 + DCA X1 + JMS I (SETS1 + JMS I (SEARCH + JMP I (ERSTAD + TAD (TVEC-1 + TAD I (SYMNUM + DCA TM1 + CDF 0 + TAD I TM1 + SNA + JMP I (ERSTAD + DCA LSTADR + TAD TM1 + TAD (7700 + DCA TM1 + CLA CLL CML RTL /CHANGE CDF TO CDF CIF + TAD I TM1 + DCA LSTFLD +ALREDY, CDF 10 + JMS I (WROVLY + TAD (1400 + JMS STOINF + DCA OLDT9 + TAD (HLA7 + DCA TM1 + TAD (-10 + DCA X3 + DCA I X1 + DCA X4 +BLDLP, CLA CLL CML RTL + TAD X3 + SNA CLA + JMP BFLD1 /TREAT FIELD 1 (COMMON AREA) DIFFERENTLY +BLDLPX, TAD I TM1 + AND (7600 + SNA + JMP BLDSKP +BLDLPY, TAD (170 + CLL CML CMA RTR + RTR + TAD X3 + CLL CMA RTL + RAL + DCA I X1 + DCA I X1 + ISZ X4 +BLDSKP, CLA CMA + TAD TM1 + DCA TM1 + ISZ X3 + JMP BLDLP + TAD X4 + CIA + DCA I (1400 + CIF 0 + JMS I (SHNDLR + 4210 + 1200 + MTEMP+10 + HLT + CDF 0 + TAD (JSTFLD-1 + JMS STOINF + TAD LSTADR + DCA I (MSTADR + TAD LSTFLD + DCA I (MSTCDF + JMP I (LDRXIT + +BFLD1, TAD COML + SNA /IS THERE ANY COMMON? + JMP BLDLPX /NO + CLL CMA + TAD I TM1 + SNL CLA /IS THERE ANY CODE IN FIELD 1? + JMP BLDSKP /NO + TAD (110 /SAVE FIELD 1 IN TWO SEGMENTS - PAGE 0 AND + DCA I X1 /THE CODE FOLLOWING THE END OF THE COMMON AREA + ISZ X4 /(THIS IS TO ENABLE "CHAIN" TO WORK PROPERLY) + TAD COML + IAC + DCA I X1 + TAD COML + CMA + TAD I TM1 + AND (7600 + JMP BLDLPY + CVTREC, 0 + TAD CUR + CLL RTL + RTL + RAL + AND (7 + JMP I CVTREC + +STOINF, 0 + DCA X1 + TAD LSTFLD + DCA I X1 + TAD LSTADR + DCA I X1 + DCA I X1 + JMP I STOINF +LSTADR, 0 +LSTFLD, 0 + PAGE + + MAPIO, TAD I ML7600 + SNA + TAD TTYNO /TELETYPE IS DEFAULT LISTING DEVICE + JMS I (GETHND + TAD I ML7604 /PICK UP EXTENSION WORD. + SNA /NON-ZERO? + TAD (1520 /NO-SUPPLY '.MP' EXTENSION. + DCA I ML7604 /YES-LEAVE ALONE + TAD ML7601 + DCA MNAME + TAD I (EASGN + TAD (100 /4 SHIFTED LEFT INTO THE "DESIRED LENGTH" POSITION + JMS I (200 + 3 +MNAME, 0 +MECNT, 0 + JMP I (OUERR + TAD MNAME + DCA ORECNO + JMS OUSETP + DCA MCCNT + TAD (OCHAR + DCA TYPE + TAD TM1 + CLL CML RAR + JMP I (MAPX +OCHAR, 0 + DCA OUTEMP + ISZ OJMP + ISZ OCHCNT +OJMPE, JMP OJMP + CIF 0 + JMS I DEVHND + 4210 +OUBUF, 4600 +ORECNO, 0 + JMP I (OUERR + ISZ ORECNO + ISZ MCCNT + JMS OUSETP + ISZ MECNT + JMP OCHAR+2 + JMP I (OUERR + OUSETP, 0 + TAD (-601 + DCA OCHCNT + TAD OUBUF + DCA OUPTR + TAD OJMPE + DCA OJMP + JMP I OUSETP + +OJMP, HLT /THREE-WAY JUMP FOR CHAR OUTPUT + JMP OCHAR1 + JMP OCHAR2 +OCHAR3, TAD OJMPE + DCA OJMP + TAD OUTEMP + RTL + RTL + DCA OUTEMP + TAD OUTEMP + AND OU7400 + TAD I OUPOLD + DCA I OUPOLD + TAD OUTEMP + RTL + RTL + AND OU7400 + TAD I OUPTR + DCA I OUPTR + ISZ OUPTR + JMP OUCOM +OCHAR2, TAD OUPTR + DCA OUPOLD + ISZ OUPTR +OCHAR1, TAD OUTEMP + AND OU377 + DCA I OUPTR +OUCOM, JMP I OCHAR +OCHCNT, 0 + OUPOLD=OUSETP +OUTEMP, 0 +OU7400, 7400 +OUPTR, 0 +OU377, 377 + /CLOSE OUTPUT FILE + +OCLOS, TAD (232 + JMS OCHAR + TAD OCHCNT + CMA + SZA CLA + JMP .-4 + JMS OCHAR + TAD I (EASGN + JMS I (200 + 4 +ML7601, 7601 +MCCNT, 0 + JMP I (OUERR + TAD (TTYOUT + DCA TYPE + JMP I (MAPRTN + +TTYOUT, 0 + 6046 + 6041 + JMP .-1 +ML7600, 7600 + JMP I TTYOUT +TTYNO, 0 /SET TO TTY DEVICE NUMBER BY INITIALIZATION +IONULL, 0 + TAD ML7600 + DCA I (HLASZA +ML7604, 7604 /POINTER TO FILE EXT. WORD + JMP I IONULL + PAGE + LOAD, 0 + DCA LREQUR + TAD BANK + TAD (HLAZ + DCA HLAPTR + JMS I (SETRCN /SET UP HLA AND RCON + TAD RCON + CLL CML + TAD LREQUR + TAD (400 + SNL SZA CLA + JMP LFAILD + TAD RECNO + DCA LRECNO + CLA CMA + DCA INCHCT + JMS ICHAR + SNA CLA + JMP .-2 + JMP I (MORE + +ICHAR, 0 + TAD XX7600 /PARITY TTY HACK + KRS + TAD (-7603 + SNA CLA + KSF + SKP + JMP I (MGET /17667=07605 + ISZ IJMP + ISZ INCHCT +IJMPE, JMP IJMP + CIF 0 + JMS I DEVHND +INCTLW, 0410 +INBUF, 4600 +LRECNO, 0 + JMP INCKEF +INISZ, ISZ LRECNO + ISZ LRECNO + TAD IN6377 + DCA INCHCT + TAD INBUF + DCA INPTR + TAD IJMPE + DCA IJMP + JMP ICHAR+1 + IJMP, HLT /THREE-WAY JUMP FOR CHAR INPUT + JMP ICHAR1 + JMP ICHAR2 +ICHAR3, TAD IJMPE + DCA IJMP + TAD I INPTR + ISZ INPTR + AND IN7400 + CLL RTR + RTR + TAD INTEMP + RTR + RTR + JMP INCOM +ICHAR2, TAD I INPTR + ISZ INPTR + AND IN7400 + DCA INTEMP +ICHAR1, TAD I INPTR +INCOM, AND IN377 + JMP I ICHAR +INCKEF, SMA CLA + JMP LRECNO+2 + JMP I (INERR +INPTR, 0 +INCHCT, 0 +INTEMP, 0 +IN7400, 7400 +IN377, 377 +IN6377, 6377 + XX7600, +XER2, 7600 + TAD EASGN + TAD (DCB-1 + DCA TM2 + TAD I TM2 + SPA CLA + JMP DIRDEV + TAD (2205 + JMS I (TTWO + TAD (1417 + JMS I (TTWO + TAD (0104 + JMS I (TTWO + JMS I (CRLF +DIRDEV, TAD I HLAPTR + ISZ BANK + CMA + AND XX7600 + JMP LOAD+1 +LFAILD, ISZ BANK + JMP LOAD+2 +EASGN, 0 +LREQUR, 0 +LOADOK, JMS I (WRPGBF + JMP I LOAD + +SETS1, 0 + TAD (S1-1 + DCA X2 + TAD I X1 + DCA I X2 + TAD I X1 + DCA I X2 + TAD I X1 + DCA I X2 + JMP I SETS1 + PAGE + / 4600-5177 USED FOR LOADER MAP OUTPUT BUFFER +/ 5200-5577 USED FOR LIBRARY DIRECTORY BUFFER + + *5600 + +/** CAN ONLY USE FIRST HALF OF THIS PAGE - 2ND HALF IS PART OF MST +/** NO LITERALS IN THIS PAGE! + +LBRY, TAD RECNO + JMS LBSRCH + JMP I .+1 + GETCD + +LBSRCH, 0 /LIBRARY SEARCH ROUTINE + DCA LBREC /SAVE START BLK OF LIBRARY + CIF 0 + JMS I DEVHND /READ LIBRARY DIRECTORY +LBCTLW, 0210 +L5200, 5200 +LBREC, 0 + JMP I LIOERR + TAD LBCTLW + DCA I LINCTL + TAD L7177 + DCA I LIN6377 + DCA I LINISZ + TAD L5177 + DCA X1 /INITIALIZE FOR SEARCH +LBRYLP, JMS I LSETS1 /GET NEXT DIRECTORY ENTRY + TAD I X1 + SNA + JMP I LBSRCH /END OF DIRECTORY + TAD L5200 + DCA LBFPTR + JMS I LSEARCH /IS IT IN SYMTAB? + JMP LBRYLP /NO + TAD I LSYMNUM + TAD LTVEC1 + DCA TM1 + CDF 0 + TAD I TM1 + CDF 10 + SZA CLA /IS SYMBOL ALREADY DEFINED? + JMP LBRYLP /YES +LBLDLP, TAD I LBFPTR /GET MODULE TO LOAD + SNA + JMP LBRYLP-2 /NO MORE MODULES TO LOAD + AND L177 + IAC + TAD LBREC + DCA RECNO + DCA BANK + TAD I LBFPTR + AND L7600 + JMS I LLOAD /LOAD LIBRARY MODULE + ISZ LBFPTR + JMP LBLDLP /GET NEXT MODULE + +LBFPTR, 0 +LIOERR, INERR +LINCTL, INCTLW +L7177, 7177 +LIN6377, IN6377 +L5177, 5177 +LSETS1, SETS1 +LSEARCH, SEARCH +L177, 177 +L7600, 7600 +LLOAD, LOAD +LSYMNUM, SYMNUM +LINISZ, INISZ +LTVEC1, TVEC-1 + IFZERO .-5700&4000 + /MAIN LOADING CODE +/MODIFIED VERSION OF +/PAPER-TAPE LINKING LOADER + +/DEFINITIONS + +BCRT= 200 +TVEC= 300 +ORGT= 100 /LOCAL SYMBOL TABLE NOW IN FIELD 0 +MST= 6177 /MAIN SYMBOL TABLE + +*6200 + +/START OF PROGRAM - INITIALIZATION + +START, 0 + TAD K7600 /SET COUNTER FOR 200 + DCA NSUB + TAD BCRTA /POINTER TO BANK TABLE + DCA X3 + CDF 00 + DCA I X3 /CLEAR BANK TABLE & TV TABLE + ISZ NSUB + JMP .-2 /NOT DONE + CDF 10 + TAD M10 + DCA NSUB + TAD HLAZA + DCA X3 + TAD K777 + DCA I X3 /BANK0 HIGHEST LOADED ADDR. =777 + ISZ NSUB /NSUB INCREMENTS TO ZERO + JMP .-2 + DCA COML /INIT. OLD COMMON AT 0000 + JMP I START + /REENTRY FOR NEXT ROUTINE TO BE LOADED + +MORE, DCA LMTC /CLR LOCAL SYMBOL COUNT + DCA CSUM /CLR CHECKSUM + TAD MORE1A /SET FOR RETURN TO MORE1 IF LEADER + DCA EOF +MORE1, JMS RWORD + TAD RC10A /RESET EOF TO WATCH FOR TRAILER + DCA EOF + TAD CODE /CK FOR HIGH COMMON + TAD M12 + SZA CLA + JMP I ER5P /NOT THERE + TAD COML + CIA + CLL CML /IF NO COMMON EXISTS, OR + TAD WORD /IF NEW COMMON .LE. OLD IT'S + SNL SZA CLA /OK, ELSE ERROR + JMP I ER3P + TAD COML + SNA CLA + TAD WORD /IF NO PREVIOUS COMMON AND IF + AND K7600 /THIS PROGRAM HAS COMMON ABOVE 177 + SNA /THEN SET COMMON LIMIT TO LIMIT OF THIS PROG + JMP GETSW + AND K7400 + TAD K377 /HIGH COMMON MUST BE AT A MULTIPLE OF 400 + DCA COML + TAD I HLA1P /IF WE HAVE LOADED + SZA CLA /ANY CODE INTO FIELD 1 + JMP I ER3P /IT'S AN ERROR + TAD COML /SET BANK1 HIGHEST LOADED ADDRESS + DCA I HLA1P + JMS I (SETRCN /SET UP HLA AND RCON AGAIN JUST IN CASE +GETSW, TAD BANK /BANK NUMBER + TAD TOPCOR /OK FOR NON-EX. MEM. + SMA CLA + JMP I ER2I /TOO BIG +/ +/MAIN LOADING LOOP +/ +LOOP, JMS RWORD + TAD BASE /LOCATE CORRECT FUNCTION + TAD CODE /IN TRANSFER TABLE + DCA CODE +CODE, 0 /TRANSFER TO APPROPRIATE ADDRESS + /READ 12-BIT COMPUTER WORD & 4-BIT RELOCATION CODE +/FROM 2 INPUT CHARACTERS + +RWORD, 0 + JMS I HSRPA /FIRST FRAME + DCA WORD + TAD WORD /EXTRACT RELOC. CODE + RTR + RTR + AND K17 + DCA CODE + TAD CODE /CK FOR LEADER + TAD M10 + SNA CLA + JMP I EOF /YES + TAD WORD /ADD TO CHECKSUM + TAD CSUM + DCA CSUM + JMS FORMWD + JMS I RCHARP + TAD WORD + DCA WORD + JMP I RWORD + +FORMWD, 0 + TAD WORD + RTR + RTR + RAR + AND K7400 /ISOLATE HI 4 BITS + DCA WORD /FROM 1ST CHAR + JMP I FORMWD + +/DATA + +EOF, 0 +LMTC, 0 +K17, 17 +K377, 377 +K777, 777 +K7400, 7400 +K7600, 7600 +M10, -10 +M12, -12 +BASE, JMP I TRTAB +BCRTA, BCRT-1 +HLAZA, HLAZ-1 +HSRPA, ICHAR +MORE1A, MORE1 +RCHARP, RCHAR +TOPCOR, 0 +HLA1P, HLA1 +ER2I, ER2 + /RELOCATION CODE TRANSFER TABLE + +TRTAB, RC0 /LOAD AS IS + RC1 /ADD RELOCATION CONSTANT + ER5 + RC3 /DEFINE SYMBOL + RC4 /ORIGIN + RC5 /CDF TO CURRENT BANK + RC6 /REPLACE LOCAL # WITH GLOBAL # + ER5 +RC10A, RC10 /LEADER-TRAILER + ER5 +ER3P, ER3 /HIGH COMMON +ER5P, ER5 + ER5 + ER5 + ER5 + RC17 /EXTERNAL SYMBOL SPECIFICATION + PAGE + /NEW ORIGIN + +RC4, TAD WORD /NEW ORIGIN + CLL + TAD RCON /+ RELOCATION CONSTANT + DCA CUR /= NEW LOADING ADDRESS + SZL + JMP I OVERFP /FIELD OVERFLOW + JMP I LOOPP1 +/ +/CHANGE CDF TO CURRENT BANK +/ +RC5, TAD BANK /MOVE BANK TO BITS 6-8 + CLL RTL + RAL + TAD WORD /PICK UP CDF + JMP RC1+2 +/ +/REPLACE LOCAL EXTERNAL SYMBOL NUMBER WITH GLOBAL EXT. SYM. NO. +/ +RC6, TAD WORD + AND K77 /EXTRACT LOCAL NUMBER + DCA B1 + TAD B1 /CK IF LOCAL # .LE. LOCAL SYM. COUNT + CIA + TAD I LMTCP1 + SPA CLA + JMP I ER5I /NO + TAD B1 /ADD LOCAL # TO BASE OF TABLE + TAD ORGTA + DCA B1 + TAD WORD /LOAD ARG COUNT + AND K7700 +KCDF, CDF 0 + TAD I B1 /+ GLOBAL # + CDF 10 + JMP RC1+2 /AT CURRENT LOADING ADDRESS + /ADD RELOCATION CONSTANT TO WORD + +RC1, TAD WORD + TAD RCON + DCA WORD +/ +/LOAD WORD DIRECTLY AS IT IS +/ +RC0, TAD HLA /CK FOR CURRENT ADDRESS TO LOAD + CIA CLL /.GE. HIGHEST ALREADY LOADED + TAD CUR + SNL CLA + JMP .+3 /NO + TAD CUR /YES, RESET HIGHEST + DCA HLA + CLL + TAD CUR /CK FOR ATTEMPT TO LOAD TOP PAGE + TAD K200 + SZL CLA + JMP I OVERFP /YES, ROUTINE IS TOO BIG + CLA CMA + TAD BANK + SZA CLA + JMP JUSTLD + CLL CML CLA RTR + TAD CUR + SZL SPA CLA + JMP GT2000 + TAD OVLYFG +K7700, SMA CLA + JMP OFFSET + JMS I (CVTREC + TAD (-11 + JMP PAGEX2 +GT2000, TAD CUR + CLL + TAD (-3600 + SZL CLA + JMP PAGEX1 + JMS I (WROVLY + CLA CMA + DCA OVLYFG + JMP JUSTLD +PAGEX1, TAD K200 + JMS I (CVTREC +PAGEX2, TAD (MTEMP+11 + JMS I (WRPGBF + CLA CLL CML RTR + TAD CUR + SZL SPA CLA + TAD K200 + TAD CUR + AND (377 + TAD (1400 + JMP JUSTLD+1 +OFFSET, CLA IAC + DCA OVLYFG + TAD (1600 +JUSTLD, TAD CUR + DCA CURX + TAD BANK + CLL RTL + RAL + TAD KCDF + DCA .+2 + TAD WORD + HLT + DCA I CURX + CDF 10 + ISZ CUR + JMP I LOOPP1 +CURX, 0 +/ +/DATA +/ +K77, 77 +K200, 200 +ER5I, ER5 +LMTCP1, LMTC +LOOPP1, LOOP +ORGTA, ORGT +OVERFP, OVERFL +HLAZ, 0 /HLA GROUP MUST REMAIN IN GIVEN ORDER +HLA1, 0 +HLA2, 0 +HLA3, 0 +HLA4, 0 +HLA5, 0 +HLA6, 0 +HLA7, 0 +B1, + +HLATST, 0 + TAD HLAZ + TAD HLAIO +HLASZA, SZA CLA /SET TO CLA BY /R AND RESTART + JMP I (UIOERR + JMP I HLATST +HLAIO, -777 + PAGE + /SYMBOL DEFINITION + +RC3, JMS I GTSYMP + TAD TVM1 /ADJUSTED BASE OF TRANSFER VECTOR TABLE + TAD SYMNUM /+ NUM. OF SYMBOL IN MST + DCA C1 + TAD RCON /LOADING ADDRESS OF THE SYMBOL + TAD WORD + CDF 00 + DCA I C1 /TO THE TRANS. VEC. TABLE + TAD C1 /GET POINTER INTO TRANSFER VECTOR TABLE + TAD M100A /FORM CORRESPONDING POINTER INTO BANK TABLE + DCA C1 /=PTR. TO BANK TABLE STORAGE + TAD BANK /GET BANK IN BITS 6-8 + CLL RTL + RAL + DCA I C1 /STORE IN BANK TABLE + CDF 10 +RC3A, TAD NSUB /CHECK FOR TOO MANY SYMBOLS + TAD M100A + SPA SNA CLA + JMP I LOOPP2 /NO + JMP ER1 +/ +/TRANSFER VECTOR +/ +RC17, TAD WORD /COUNTER OF SYMBOLS TO COME + CIA + DCA C2 +RC17A, JMS I GTSYMP + ISZ I LMTCP2 /INC. LOCAL SYM. CTR. + TAD ORGTA2 /GET PTR TO STORAGE IN ORIG. TABLE + TAD I LMTCP2 + DCA C1 + CMA /SYM. # -1 TO ORIG. TABLE + TAD SYMNUM + CDF 0 + DCA I C1 + CDF 10 + ISZ C2 /CK CTR. + JMP RC17A /NOT DONE + JMP RC3A + /ERRORS + +SIOERR, +H7600, 7600 + DCA ERBACK + IAC +HNDERR, IAC +ERSTAD, IAC +INERR, IAC +OUERR, IAC +ER5, IAC /ILLEGAL INPUT FORMAT +ER4, IAC /CHECKSUM ERROR +ER3, IAC /HIGHEST COMMON NOT FIRST +ER2, IAC /PROGRAM TOO LARGE +ER1, IAC /SYMBOL TABLE OVERFLOW +UIOERR, DCA C3 + JMS CRLF + TAD K0522 /"ER" + JMS TTWO + TAD K2217 /"RO" + JMS TTWO + TAD K2240 /"R " + JMS TTWO + TAD C3 /# + JMS TOCT + JMS I (WRPGBF +ERBACK, JMP I (CDCALL + CDF CIF 0 + JMP I H7600 /RETURN TO MONITOR +/ +/TYPE A CARRIAGE RETURN & LINE FEED +/ +CRLF, 0 + TAD K215 + JMS I TYPE + TAD K212 + JMS I TYPE + JMP I CRLF +/ +/UNPACK & TYPE 2 6-BIT CHARACTERS +/ +TTWO, 0 + DCA C1 + CMA /SET FLAG FOR 1ST CHARACTER + DCA C2 + TAD C1 /MOVE LEFT HALF DOWN + RTR + RTR + RTR + SKP +TTWO1, TAD C1 /GET RIGHT HALF + AND C77 + TAD M40 /200 OR 300 GROUP? + SPA + TAD K100 /300 + 6BIT + TAD K2240 /200 + 6BIT + JMS I TYPE + ISZ C2 /2ND CHARACTER DONE? + JMP I TTWO + JMP TTWO1 /NO +/ +/TYPE OCTAL CONTENTS OF AC +/ +TOCT, 0 + DCA C1 + TAD M4B + DCA C2 +TOCT1, TAD C1 /MOVE NEXT DIGIT INTO BITS 9-11 + RTL + RAL + DCA C1 + TAD C1 /GET DIGIT + RAL + AND KK7 + TAD C260 /CONVERT TO ASCII + JMS I TYPE + ISZ C2 + JMP TOCT1 /MORE TO GO + JMP I TOCT +/ +/DATA +/ +C1, 0 +C2, 0 +C3, +SYMNUM, 0 +KK7, 7 +C77, 77 +K100, 100 +K212, 212 +K215, 215 +C260, 260 +K0522, 0522 +K2217, 2217 +K2240, 2240 +M4B, -4 +M40, -40 +M100A, -100 +GTSYMP, GETSYM +LMTCP2, LMTC +LOOPP2, LOOP +ORGTA2, ORGT +TVM1, TVEC-1 + PAGE + /STORE OR LOOK UP SYMBOL IN SYMBOL TABLE + +DEFN, 0 + +/READ A SYMBOL FROM INPUT ASCII - 6 FRAMES + + CLA CLL CMA RTL + DCA D1 + TAD S1A /POINTER TO 3 WORD BUFFER + DCA X3 +RSYM1, JMS RCHAR + AND K0077 /EXTRACT 6-BIT + CLL RTL + RTL + RTL + DCA D3 /SAVE LEFT HALF + JMS RCHAR + AND K0077 /GET RIGHT HALF + TAD D3 + DCA I X3 + ISZ D1 + JMP RSYM1 /NOT DONE + JMP I DEFN +/ +/SEARCH SYMBOL TABLE FOR CURRENT SYMBOL (IN S1-S3) +/ +SEARCH, 0 + DCA I SYMNMP /CLR SYMBOL COUNTER + TAD MSTA /SET SYMBOL TABLE PTR + DCA D4 + TAD NSUB /SET CTR FOR NUMBER OF SYMBOLS + CMA /+1 (IN CASE NSUB=0) + DCA D5 + JMP SRCH2 +SRCH1, ISZ I SYMNMP /KEEP COUNT + TAD D4 /TEST TABLE ENTRY + DCA X4 /SYM. TAB. PTR + CLA CLL CMA RTL + DCA D2 /COUNTER + TAD S1A + DCA X3 /PTR TO S1/S3 +COMP1, TAD I X4 /COMPARE WORDS + CIA + TAD I X3 + SZA CLA + JMP NOMACH /NOT ALIKE + ISZ D2 + JMP COMP1 /TRY NEXT WORD OF TRIPLET + ISZ SEARCH + JMP I SEARCH +NOMACH, CLA CLL CMA RTL + TAD D4 + DCA D4 +SRCH2, ISZ D5 + JMP SRCH1 /NOT DONE + JMP I SEARCH +/ +/ENTER A SYMBOL IN THE SYMBOL TABLE +/ +INSERT, 0 + TAD NSUB /(NUMBER OF SYMBOLS)*3 + CLL RAL + TAD NSUB + CIA /SUBTRACT FROM BASE OF TABLE + TAD MSTA + DCA X3 /FOR POINTER + TAD S1 /1ST WORD + DCA I X3 + TAD S2 /2ND + DCA I X3 + TAD S3 /3RD + DCA I X3 + ISZ NSUB /COMPUTE SYM. TAB. NUMBER + TAD NSUB + DCA I SYMNMP + JMP I INSERT +/ +/CORE OVERFLOW +/ +OVERFL, TAD BCRTA3 + DCA D1 + TAD TVECA3 + DCA D2 + TAD M100 + DCA D3 + CDF 00 +OVERF2, TAD I D1 /CK FOR CDF IN BCRT + SPA CLA + JMP .+3 /YES + DCA I D1 /NO, CLEAR IT + DCA I D2 /CLEAR TV WORD + ISZ D1 + ISZ D2 + ISZ D3 + JMP OVERF2 /MORE TO GO + CDF 10 + JMP I ER2P + +GETSYM, 0 /GET SYMBOL AND SEARCH TABLE + JMS DEFN + JMS SEARCH + JMS INSERT + JMP I GETSYM + /READ 1 FRAME & ADD TO CHECKSUM + +RCHAR, 0 + JMS I HSRPB + DCA D4 + TAD D4 + TAD CSUM + DCA CSUM + TAD D4 + JMP I RCHAR + +SETRCN, 0 /SUBR TO SET HIGHEST-LOADED ADDRESS (HLA) + TAD I HLAPTR /AND RELOCATION CONSTANT (RCON) + DCA HLA + TAD HLA + AND (7600 + DCA RCON + JMP I SETRCN + +MAIN, 1501;1116;4040 /"MAIN" + +/ +/DATA +/ +D1, 0 +D2, 0 +D3, 0 +D4, 0 +D5, 0 +S1, 0 +S2, 0 +S3, 0 +K0077, 77 +M100, -100 +BCRTA3, BCRT +ER2P, XER2 +HSRPB, ICHAR +MSTA, MST-3 +S1A, S1-1 +SYMNMP, SYMNUM +TVECA3, TVEC + PAGE + /TRAILER CODE EXIT + +RC10, JMS I (FORMWD + JMS I HSRP /GET LOW ORDER PART + TAD WORD + CIA + TAD CSUM /COMPARE WITH ACCUMULATED SUM + SZA CLA + JMP I ER4P /NOT EQUAL + TAD BCRTA4 + DCA T1 + TAD TVECA + DCA X2 + TAD M100D + DCA T3 +K6201A, CDF 00 +RC10Z, TAD I X2 /GET TV ENTRY + SNA CLA + JMP .+5 /NOT DEFINED; IGNORE IT + TAD I T1 /GET BCRT WORD + AND K70 /EXTRACT BANK + TAD K6201A /COMBINE CDF + DCA I T1 + ISZ T1 + ISZ T3 + JMP RC10Z /NOT DONE YET + CDF 10 + TAD HLA /STORE HIGHEST LOADED ADDRESS + DCA I HLAPTR /IN PROPER LOC. (HLA0-7) + JMP I (LOADOK + /LOADER MAP PRINT ROUTINE CONTINUED + +MAPX, SNL CLA /IF LINK=1 ONLY PRINT PAGE COUNTS, + TAD NSUB /OTHERWISE PRINT SYMBOLS + CMA + DCA T1 /CTR OF ROUTINES + TAD MSTA4 /SYMB. TAB. PTR. + DCA X1 + TAD TVECA /TV PTR + DCA X2 + TAD BCRTA4 /BCRT PTR + DCA T4 + TAD (2640 /PRINT V# + JMS I TTWOP + TAD (VERSION+PATCH + JMS I TTWOP + JMS I CRLFP + JMP PRINT1 +PRINT, TAD TM1 + RTR CLL + CDF 0 + TAD I X2 + CDF 10 + DCA TM2 + TAD TM2 + SNL SZA CLA + JMP PIGNOR + TAD I X1 + JMS I TTWOP + TAD I X1 + JMS I TTWOP + TAD I X1 + JMS I TTWOP + TAD K4040 /2 SPACES + JMS I TTWOP + CDF 00 + TAD I T4 /PRINT BANK NUMBER + CDF 10 + RTR + RAR + AND K7B + TAD K260 + JMS I TYPE + TAD TM2 /PRINT SYMBOL VALUE + JMS I TOCTP + TAD TM2 /IF ADDRESS=0,IT IS UNDEFINED + SZA CLA + JMP .+3 /ITS OK + TAD K4025 /TYPE SPACE,U + JMS I TTWOP + JMS I CRLFP + TAD M03 +PIGNOR, TAD M03 + TAD X1 + DCA X1 + ISZ T4 +PRINT1, ISZ T1 + JMP PRINT /JUMP IF MORE SYMBOLS, ELSE FALL INTO NEXT PG + PAGES, TAD FCTR /SET CTR FOR CORRECT # OF BANKS + DCA T1 + TAD (HLAZ-1 /INIT. PTR. TO HLA LIST + DCA X1 + TAD I X1 /GET HLA OF NEXT BANK + CMA RTL /DIVIDE BY 200 AND COMPLEMENT + RTL + RTL + AND K37 /=NUMBER OF PAGES LEFT + 1 + SZA + TAD (-1 /REDUCE IF NON-ZERO + JMS I TOCTP + JMS I CRLFP + ISZ T1 + JMP PAGES+4 /NOT DONE WITH ALL BANKS + JMP I (OCLOS + +/ +/DATA +/ +FCTR, 0 /# OF HIGHEST MEM. FIELD +K37, 37 +T1, 0 +T3, 0 +T4, 0 +K7B, 7 +K70, 70 +K260, 260 +K4025, 4025 +K4040, 4040 +M03, -3 +BCRTA4, BCRT +CRLFP, CRLF +ER4P, ER4 +HSRP, ICHAR +MSTA4, MST-3 +TOCTP, TOCT +TTWOP, TTWO +TVECA, TVEC-1 +M100D, 7700 + PAGE + /WROVLY IS USED TO STORE THE FIELD COUNT FOR THE PROPGT +/ROUTINE- PROPGT IS CALLED THE FIRST TIME THAT IOTEST IS +/CALLED-SEE LOC.325 IN FIELD ZERO(APPROX.) + +BC1000, 1000 +WROVLY, 0 + TAD OVLYFG + SPA SNA CLA + JMP I WROVLY + CIF 0 + JMS I (SHNDLR + 0110 + 1600 + MTEMP + JMP I (SIOERR + CIF 0 + JMS I (SHNDLR + 5010 + 1600 + MTEMP + JMP I (SIOERR + DCA OVLYFG + JMP I WROVLY + +WRPGBF, 0 + DCA PRECNO + TAD WRBFSW + SNA + JMP PREAD + CIA + TAD PRECNO + SNA CLA + JMP I WRPGBF + CIF 0 + JMS I (SHNDLR + 4210 + 1400 +WRBFSW, 0 + JMP I (SIOERR +PREAD, DCA OLDT9 + TAD PRECNO + SNA CLA + JMP SETBF + CIF 0 + JMS I (SHNDLR + 0210 + 1400 +PRECNO, 0 + JMP I (SIOERR +SETBF, TAD PRECNO + DCA WRBFSW + JMP I WRPGBF + /LOADER CLEANUP CODE - PREPARES TO RETURN TO OS/8 + +LDRXIT, CDF 10 + TAD I (HLA1 + TAD BC200 +L7700, SMA CLA /DID WE LOAD OVER THE LOADER? + TAD (FIVE /NO + DCA WROVLY /WROVLY=0 OR 5 + CIF 0 + JMS I (SHNDLR + 0201 + 400 + MTEMP+21 /READ BACK THE RUN-TIME ROUTINES + JMP I (SIOERR /BADDIE + TAD K1600 + CDF 0 + DCA I ST1600 + TAD I P4 + DCA I P5 + ISZ P4 + ISZ P5 + ISZ P6 + JMP .-5 /ALSO MOVE 16-32 INTO LOC 100 + CDF 10 + JMS I BC200 + 13 /RESET EVERYTHING + TAD I (MPARAM + AND (40 /GET "/G" SWITCH + SNA CLA + JMP CALMON /GO SWITCH NOT ON + JMS I BC200 + 11 /KICK MONITOR OUT + CDF CIF 0 + TAD (MSTCDF + DCA I (FIVE+1 /GO TO PROGRAM START ADR INSTEAD OF 7600 + ISZ I (ONE /OPTOMIZE READ A LITTLE ON DECTAPE + JMP I WROVLY + +CALMON, CLA CMA + DCA I L7700 /INDICATE I/O MONITOR IS IN CORE + CDF CIF 0 + JMP I WROVLY /GET OUT + +ST1600, 177 /THIS IS SET TO "FINBUF" OR "FOUBUF" BY /I AND /O +P4, 16 +P5, 100 +P6, -15 + /ROUTINE TO TEST FOR /I AND /O SWITCHES + +IOTEST, 0 + TAD I (MPARAM + AND (10 + SNA CLA //I? + JMP .+4 + JMS I (HLATST + CDF CIF 0 + JMS I (INPENB + TAD I (MPARAM+1 +BC200, AND BC1000 + SNA CLA //O? + JMP .+4 + JMS I (HLATST + CDF CIF 0 + JMS I (OUPENB + ISZ DOPROP /SHOULD WE PROPAGATE RESIDENT(AND WRITE OUT + JMP .+4 /THE RUN-TIME ROUTINES?)--NO + TAD WROVLY /YES-FIELD COUNT IS IN WROVLY + CDF CIF 0 + JMS I (PROPGT /DO IT + JMP I IOTEST +K1600, 1600 /RESET TO 2000 IF TWO PG.DEV.HNDLRS AT RUN TIME +DOPROP, 7777 /ONCE-ONLY FLAG FOR PROPAGATING FIELD ZERO + /RESIDENT AND WRITING OUT RUNTIME ROUTINES + /NOT RESET AFTER /R!!!! + /SET TO -2 IF CALLED BY ".R LOADER" + /BECAUSE OF USELESS INIT CALL TO IOTEST + PAGE + $ + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/README b/sw/os8/v3d/sources/system/dectapes/dectape1/README new file mode 100644 index 0000000..583a608 --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/README @@ -0,0 +1,18 @@ +This area contains the files contained on system release DECtape #1. + +Directory of OS/8 V3D DECtape 1 labeled: AL-4691C-SA 2/15/78 + OS/8 V3D SRC DT 1 OF 7 + (replaces DEC-S8-OSYSB-B-UA1) + + +EPIC .PA 65 01-AUG-77 TD8EC .PA 20 01-AUG-77 +CREF .PA 148 01-AUG-77 TD8ED .PA 20 01-AUG-77 +RK08SY.PA 16 01-AUG-77 FLOAT .SB 27 01-AUG-77 +RK08NS.PA 11 01-AUG-77 LIBSET.PA 32 01-AUG-77 +ASR33 .PA 10 01-AUG-77 SRCCOM.PA 63 01-AUG-77 +TD8EA .PA 20 01-AUG-77 C2BOOT.PA 8 01-AUG-77 +TD8EB .PA 20 01-AUG-77 LOADER.PA 99 01-AUG-77 + + 14 files in 559 blocks - 171 free blocks + + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/RK08NS.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/RK08NS.PA new file mode 100644 index 0000000..e8d82fb --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/RK08NS.PA @@ -0,0 +1,197 @@ +/3 RK8 NON SYSTEM HANDLER +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + *0 + -4 + +DEVICE RK01;DEVICE RKA0;4050;20;ZBLOCK 2 +DEVICE RK01;DEVICE RKA1;4050;21;ZBLOCK 2 +DEVICE RK01;DEVICE RKA2;4050;22;ZBLOCK 2 +DEVICE RK01;DEVICE RKA3;4050;23;ZBLOCK 2 + + DLDC=6732 + DCLS=6742 + DRDS=6741 + DSKD=6745 + DSKE=6747 + DCLA=6751 + DLWC=6753 + DLCA=6755 + DLDR=6733 + + RKVERSION="A&77 + +/V3 CHANGES: + +/1. VERSION # IS NOW 1 +/2. A FULL 4K READ OR WRITE IS NOW LEGAL + + *200 +/THE ENTRY POINTS FOR RK8 ARE SET AT 20-23. VITAL!! + +RLOC, 0 /FOR BUFFER ADDRESS +RREC, 0 /HOLDS RECORD NO. +R76, 76 +RDLDR, DLDR +RKANO, 0 +RKAISZ, ISZ RKANO +RBLKCT, 0 /HOLDS TOTAL WORD COUNT +RERRCT, 0 /# ERROR TRIES +R177, 177 +R40, 40 +RM3, -3 +R400, 400 +R7400, 7400 +RKA, 0 /HOLDS ARGUMENT ADDRESS +R34, 34 +RZERO, RKVERSION + IFNZRO .-220 +RKA0, ISZ RKANO +RKA1, ISZ RKANO +RKA2, ISZ RKANO +RKA3, ISZ RKANO +R7600, 7600 + TAD RM3 + DCA RERRCT /3 TRIES ON ERROR + TAD RKANO /THIS CODE RESTORES THE ISZ RKANO + CMA /WHICH WAS DESTROYED IN THE CALL + TAD RKATAD + DCA RFUNCT + CLA CLL CML RTR + TAD RFUNCT /FORM DCA RKAN,WHERE RKAN WAS CALLED + DCA RKADCA + RDF + TAD RCDIF /RESTORE TO PROPER FIELD + DCA REXIT +RFUNCT, HLT /CONTAINS TAD RKAN WHEN EXECUTED + DCA RKA /SO WE SAVE ADDRESS OF ARGUMENTS + TAD RKAISZ /AND NOW RESTORE THE ISZ RKANO +RKADCA, HLT + TAD I RKA /FUNCTION WORD + DCA RFUNCT + ISZ RKA + CLA CMA /BUFFER ADDRESS -1 + TAD I RKA + DCA RLOC + ISZ RKA + TAD I RKA /RECORD NUMBER + DCA RREC + TAD RFUNCT /NOW FORM RK8 IOT FROM FUNCTION. + CLL RAL /READ/WRITE TO LINK + AND R7600 /ISOLATE WORD COUNT + DCA RBLKCT + RTL /READ=6733,WRITE=6735 + TAD RDLDR + DCA RINST + RLOOP, TAD RLOC /LOAD CURRENT ADDRESS + DLCA + TAD RBLKCT /TEST WORD COUNT FOR SIZE. +RKATAD, TAD R7600 /FULL=256, HALF=128 + SZA CLA + TAD R7600 + TAD R7600 + DLWC /LOAD WORD COUNT + TAD RFUNCT /LOADING COMMAND WORD WITH FIELD + CMA RAR /AND DISK SELECTION + AND R34 + TAD RKANO + CMA RAL + AND R76 + DLDC + DCLS /CLEARS SELECT ERROR IF STILL UP + TAD RREC +RINST, HLT /GETS DISK IOT + DSKD /TEST COMPLETION FLAG + SKP CLA /NOT DONE YET + JMP RCTLC /DONE. CHECK FOR ^C + DSKE /IS ERROR UP? + JMP .-4 +RERROR, ISZ RERRCT /ERROR BUMP COUNT + JMP .+4 + DCA RKANO /IT'S ALL OVER. CLEAR FOR RECALL + CLA CLL CML RAR + JMP RETRN+1 /FATAL ERROR + DRDS /LOOK AT STSTUS + AND R40 /TRACK NOT FOUND BIT + ISZ RZERO /CARRY OVER FROM SYSTEM HANDLER + JMP .-1 + SNA CLA + JMP RLOOP /TRY AGAIN + DCLA /RECALIBRATE + DSKD + JMP .-1 + JMP RLOOP /AND TRY AGAIN + RNEXT, DSKE /TRANSFER DONE. IS ERROR UP? + SKP + JMP RERROR /YEP.TOUGH LUCK + ISZ RREC /BUMP RECORD NUMBER + TAD RLOC + TAD R400 /BUMP CURRENT ADDRESS + DCA RLOC + TAD RBLKCT /DONE WITH ALL TRANSFERS? + SNA + JMP RDONE /V3 0 OK HERE + CLL CML + TAD R7400 + SZL SNA + JMP RDONE + DCA RBLKCT /NO..UPDATE TOTAL WORD COUNT + JMP RLOOP /AND DO THE TRANSFER +RDONE, CLA + DCA RKANO /CLEAR FOR RECALL +RETRN, ISZ RKA + ISZ RKA +REXIT, HLT + JMP I RKA + +RCTLC, KRS /TEST FOR ^C IN KEYBOARD BUFFER + AND R177 /WITH THE FLAG UP + TAD RM3 + SNA CLA + KSF + JMP RNEXT /NO ^C, KEEP GOING +RCDIF, CIF CDF 0 + JMP I R7600 + $ + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/RK08SY.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/RK08SY.PA new file mode 100644 index 0000000..ff09ee2 --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/RK08SY.PA @@ -0,0 +1,255 @@ +/10 OS/8 RK8 SYSTEM HANDLER V3D +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + /SYSTEM HANDLER ALSO HAS RESIDENT THE NONSYSTEM HANDLER RKA1: + +/ SOFSET=7747 + + RKVERSION="D&77 + + DLDA=6731 /LOAD DISK ADDRESS (MAINT ONLY) + DLDC=6732 /LOAD COMMAND REGISTER + /0: ENABLE CHANGE IN INTERRUPT STATUS + /1: ENABLE PROGRAM INTERRUPT ON TRANSFER DONE + /2: ENABLE INTERRUPT ON ERROR + /3: UNUSED + /4: SEEK TRACK AND SURFACE ONLY + /5: ENABLE READ/WRITE OF 2 HEADER WORDS + /6-8: EXTENDED MEMORY ADDRESS + /9-10: DISK FILE NUMBER + /11: UNUSED + DLDR=6733 /LOAD DISK ADDRESS AND READ, THEN CLEAR AC + /0-7: TRACK ADDRESS + /8: SURFACE BIT + /9-11: SECTOR ADDRESS + DRDA=6734 /READ DISK ADDRESS + DLDW=6735 /LOAD DISK ADDRESS AND WRITE, THEN CLEAR AC + DRDC=6736 /READ DISK COMMAND REGISTER + DCHP=6737 /LOAD DISK ADDRESS AND CHECK PARITY + DRDS=6741 /READ DISK STATUS REGISTER + /0: ERROR + /1: TRANSFER DONE + /2: CONTROL BUSY ERROR + /3: TIME OUT ERROR + /4: PARITY OR TIMING ERROR + /5: DATA RATE ERROR + /6: TRACK ADDRESS ERROR + /7: SECTOR NO GOOD ERROR + /8: WRITE LOCK ERROR + /9: TRACK CAPACITY EXCEEDED ERROR + /10: SELECT ERROR + /11: BUSY + DCLS=6742 /CLEAR STATUS REGISTER + DMNT=6743 /LOAD MAINTENANCE REGISTER + /SEE PAGE 7-145 IN 1972 SMALL COMPUTER HANDBOOK + DSKD=6745 /SKIP ON DISK DONE + DSKE=6747 /SKIP ON DISK ERROR + DCLA=6751 /CLEAR ALL + DRWC=6752 /READ WORD COUNT REGISTER + DLWC=6753 /LOAD WORD COUNT REGISTER + DLCA=6755 /LOAD CURRENT ADDRESS REGISTER + DRCA=6757 /READ CURRENT ADDRESS REGISTER + *0 + + -3 + DEVICE RK8;DEVICE SYS;4051;2007;0;6260 + DEVICE RK8;DEVICE RKA0;4051;1007;0;6260 + DEVICE RK8;DEVICE RKA1;4051;RKA1&177+1000;0;6260 + +/V3D CHANGES: + +/FIXED BUG CONCERNING RETRY COUNT IF LINK SET ON CALL +/REMOVED 'SOFSET' + BOOT-ENDB-1 + + NOPUNC + *1 + ENPUNC + +BOOT, TAD I BOOTX1 + DCA I BOOTX2 + TAD I BOOTX3 + CDF 10 + DCA I BOOTX4 + CDF 0 + TAD BOOTX2 + SZA CLA + JMP BOOT + JMP BGETUT +BOOTX1, 200 +BOOTX2, 7577 +BOOTX3, 47 +BOOTX4, 7646 +BGETUT, DRDC + RAR + AND BOOT3 + DCA I BOOTUT + JMP I B7605 +BOOT3, 3 +BOOTUT, DEFUNIT + ZBLOCK 27-. +B7605, 7605 + DSKD /MUST LOAD OVER LOC. 30 + JMP .-1 /MUST LOAD OVER 31 +ENDB, JMP BOOT + /THE BOOTSTRAP FOR THE RK8 IS AS FOLLOWS: (UNIT 0) + + / LOCATION CONTENTS + / 30 6733 + / 31 5031 + + /LOAD ADDRESS 30 AND START + +/THE BOOTSTRAP FOR OTHER UNITS IS AS FOLLOWS: + +/ 26 7604 +/ 27 6732 +/ 30 6733 +/ 31 5031 + +/LOAD ADDRESS 26, PUT UNIT NUMBER IN SWITCH REGISTER BITS 9-10, +/CLEAR, CONTINUE + *200 + + NOPUNCH;*7600;ENPUNCH + + ZBLOCK 7 +RK8, RKVERSION + CLA + TAD DEFUNIT /USE DEFAULT UNIT FOR SYSTEM HANDLER + JMP COMN +DEFUNIT,0 +RKBAD, STL CLA RAR /4000 + SKP +RKOVER, ISZ RK8 /POINT TO GOOD RETURN +SFIELD, HLT /CONTAINS CIF CDF TO USER'S FIELD + JMP I RK8 /RETURN + IFNZRO .&177-21 +RKA1, RKVERSION + CLA + TAD RKA1 + DCA RK8 + CLA IAC +COMN, DCA RKANO + CLL STA RTL /V3D + DCA RKCNT /SET # OF RETRIES ON AN ERROR TO 3 + RDF + TAD LCIFCDF /CALLING FIELD FOR RETURN + DCA SFIELD +RKRETRY,TAD I RK8 /GET FN WORD + AND L70 /ISOLATE FIELD OF BUFFER + TAD RKANO + TAD RKANO /INCLUDE UNIT # (TIMES 2) + DLDC /SET FIELD + TAD I RK8 /GET FN WORD BACK + RAL /MOVE R/W BIT TO LINK + AND L7600 /ISOLATE # OF WORDS TO READ + SZA + CIA /NEGATE + DLWC /LOAD WORD COUNT THEN CLEAR AC + RTL /MOVE R/W BIT TO AC 10 + TAD LDLDR + DCA RKINST /CREATE READ (6733) OR WRITE (6735) + ISZ RK8 /POINT TO BUFFER ADDRESS + STA + TAD I RK8 /GET CURRENT ADDRESS-1 + DLCA /LOAD CURENT ADDRESS AND CLEAR AC + ISZ RK8 /POINT TO BLOCK # + DCLS /CLEAR STATUS REGISTER + DSKE /CHECK FOR NON-EXISTENT DISK ERROR +L7760, SMA SZA SNL CLA /OK, BUT SKIP ALWAYS + JMP RKBAD /IT'S BAD +/V3D TAD RKANO /! CAN'T HAVE OFFSETS ON OTHER UNITS THAN 0 +/V3D SNA CLA +/V3D TAD SOFSET + TAD I RK8 /GET BACK # + ISZ RK8 /POINT TO ERROR RETURN +RKINST, HLT /GO (EITHER 6733 OR 6735) + SZA CLA /CHECK FOR NO DISK AT ALL + JMP RKBAD /IOT DIDN'T CLEAR AC +/THE ABOVE TWO LINES ARE USELESS. HOW DID HE BOOTSTRAP IF DISK WASN'T THERE? + DSKD /WAIT FOR DONE + JMP .-1 + DSKE + JMP RKOVER /NO ERROR +L70, 70 +L20, 20 +L7600, 7600 +L4, 4 + SKP CLA + IFNZRO .-7701 + HLT /SAFETY HALT AT 7701 + DRDS /READ STATUS REGISTER + AND L4 /CHECK FOR TRACK OVERFLOW + SZA CLA + JMP RKTKOV + ISZ RKCNT /SOME OTHER ERROR - BADNESS [SIC] + JMP RKOK /TRY AGAIN + JMP RKBAD /3 TRIES IS ENOUGH +RKOK, DRDS /READ STATUS REGISTER + AND L40 /TRACK SEEK ERROR? + DCLS /CLEAR STATUS REGISTER + SNA CLA + JMP RKBACK + DCLA /YES - RECALIBRATE + DSKD /WAIT 'TILL DONE + JMP .-1 +RKBACK, CLL STA RTL /-3 + TAD RK8 + DCA RK8 /POINT BACK TO FUNCTION WORD + JMP RKRETRY /GO TRY AGAIN + +RKTKOV, DCLS /CLEAR STATUS REGISTER + DRDA /READ TRACK ADDRESS STUFF + AND L7760 /ISOLATE JUST TRACK (NEEDED ??) + TAD L20 /BUMP TRACK NUMBER BY 1 + JMP RKINST /GO BACK AND CONTINUE TRANSFER +LCIFCDF,CIF CDF 0 +LDLDR, DLDR +L40, 40 +RKCNT, 0 +RKANO, 0 +/ MUST NOT GO INTO LOCATION 7744 + IFZERO .&177-145&4000 + $ diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/SRCCOM.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/SRCCOM.PA new file mode 100644 index 0000000..ef99e80 --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/SRCCOM.PA @@ -0,0 +1,1043 @@ +/1 OS8 SOURCE COMPARE (SRCCOM) +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1972,1973,1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + /LAST EDITED 4/28/77 +/ +/ +/COPYRIGHT 1973,1977 +/DIGITAL EQUIPMENT CORPORATION +/MAYNARD, MASS. 01754 +/ +/PDP-8 SOURCE COMPARISON PROGRAM +/STOLEN FROM PDP-10 SRCCOM BY R. LARY + +VERSION= 4 /CHANGE EVERY MAJOR EDIT +PATCH="A + + IFNDEF CORE + MPARAM=7643 /COMMAND DECODER PARAMETER BLOCK + + IFZERO CORE-2 + IFZERO CORE-4 + BUFLIM=FBLOCK-1001 /END OF LINE BUFFER + INBUF=FBLOCK-1000 /INPUT BUFFER + /SRCCOM FIELD 0 PAGE 0 + + FIELD 0 + + XR=10 + + *20 +SCT, 0 /TEMPORARY +OFILNM, ZBLOCK 4 /OUTPUT FILE NAME +IFPTR, 0 /TEMPORARY +SETUP1, NOPUNCH + *7556 /JAM PARAMETERS UP AGAINST TOP OF USER CORE +FBLOCK, ENPUNCH + +/LAYOUT OF FILE PARAMETER TABLE +/THERE IS A COPY OF THIS TABLE IN FIELDS F1 AND F2. EACH COPY +/CONTAINS ALL THE INFORMATION ABOUT THE FILE WHOSE BUFFERS +/ARE IN THE SAME FIELD + + +PGNUM, 1 /CURRENT INPUT PAGE +CURLIN, 0 /CURRENT LINE (IN LINE BUFFER) +TOPLIN, 0 /NUMBER OF LINES IN LINE BUFFER +TMPLIN, 0 /TEMPORARY STORAGE FOR "CURLIN" +OLDLIN, 1 /LINE OPTIMIZATION COUNTER +OLDPTR, LNBEG /LINE OPTIMIZATION POINTER + /THE NEXT SEVERAL WORDS ARE A SUBROUTINE + /WHICH READS A BUFFER IN FROM THE INPUT FILE +INTEMP, 0 /SHIFT REGISTER FOR "GCHAR" ROUTINE + CIF 0 + JMS I INHNDL +INCHCT, 7777 /COUNT OF CHARACTERS IN BUFFER +INPTR, 0 /POINTS TO CURRENT WORD IN BUFFER +INREC, 0 /CONTAINS CURRENT INPUT RECORD + ISZ INTEMP /SUBROUTINE SKIPS ON INPUT ERROR + CIF 10 + JMP I INTEMP +INHNDL, 0 /POINTS TO ENTRY POINT OF INPUT HANDLER + +INEOF, 0 /END-OF-FILE INDICATOR +INRCNT, 0 /COUNT OF RECORDS REMAINING IN THIS FILE + IFNZRO .-7600 <_ERROR_> + *SETUP1+.-FBLOCK/PUT ASSEMBLER LOCATION COUNTER BACK + SETUP2=. + + + /CORE ALLOCATION FOR 8K SYSTEM + +/ FIELD 0 +/ +/0000-0377 CONTROL CODE +/0400-0777 INPUT HANDLER 1 +/1000-1377 INPUT HANDLER 2 +/1400-1777 OUTPUT HANDLER +/2000-6555 FILE 1 LINE BUFFER +/6556-7555 FILE 1 INPUT BUFFER +/7556-7577 FILE 1 CONTROL BLOCK +/ +/ FIELD 1 +/ +/0000-1377 SRCCOM PROPER +/1400-1777 OUTPUT BUFFER +/2000-6555 FILE 2 LINE BUFFER +/6556-7555 FILE 2 INPUT BUFFER +/7556-7577 FILE 2 CONTROL BLOCK +/ +/ +/ FORMAT OF LINE BUFFER: +/ THE LINE BUFFER CONSISTS OF SOURCE LINES. THE FIRST WORD +/ OF EACH LINE IS A LENGTH WORD GIVING THE LENGTH OF THE +/ LINE (INCLUDING THE LENGTH WORD ITSELF) AS A POSITIVE +/ NUMBER. THE NEXT WORD IS THE NUMBER OF THE SOURCE PAGE +/ ON WHICH THIS LINE WAS FOUND. SUBSEQUENT WORDS CONTAIN THE +/ CHARACTERS OF THE LINE ITSELF, PACKED ONE PER WORD. + + +NODFMS, "N;"O;" ;"D;"I;"F;"F;"E;"R;"E;"N;"C;"E;"S;0 + SETUP, 0 /ROUTINE TO SET UP FILE PARAMETERS + TAD [SETUP1-SETUP2 + DCA SCT + TAD [TAD SETUP1 + DCA INST2 + TAD [FBLOCK-1 + DCA XR +INST2, HLT /MOVE THE SKELETON PARAMETER BLOCK + DCA I XR /UP INTO THE DESIRED FIELD + ISZ INST2 + ISZ SCT + JMP INST2 + RDF + TAD [6201 + DCA SETCDF /SAVE FIELD NUMBER + CDF 10 + TAD I IFPTR + CDF 0 + SNA + JMP I [INERR1 /NO INPUT FILE - BAD + CIF 10 + JMS I [200 /ASSIGN DEVICE HANDLER + 1 +DVPAGE, 0 + HLT /NEVER HOPPEN + CDF 10 + TAD I IFPTR + AND [7760 /COMPUTE FILE LENGTH + SZA + TAD [17 + CLL CML RTR + RTR + DCA SCT /SAVE IT AWAY TEMPORARILY + ISZ IFPTR + TAD I IFPTR +SETCDF, HLT /RESET DATA FIELD + DCA I [INREC /SAVE STARTING BLOCK NUMBER + TAD SCT + DCA I [INRCNT /SAVE FILE LENGTH + TAD DVPAGE + DCA I [INHNDL /SAVE DEVICE HANDLER ENTRY POINT + ISZ IFPTR + JMP I SETUP /RETURN + *200 /INITIALIZATION CODE +SRCCOM, ISZ NOCHN + CIF 10 + JMS I [7700 + 10 /BRING USR INTO CORE +SRCCD, TAD NOCHN /HAVE WE BEEN CHAINED TO? + SNA CLA + JMP NOSRCD /YES + CIF 10 + JMS I [200 + 5 /COMMAND DECODE + 0 /NO DEFAULT EXTENSIONS +NOSRCD, TAD [7617 + DCA IFPTR /SET IFPTR POINTING TO FILE 1 + TAD [401 + DCA DVPAGE /FILE 1 HANDLER GOES IN 400-777 + CDF F1 + JMS SETUP /SET UP FILE 1 PARAMETER AREA + TAD [1001 + DCA DVPAGE /FILE 2 HANDLER GOES INTO 1000-1377 + CDF F2 + JMS SETUP /SET UP FILE 2 PARAMETER AREA + TAD [1401 + DCA OUPAGE /OUTPUT HANDLER GOES INTO 1400-1777 +GTOUHN, CDF 10 + TAD I [7600 /GET OUTPUT DEVICE # + CDF 0 + SZA /IS THERE ONE? + JMP ASSOUT + DCA TTYNO + CIF 10 /NO - LOOK UP "TTY" + JMS I [200 + 12 /INQUIRE + 5524 /=2424+3100 = TTY +TTYNO, 0 + 0 + JMP OUERR1 /NO TELETYPE + TAD TTYNO + CDF 10 + DCA I [7600 + JMP GTOUHN /BACK TO GET IT AGAIN +ASSOUT, CIF 10 + JMS I [200 + 1 +OUPAGE, 0 + JMP OUERR1 + TAD [-4 + DCA SCT + TAD [7600 + DCA XR + TAD [DCA OFILNM + DCA INST1 + CDF 10 /MOVE OUTPUT FILE NAME INTO FIELD 0 + TAD I XR +INST1, HLT + ISZ INST1 + ISZ SCT + JMP INST1-1 + TAD PFILNM + DCA ORCNO /SET UP ENTER + TAD OFILNM+3 + SNA + TAD [1423 /ASSUMED OUTPUT EXTENSION = .LS + DCA OFILNM+3 + TAD I [7600 + CDF 0 + CIF 10 + JMS I [200 + 3 +ORCNO, 0 /POINTS TO FILE NAME +OLEN, 0 + JMP OUERR1 + CIF 10 + JMS I [200 + 11 /KICK USR OUT OF CORE + DCA OCOUNT + CDF CIF 10 + TAD ORCNO + DCA I [OUREC + TAD OUPAGE + JMP I .+1 + SRCOPT /GO SET UP OPTION SWITCHES AND COMPARE + OCLOSE, CIF 10 + JMS I [7700 + 10 /GET USR INTO CORE + CDF CIF 10 + TAD I [7600 /GET OUTPUT DEVICE NUMBER + CDF 0 + JMS I [200 + 4 /CLOSE OUTPUT FILE +PFILNM, OFILNM +OCOUNT, 0 /COUNT OF BLOCKS WRITTEN + JMP OUERR1 /ERROR ON CLOSE +SRCATS, ISZ NOCHN /IN CASE WE LOOP, CLEAR "CHAINED TO" FLAG + CDF 10 + TAD I [MPARAM-1 /GET ALTMODE FLAG + CDF 0 + SPA CLA + JMP I [7605 /GO AWAY IF ALTMODE + JMP SRCCD /GO BACK FOR MORE + +NOCHN, 0 + +INERR1, RDF + CLL RTR + RAR + TAD [-4 +OUERR1, TAD [4005 +NOROOM, TAD [260 + DCA SETUP + TAD [277 + JMS TYPE /OUTPUT "?N" WHERE N IS THE ERROR NUMBER + TAD SETUP + JMS TYPE + TAD [215 + JMS TYPE + TAD [212 + JMS TYPE + TAD SETUP + SPA CLA /IS THE USR IN CORE? + JMP SRCATS /YES - DON'T LOAD IT + CIF 10 + JMS I [7700 /NO - LOAD IT + 10 + JMP SRCATS + +TYPE, 0 + TLS + TSF + JMP .-1 + CLA + JMP I TYPE + / PAGE 0 LITERALS + FIELD 1 + /PAGE 0 FOR SRCCOM + + *0 +T1, 0 +T2, 0 +T, 0 +CT, 0 + + XR1=11 + XR2=12 + + *20 + +/*************** SRCCOM SWITCHES *************** + +CSW, 0 /"C" SWITCH - ON=-257, MEANING IGNORE COMMENTS + / OFF=+521, MEANING COMPARE COMMENTS +SSW, 0 /"S" SWITCH - ON=-240, MEANING IGNORE SPACES & TABS + / OFF=-200, MEANING COMPARE SPACES&TABS +TSW, 0 /"T" SWITCH - ON=20 , MEANING CONVERT TABS ON OUTPUT + / OFF=0 , MEANING PRINT TABS ON OUTPUT +XSW, 0 /"X" SWITCH - ON=1 , MEANING DON'T INPUT COMMENTS + / OFF=0 , MEANING INPUT COMMENTS INTO CORE +ALLSW, 0 /"B" SWITCH - ON=2000, MEANING COMPARE BLANK LINES + / OFF=0 , MEANING IGNORE BLANK LINES +NUMLIN, 0 /NUMERICAL ARGUMENT - NUMBER OF LINES CONSTITUTING + /A MATCH - SET TO -3 IF NO NUMERICAL ARGUMENT + +MLIMIT, 0 +GETCNT, 0 +GETFIL, 0 +CHAR, 0 +IPTR, 0 +NUMTMP, 0 +PLNCNT, 0 +PNTPGN, 0 +OUHNDL, 0 /THESE 5 WORDS ARE USED BY OUTPUT ROUTINE +OUCHCT, 0 +OUPTR, 0 +OUXPTR, 0 +OUTEMP, 0 +TABCT, 0 +DIFFS, 0 /DIFFERENCES FOUND FLAG + +CTCCHK, 0 + TAD [200 + KRS /GET A CHAR FROM THE TELETYPE + TAD [-203 /CHECK FOR EITHER PARITY ^C + SNA CLA + KSF /WITH THE KEYBOARD FLAG UP + JMP I CTCCHK /NOPE + CDF CIF 0 /YUP - RETURN TO OS/8 + JMP I [7600 + PAGE + +SETONE, 0 /ROUTINE TO FIND WHERE A LINE IS + TAD I [CURLIN /GET LINE NUMBER + DCA TLNNUM /SAVE IT AWAY + TAD I [OLDPTR /GET THE POINTER TO THE LATEST LINE +SETOPT, DCA T /SAVE THE STARTING POINTER + TAD TLNNUM /GET THE TARGET LINE + CMA CLL + TAD I [OLDLIN /IS IT BEFORE OR AFTER THE LATEST LINE? + SZL + JMP SETRST /BEFORE - WE MUST START SEARCHING FROM LINE 1 + DCA CT /AFTER - START SEARCHING FROM LATEST LINE +TLOOP, ISZ CT + JMP KEEPON /NOT THERE YET + TAD TLNNUM /WE FOUND IT - MAKE THIS LINE + DCA I [OLDLIN /THE NEW "LATEST LINE" + TAD T /TO SPEED UP + DCA I [OLDPTR /FUTURE SEARCHES. + CLA CMA + TAD T + JMP I SETONE /RETURN POINTER FOR AUTO-XR +KEEPON, TAD I T + TAD T /ADD LENGTH OF THIS LINE TO POINTER + DCA T /TO GET POINTER TO NEXT LINE + JMP TLOOP +TLNNUM, 0 /TEMPORARY FOR SETONE - DO NOT USE ANYWHERE ELSE + +SETRST, CLA IAC /RESET THE "LATEST LINE" POINTERS TO THE FIRST + DCA I [OLDLIN /LINE, SINCE THE LINE WE SEEK IS BEFORE + TAD [LNBEG /THE CURRENT "LATEST LINE" + JMP SETOPT /GO BACK AND FIND THE LINE + MOVEUP, 0 /SUBR TO DELETE LINES FROM CORE + TAD I [CURLIN /GET FIRST LINE NOT TO BE DELETED + CIA + TAD I [TOPLIN + DCA I [TOPLIN /REDUCE THE NUMBER OF LINES IN THE BUFFER + TAD I [TOPLIN /GET NEW LINE COUNT + SNA /IF ALL LINES DELETED, DON'T MOVE CORE + JMP MOVXIT /JUST CLEAN UP AND GET OUT + IAC + JMS SETONE /GET POINTER TO LAST LINE+1 + CIA + DCA MLIMIT /SAVE AS LIMIT ON MOVE + IAC + JMS SETONE /GET POINTER TO THE FIRST LINE NOT TO DELETE + DCA XR1 + TAD [LNBEG-1 + DCA XR2 +MLOOP, TAD I XR1 + DCA I XR2 /AREN'T AUTO-XRS WONDERFUL + TAD XR1 + TAD MLIMIT /(ACTUALLY, NO) + SZA CLA + JMP MLOOP +MOVXIT, CLA IAC /AFTER MOVING CORE AROUND, WE MUST + DCA I [OLDLIN /RESET THE "LATEST LINE" POINTERS TO THE FIRST + TAD [LNBEG /LINE SINCE IT IS THE ONLY ONE WHICH + DCA I [OLDPTR /HAS A KNOWN POSITION. + JMP I MOVEUP + COMPL, 0 /SUBROUTINE TO COMPARE TWO LINES + CDF F1 + JMS SETONE /GET POINTER TO CURRENT LINE IN FILE 1 + TAD [2 /SKIP OVER PROLOGUE + DCA XR1 + CDF F2 + JMS SETONE /GET POINTER TO CURRENT LINE IN FILE 2 + TAD [2 /SKIP OVER PROLOGUE + DCA XR2 +COMP1, CDF F1 + TAD I XR1 /GET A CHAR FROM FILE 1 + DCA T1 +COMP2, CDF F2 + TAD I XR2 + DCA T2 /AND A CHAR FROM FILE 2 +COMP0, TAD T2 + CIA + TAD T1 + SZA CLA /ARE THEY EQUAL? + JMP COMP4 /NO +COMP5, TAD T1 + SZA + TAD CSW /IF AT END OF LINE, OR IF AT A "/" + SZA CLA /AND "IGNORE COMMENTS" SWITCH ON, + JMP COMP1 + JMP I COMPL /TAKE "LINES MATCH" RETURN + +COMP3, CDF F1 + TAD I XR1 /GET THE NEXT CHAR FROM FILE 1 + DCA T1 +COMP4, TAD T1 + TAD SSW /IF T1 IS A BLANK OR A TAB + SZA + TAD [27 /(27=BLANK-TAB) + SNA CLA /AND WE ARE IGNORING BLANKS, + JMP COMP3 /THEN IGNORE T1 + TAD T2 + TAD SSW /DO THE SAME WITH T2 + SZA + TAD [27 + SNA CLA + JMP COMP2 + TAD T1 + CIA + TAD T2 /NOW THAT WE HAVE (MAYBE) ELIMINATED BLANKS + SNA CLA /ARE T1 AND T2 STILL UNEQUAL? + JMP COMP5 /NO - THERE'S STILL HOPE + TAD T1 /YES - NOW TEST COMMENT SWITCH + CMA + AND T2 + TAD CSW /IF T1 IS A CARRIAGE RETURN AND T2 IS A "/" + SNA CLA /WITH THE COMMENT SWITCH ON WE'VE SUCEEDED + JMP I COMPL /SO TAKE "LINES MATCH" RETURN + TAD T2 + CMA + AND T1 /SAME IF T2=CARRIAGE RETURN AND T1="/" + TAD CSW + SZA CLA + ISZ COMPL /OTHERWISE TAKE "LINES DON'T MATCH" RETURN + JMP I COMPL + +GETTWO, 0 /SUBROUTINE TO GET A LINE FROM EACH FILE + CLA CLL CMA RTL + DCA GETCNT + DCA GETFIL /ZERO INDICATOR AS TO WHICH FILE IS NULL + CDF F1 + JMS I [GLINE /GET A LINE FROM FILE 1 + CDF F2 + JMS I [GLINE /DITTO FILE 2 + ISZ GETCNT /HOW MANY LINES DID WE GET? + JMP I GETTWO /LESS THAN TWO - TAKE EOF RETURN + ISZ GETTWO + JMP I GETTWO /TAKE NORMAL RETURN + + PAGE + GLINE, 0 /SUBROUTINE TO GET A LINE FROM A FILE + TAD I [CURLIN + CIA + TAD I [TOPLIN + SZA CLA /IS THE LINE IN CORE? + JMP GLEXIT /YES + CLA IAC + JMS I [SETONE /GET POINTER TO THIS LINE + DCA XR1 + CLA CLL CML RTL + DCA I XR1 /SET WORD COUNT TO 2 + TAD XR1 + DCA T /SAVE POINTER TO LENGTH WORD + JMS CTCCHK /CHECK FOR ^C TYPED + ISZ XR1 +GLINE2, JMS GCHAR /MAIN LOOP - GET A CHARACTER + JMS I [TSTXSW /SEE WHETHER WE SHOULD INPUT COMMENTS + CLA CLL CMA RAL + TAD CHAR + TAD ALLSW /IF THE CHAR IS A CARRIAGE RETURN AND THE + TAD I T /"B" SWITCH IS OFF AND THE LINE COUNT IS 2, + SNA CLA /THEN WE SHOULD IGNORE THIS BLANK LINE. + JMP GLINE2 + TAD CHAR + DCA I XR1 /SALT IT AWAY + TAD XR1 + CLL + TAD [4-BUFLIM /COMPARE AGAINST END OF BUFFER + SNL CLA + JMP .+3 + CDF CIF 0 /LINE OVERFLOWS CORE - BAD! + JMP I [NOROOM /TELL THE WORLD + ISZ I T /BUMP COUNTER OF WORDS IN LINE + TAD CHAR + SZA CLA /WAS IT A CARRIAGE RETURN? + JMP GLINE2 /NO + ISZ I [TOPLIN /YES - BUMP COUNT OF LINES IN CORE + ISZ T + TAD I [PGNUM + DCA I T +GLEXIT, ISZ GETCNT /BUMP COUNTER OF # OF LINES GOTTEN + RDF + TAD [6201 + DCA GETFIL /INDICATE THAT THIS FILE WAS NOT NULL + ISZ I [CURLIN /BUMP CURRENT LINE POINTER + JMP I GLINE + GCHAR, 0 /SUBROUTINE TO GET A CHAR FROM A FILE + TAD I [INPTR + DCA IPTR /SAVE POINTER TO CURRENT BUFFER WORD + ISZ I [INCHCT /BUMP CHAR COUNTER + JMP GETIN + TAD I [INEOF /END OF BUFFER + SZA CLA /END OF FILE?? + JMP GEOF+1 /YES + CLA CLL CML RTL + TAD I [INRCNT /BUMP COUNT OF REMAINING RECORDS BY 2 + SZL /OVERFLOW? + ISZ I [INEOF /YES - SET END OF FILE FLAG + SNL + DCA I [INRCNT /RESTORE COUNTER IF NO OVERFLOW + CLL CMA CML RTL + RTL + RTL + TAD [401 /COMPUTE INPUT CONTROL WORD + RDF + DCA I [INCHCT + TAD [INBUF + DCA I [INPTR /PUT BUFFER ADDRESS INTO CALLING SEQUENCE + RDF + TAD [6203 + DCA .+1 + NOP /SET INSTRUCTION FIELD TO DATA FIELD + JMS I [INTEMP /CALL SUBR TO READ IN BUFFER + JMP .+4 /NO ERROR + SPA CLA /FATAL ERROR? + JMP I [INERR /YES + ISZ I [INEOF /NO - SET END OF FILE FLAG + ISZ I [INREC + ISZ I [INREC /BUMP RECORD NUMBER BY 2 + TAD [10 + DCA I [INTEMP /INITIALIZE SHIFT REGISTER + TAD I [INCHCT + CLL RAL + TAD I [INCHCT + AND [7600 + CMA + DCA I [INCHCT /COMPUTE CHAR COUNT FROM BUFFER CONTROL WD + JMP GCHAR+1 /START ALL OVER WITH NEW BUFFER + GETIN, TAD I [INTEMP + SPA /IF WE HAVE A CHAR IN THE SHIFT BUFFER + DCA I IPTR /WRITE OVER THE CURRENT BUFFER WORD WITH IT + DCA I [INTEMP /AND ZERO THE SHIFT BUFFER + TAD I IPTR /GET THE CURRENT BUFFER WORD + AND [7400 + CLL RAL + TAD I [INTEMP + RTL /SHIFT THE HIGH ORDER 4 BITS + RTL /INTO THE SHIFT BUFFER + SMA /DID WE GET A COMPLETE CHARACTER? + ISZ I [INPTR /NO - BUMP WORD POINTER + DCA I [INTEMP + TAD I IPTR + AND [177 /USE LOW ORDER 7 BITS OF THE CURRENT WORD + SZA /AS THE CHARACTER + TAD [-177 /IGNORING BLANK TAPE, RUBOUTS, LINE-FEEDS + SZA /AND VERT. TABS + TAD [177-13 + SZA + IAC + SNA + JMP GCHAR+1 + TAD [12-14 + SNA + JMP FFEED /FORM FEED IS SPECIAL + TAD [14-32 + SNA + JMP GEOF /^Z SIGNIFIES END-OF-FILE + TAD [32-15 + SZA + TAD [215 /AND CARRIAGE RETURN IS MAPPED INTO 0 + DCA CHAR + JMP I GCHAR + +FFEED, ISZ I [PGNUM /BUMP THE PROPER PAGE COUNT ON A FORM FEED + JMP GCHAR+1 /BUT OTHERWISE IGNORE IT + +GEOF, ISZ I [INEOF /SET END-OF-FILE FLAG + CLA CMA + DCA I [INCHCT /FORCE AN EMPTY BUFFER + JMP I GLINE /RETURN FROM GLINE WITHOUT SETTING GETFIL + + PAGE + / INITIALIZATION +STARTC, JMS I [OUSETP /INITIALIZE OUTPUT BUFFER POINTERS + CLA IAC + DCA PNTPGN /FUDGE PNTPGN WHILE PRINTING HEADER LINES + TAD [HEDING-1 + JMS I [PNTHDG /PRINT SRCCOM HEADING LINE + JMS I [GETTWO /GET TITLE LINES + JMP FINISH /ONE FILE IS EMPTY - ABORT COMPARISON + CDF F1 + JMS I [PNTTXT /PRINT FILE 1 HEADER + CDF F2 + JMS I [PNTTXT /AND FILE 2 HEADER + DCA PNTPGN /INITIALIZE PAGE NUMBER + STA + DCA DIFFS /INITIALIZE FLAG TO NO DIFFERENCES + +/ MAIN LOOP + +MAIN, CDF F1 + JMS I [MOVEUP + CDF F2 + JMS I [MOVEUP /DELETE ANY USELESS LINES +MAINST, CDF F1 + DCA I [CURLIN + CDF F2 + DCA I [CURLIN + JMS I [GETTWO /GET TWO INPUT LINES + JMP MAIN15 /ONE FILE IS EMPTY + JMS I [COMPL /COMPARE THE LINES + JMP MAIN /EQUAL - DELETE AND CONTINUE + DCA DIFFS /UNEQUAL - CLEAR "NO DIFFERENCES" FLAG + +MAIN10, JMS I [GETTWO /GET TWO MORE LINES + JMP MAIN15 /ONE FILE RAN OUT + CDF F1 + DCA I [CURLIN /INITIALIZE FILE 1 LINE NO. +MAIN12, ISZ I [CURLIN /BUMP TO NEXT LINE IN FILE 1 + JMS I [COMPL /COMPARE NEW LINE FROM FILE 2 + JMS MULTI /WITH THIS LINE FROM FILE 1 + CDF F2 /AND IF MATCH IS FOUND CHECK MULTIPLE LINES + TAD I [CURLIN + CIA + CDF F1 + TAD I [CURLIN + SZA CLA /THROUGH WITH FILE 1 LINES? + JMP MAIN12 /NO + CDF F2 + CLA IAC + DCA I [CURLIN /NOW INITIALIZE FILE 2 LINE NO. +MAIN14, TAD I [CURLIN + CIA + CDF F1 + TAD I [CURLIN + SNA CLA /HAVE WE EXHAUSTED FILE 2 LINES? + JMP MAIN10 /YES - NO MATCH AT ALL + JMS I [COMPL /NO - COMPARE ALL FILE 2 LINES + JMS MULTI /AGAINST NEW FILE 1 LINE + CDF F2 /AND, IF MATCH, CHECK MULTIPLE LINES + ISZ I [CURLIN /GO TO NEXT FILE 2 LINE + JMP MAIN14 /AND LOOP + +MAIN15, TAD GETFIL + SNA /FIND WHICH FILE WAS EMPTY + JMP FINISH /BOTH - ALL DONE + DCA MAIN18 + CDF F1 + TAD I [CURLIN + CDF F2 + SZA CLA + TAD I [CURLIN + SNA CLA /IS EITHER FILE EXHAUSTED IN CORE? + JMP MAIN18 /YES - PRINT ALL OF OTHER FILE + TAD MAIN18 /GET CDF OF LONG FILE + CIA + TAD [4402+F1+F2 /COMPUTE CDF OF SHORT FILE + DCA MAIN17 +MAIN17, NOP + TAD I [CURLIN + CMA CLL + TAD I [TOPLIN + SNL CLA /IS CURLIN < TOPLIN? + JMP MAIN10 /NO - WE STILL HAVE SOME COMPARING TO DO + ISZ I [CURLIN + JMS I [COMPL + JMS MULTI + JMP MAIN17 + +MAIN18, NOP /SET DF TO DATA FIELD OF LONG FILE + JMS I [PNTTXT /PRINT IT + JMP MAIN + +FINISH, CDF F1 + TAD I [CURLIN + CDF F2 + TAD I [CURLIN + SZA CLA /ARE BOTH CORE BUFFERS EMPTY? + JMS I [PNTBTH /NO - PRINT THEM + JMP I [EOCOMP + / MULTI-LINE COMPARATOR +MULTI, 0 + CDF F1 + TAD I [CURLIN + DCA I [TMPLIN + CDF F2 + TAD I [CURLIN + DCA I [TMPLIN /STORE CURLIN AWAY IN A TEMPORARY + TAD NUMLIN + DCA NUMTMP /GET COUNT OF LINES TO COMPARE + JMP MULT6 + +MULT2, JMS I [GETTWO /GET TWO LINES + JMP MULT4 /ONE FILE HAS NO MORE + JMS I [COMPL /COMPARE THEM + JMP MULT6 /THEY COMPARE - KEEP GOING +MULT4, JMS SWAPCT /RESET OLD CURLIN + JMP I MULTI +MULT6, ISZ NUMTMP /LINE COUNT EXHAUSTED? + JMP MULT2 /NO - KEEP COMPARING + JMS SWAPCT /RESTORE OLD CURLIN + JMS I [PNTBTH /PRINT OUT DIFFERENCES + TAD [-10 + JMS I [PNTAST /PRINT OUT SEPARATOR + JMS SWAPCT /RE-SWAP FOR DELETION + JMP MAIN /DELETE THRU MATCHING LINES AND CONTINUE + +SWAPCT, 0 + CDF F1 + JMS SWAPX /SWAP CURLIN AND TMPLIN FOR FILE 1 + CDF F2 + JMS SWAPX /DITTO FOR FILE 2 + JMP I SWAPCT +SWAPX, 0 + TAD I [CURLIN + DCA NUMTMP + TAD I [TMPLIN + DCA I [CURLIN + TAD NUMTMP + DCA I [TMPLIN + JMP I SWAPX + + PAGE + PNTBTH, 0 /PRINT BOTH TEXT BUFFERS + TAD [212 + JMS I [OCHAR /SEPARATOR + CDF F1 + JMS PNTTXT /PRINT FILE 1 BUFFER + TAD [-4 + JMS PNTAST /PRINT SEPARATOR + CDF F2 + JMS PNTTXT /PRINT FILE 2 BUFFER + TAD [212 + JMS I [OCHAR /SEPARATOR + JMP I PNTBTH + +PNTTXT, 0 /PRINT A TEXT BUFFER + TAD I [CURLIN + CIA + DCA PLNCNT /GET # OF LINES TO PRINT +PNTLP, DCA TABCT /ZERO TAB COUNTER (IN CASE "T" SW ON) + RDF + CLL RTR + RAR /GET FILE NUMBER + TAD [261 /260 FOR 12K VERSION + JMS I [OCHAR + TAD [251 + JMS I [OCHAR /PRINT RPAR + TAD PLNCNT + IAC + JMS I [SETONE /GET POINTER TO LINE + IAC + DCA XR1 + TAD I XR1 /GET THE PAGE NUMBER OF THE LINE + DCA T + TAD T + CIA + TAD PNTPGN + SNA CLA /DID THE PAGE NUMBER JUST CHANGE? + JMP PNTTAB /NO - DON'T PRINT IT + TAD TENTAD + DCA PNTTAD + TAD T + DCA PNTPGN /UPDATE THE CURRENT PAGE NUMBER + CLA CLL CMA RTL + DCA CT /PRINT 3 DECIMAL DIGITS +DIGLP1, DCA T1 + JMP .+3 +DIGLP2, DCA T + ISZ T1 + TAD T +PNTTAD, HLT /ADD IN A POWER OF 10 + SMA + JMP DIGLP2 /KEEP GOING +PN7200, CLA + ISZ PNTTAD /GOT A DIGIT - GO TO NEXT POWER OF 10 + TAD T1 + TAD [260 + JMS I [OCHAR /PRINT DIGIT + ISZ CT /THROUGH? + JMP DIGLP1 /NO +PNTTAB, TAD TSW + SNA CLA /SHOULD WE SIMULATE TABS? + JMP PNTCHR /NO + TAD [240 /YES - PRINT A BLANK + JMS I [OCHAR + TAD TABCT + AND [7 + SZA CLA /KEEP PRINTING BLANKS UNTIL WE REACH A MULTIPLE OF + JMP PNTTAB /EIGHT COLUMNS. +PNTCLP, TAD I XR1 /GET A CHARACTER FROM THE LINE + SNA /END? + JMP PNTCR /YES + TAD [-211 + SNA /IS IT A TAB? + JMP PNTTAB /YES +PNTCHR, TAD [211 /NO - RESTORE THE CHAR + JMS I [OCHAR + JMP PNTCLP /PRINT IT AND LOOP +PNTCR, TAD [215 /PRINT CRLF + JMS I [OCHAR + TAD [212 + JMS I [OCHAR + ISZ PLNCNT + JMP PNTLP /LOOP FOR EACH LINE IN BUFFER + JMP I PNTTXT + PNTAST, 0 /ROUTINE TO PRINT ASTERISKS + DCA CT /SAVE COUNTER + TAD ["* + JMS I [OCHAR + ISZ CT + JMP .-3 /PRINT REQUIRED NUMBER OF ASTERISKS + TAD [215 + JMS I [OCHAR /TERMINATE THE LINE + TAD [212 + JMS I [OCHAR + DCA PNTPGN /KILL CURR. PAGE NUMBER + JMP I PNTAST + +EOCOMP, ISZ DIFFS /ANY DIFFERENCES? + JMP .+4 /YES + CDF 0 /MESSAGE IN FIELD 0 + TAD [NODFMS-1 + JMS I [PNTHDG /NO - PRINT MESSAGE + TAD PN7200 /ROUTINE TO FINISH UP OUTPUT + DCA CT + TAD [214 + JMS I [OCHAR /TERMINATE THE OUTPUT FILE + TAD [232 /WITH A FORM FEED AND A ^Z + JMS I [OCHAR + ISZ CT + JMP .-2 /FILL WITH ZEROS TO FORCE BUFFER OUT + CDF CIF 0 + JMP I .+1 /GO TO FIELD 0 TO FINISH UP AS WE WILL BE + OCLOSE /OVERLAYED BY THE USR DURING THE CLOSE + +TENTAD, TAD .+1 /TABLE OF POWERS OF TEN + -144 + -12 + -1 + +INERR, RDF /INPUT ERROR - ERROR NUMBER=FILE NUMBER + CLL RTR + RAR + IFZERO CORE-2 + IFZERO CORE-4 + CDF CIF 0 + JMP I [NOROOM /GO TO COMMON ERROR ROUTINE + +PNTHDG, 0 /ROUTINE TO PRINT A LITERAL LINE + DCA XR1 /POINTER TO LINE IN AC + TAD PNTHDG + DCA PNTTXT /WE WORK BY FAKING OUT PNTTXT + STA + DCA PLNCNT /SET LINE COUNTER TO 1 + JMP PNTCLP + + PAGE + OCHAR, 0 /LOW LEVEL OUTPUT ROUTINE + AND [377 + DCA OUTEMP + ISZ TABCT /BUMP TAB COUNTER + RDF + TAD [6201 + DCA OCDF + CDF 10 + TAD OUCHCT /GET CHAR COUNTER - CHAR COUNTER COUNTS + RTR /FOUR TIMES FOR EACH THREE CHARACTERS. + CML /WHEN THE LOW ORDER BITS OF THE COUNT ARE 10, + SZL SPA CLA /ITS TIME TO SQUEEZE A CHAR INTO THE HIGH + JMP OUNORM /ORDER BITS - OTHERWISE JUST STORE IT + ISZ OUCHCT /WE MUST SQUEEZE - BUMP OUCHCT AN EXTRA + TAD OUTEMP /TIME + RTL + RTL + AND [7400 + TAD I OUXPTR /FIRST WORD OF DOUBLET + DCA I OUXPTR + TAD OUTEMP + RTR + RTR + RAR + AND [7400 + TAD I OUPTR /SECOND WORD OF DOUBLET + JMP OUCOMN + +OUNORM, TAD OUPTR + DCA OUXPTR /REMEMBER LAST WORD + ISZ OUPTR + TAD OUTEMP +OUCOMN, DCA I OUPTR + ISZ OUCHCT /BUMP CHAR COUNT + JMP OCDF /RETURN + CIF 0 /CHAR COUNT OVFLO - OUTPUT BUFFER + JMS I OUHNDL + 4210 + 1400 +OUREC, 0 + JMP OUERR2 + JMS OUSETP /INITIALIZE FOR NEXT BUFFER + ISZ OUREC /BUMP RECORD NUMBER + CDF 0 + ISZ I [OCOUNT /BUMP CLOSING COUNT + ISZ I [OLEN /AND LENGTH OF HOLE + JMP OCDF +OUERR2, CLL CML RTL /OUTPUT ERROR OR FILE TOO BIG - GENERATE + IAC /A 3 OR A 4 MESSAGE, RESPECTIVELY + CDF CIF 0 + JMP I [NOROOM +OCDF, HLT /RESTORE DATA FIELD + JMP I OCHAR /RETURN + OUSETP, 0 + TAD [7000 /4 COUNTS FOR 2 WORDS + DCA OUCHCT + TAD [1377 + DCA OUPTR + JMP I OUSETP + +TSTXSW, 0 /SUBROUTINE TO IGNORE COMMENTS ON INPUT + TAD CHAR /IF "X" SWITCH SET + TAD [-257 + SNA CLA + TAD XSW /IF XSW IS OFF OR THE CURRENT CHAR ISN'T A / + SNA CLA + JMP I TSTXSW /RETURN + JMS I [GCHAR + TAD CHAR /SKIP CHARACTERS UNTIL CARRIAGE RETURN + SZA CLA + JMP .-3 +TSTXLP, CLA CLL CMA RAL + TAD I T + SNA CLA /ARE WE AT THE BEGINNING OF A LINE? + JMP I TSTXSW /YES - GLINE WILL DELETE IT IF NECESSARY + TAD XR1 + DCA TX + TAD I TX + TAD [-240 + SZA /IS THE PREVIOUS CHARACTER A SPACE + TAD [240-211 + SZA CLA /OR A TAB? + JMP I TSTXSW /NO + CMA + TAD XR1 + DCA XR1 /BACK UP CHAR PTR + CMA + TAD I T + DCA I T /AND CHAR CTR + JMP TSTXLP /LOOP +TX, 0 + SRCOPT, DCA OUHNDL + TAD I [MPARAM + CMA + AND [1000 /"C" OPTION + TAD [-257 + DCA CSW + CLA CLL CML RTR + AND I [MPARAM + DCA ALLSW /"B" OPTION + TAD I [MPARAM+1 + CMA + AND [40 /"S" OPTION + TAD [-240 + DCA SSW + TAD I [MPARAM+1 + AND [20 /"T" OPTION + DCA TSW + CLA IAC + AND I [MPARAM+1 + DCA XSW /"X" OPTION + TAD I [MPARAM+3 + CIA /GET NEGATIVE OF NUMERICAL ARGUMENT + SNA + CLA CLL CMA RTL /DEFAULT VALUE IS 3 + DCA NUMLIN /TO NUMBER OF LINES NECESSARY FOR A MATCH + JMP I .+1 + STARTC + +HEDING, "S;"R;"C;"C;"O;"M;" ;"V;VERSION+"0;PATCH;212;0 + /PAGE 0 LITERALS FOR FIELD 1 + $-$-$ /END OF ASSEMBLY OF SRCCOM + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/TD8EA.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/TD8EA.PA new file mode 100644 index 0000000..5ef0b4a --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/TD8EA.PA @@ -0,0 +1,364 @@ +/4 TD8E HANDLER FOR BUILD..TD8E-A +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + *0 + -2 +DEVICE TD8A;DEVICE DTA0;4210;4010;ZBLOCK 2 +DEVICE TD8A;DEVICE DTA1;4210;4014;ZBLOCK 2 + + SDSS=6771 /SKIP ON SINGLE LINE FLAG + SDST=6772 /SKIP ON TIME ERROR + SDSQ=6773 /SKIP ON QUAD LINE FLAG + SDLC=6774 /LOAD TAPE COMMAND REGISTER + SDLD=6775 /LOAD DATA REGISTER + SDRC=6776 /READ COMMAND REGISTER + SDRD=6777 /READ DATA REGISTER + + TDVERSION="D&77 + +/V3 CHANGES: + +/1. VERSION # IS NOW 1 +/2. PARITY ^C IS NOW LEGAL +/3. ^C CHECK NO LONGER WILL ADVANCE READER + +/MAINTENANCE RELEASE CHANGES: + +/4. FIXED ^C BUG +/5. MADE CODE IMPROVEMENTS +/6. FIXED RETRY BUG + + + *200 + +NXINIT, 7600 /CLEAR AC HERE!!! + JMS I CINIT2 /PART OF INITIALIZATION..DO THE PART +BASE2, DCA JINIT /ON SECOND PAGE AND THEN TO JINIT + JMP JINIT + +BUFF, 0 +PGCT, 0 +FUNCT, 0 +C1000, 1000 + +DTA0, TDVERSION /ENTRY FOR UNIT 0 + CLA CLL + JMP DTA1X +UNIT, 0 /FILLER WORD +DTA1, TDVERSION /ENTRY FOR UNIT 1 + CLA CLL CML + TAD DTA1 + DCA DTA0 /PICK UP ARGS AT DTA0 +DTA1X, RAR + DCA UNIT /UNIT # FROM LINK + RDF + TAD C6203 + DCA LEAVE /SET UP EXIT FROM HANDLER + TAD I DTA0 + DCA FUNCT /SAVE FUNCTION WORD + TAD FUNCT + CLL RAL +C200, AND CM200 /GET A PAGE COUNT + DCA PGCT + TAD FUNCT +C374, AND C70 /ISOLATE FIELD OF TRANSFER + TAD C6203 + DCA XFIELD + ISZ DTA0 /POINT TO BUFFER + TAD I DTA0 + DCA BUFF + ISZ DTA0 /POINT TO RECORD + TAD I DTA0 + CLL RAL /CONVERT TO DECTAPE BLOCKS + DCA TBLOCK + ISZ DTA0 /POINT TO ERROR RET. +C6203, CIF CDF 0 + +JINIT, JMP INIT /FIRST TIME THRU IT GETS EXECUTED + /THE RETURN FROM INIT ZEROES IT + CLA CLL CMA RTL + DCA ERCNT /3 ERROR TRIES + TAD UNIT + DCA I CXUNIT + JMS I CSELCT /CHECK FOR SELEC ERROR + JMP .-1 /LOOPS IF NO ^C AND SELECT ERROR + TAD FUNCT + CLL RAR + JMP GO /OK.. START THE SEARCH +TRWCOM, SDST /TIME OR CHECK SUM ERROR? + SZA CLA + JMP TRY3 /YES TRY UP TO 3 TIMES + TAD PGCT /NO.. IS PAGE COUNT EXHAUSTED? + TAD CM200 + SNA + JMP EXIT /YES.. DONE THIS TRANSFER + DCA PGCT /NEW PAGE COUNT + ISZ TBLOCK + TAD BUFF + TAD C200 /GET NEW BUFFER ADDRESS + DCA BUFF + CLL CML /FORCE FORWARD MOTION +GO, CLA CML RTR /PUT IN DIRECTION BIT + TAD C1000 + TAD UNIT + SDLC /INITIATE THE MOTION + JMS I CRDQAD /WAIT FOR 8 LINES TO PASS + JMS I CRDQAD +M20, 7760 /DON'T CARE IF IT DOES SKIP!!! +TSRCH, SDSS /WAIT FOR BLOCK MARK OR END ZONE + JMP .-1 + SDRC + CLL RTL /DIRECTION TO LINK, DATA TO AC 4-9 + AND C374 /ISOLATE M.T BITS + TAD M110 /IS IT END ZONE? + SNA + JMP ENDZ /YES..DO SOMETHING REASONABLE + TAD M20 /HOW ABOUT BLOCK MARK? + SZA CLA + JMP TSRCH /NEITHER..KEEP LOOKING + SDRD /WHAT IS THIS BLOCK'S #? + SZL /IF IN REVERSE, LOOK FOR 3 BEFORE + TAD TC3 /THE ACTUAL TARGET BLOCK + CMA + TAD TBLOCK + CMA + SNA /IS THIS THE BLOCK? + JMP TFOUND /YES..HAVE CORRECT ONE +M110, SZL SNA CLA /ARE WE HEADED PROPERLY? + JMP TSRCH /YES.. KEEP LOOKING +ENDZ, SDRC /IF WE ARE IN END ZONE FORWARD, WE LOSE + CLL RTL + JMP GO /EXECUTE TURN AROUND AND SEARCH + TRY3, CLA CLL /V3C + ISZ ERCNT /TRIED 3 TIMES? + JMP GO + JMP FATAL +EXIT, ISZ DTA0 /NORMAL RETURN + CLL CML +FATAL, TAD UNIT /STOP TAPE FIRST + SDLC + CLA CML RAR /EITHER 0 OR 4000 IN AC +LEAVE, HLT /GETS CIF CDF N + JMP I DTA0 + +INIT, JMS . /FIND OUT WHERE WE GOT LOADED +BASE, TAD CRDQAD + SPA /NEGATIVE ENDS LIST + JMP NXINIT + TAD INIT + DCA CRDQAD + ISZ .-1 + ISZ BASE + JMP BASE + +CRDQAD, R4LINE-BASE +CINIT2, INIT2-BASE +CSELCT, SELECT-BASE +CXUNIT, XUNIT-BASE + + *367 +TFOUND, SZL CLA /ARE WE IN RIGHT DIRECTION + JMP GO /NOT YET + TAD FUNCT + CLL RAL /R/W TO LINK + CLA +C70, 70 +TC3, 3 + TAD BUFF +XFIELD, HLT /CONTROL 'TRICKLES THROUGH + +TBLOCK=DTA1 +ERCNT=INIT+1 +CM200=NXINIT +DTA2=DTA0 +DTA3=DTA1 +DTA4=DTA0 +DTA5=DTA1 +DTA6=DTA0 +DTA7=DTA1 + *400 + CIF 0 /WE ARE IN FIELD 0 + DCA XBUFF + RAR + DCA XFUNCT /READ/WRITE TO FUNCTION +RGRD, SDSS + JMP .-1 /LOOK FOR REVERSE GUARD PATTERN + SDRC + AND K77 + TAD CM32 + SZA CLA /IF NOT REV. GUARD, KEEP LOOKING + JMP RGRD + TAD C7600 + DCA WORDS /128 WORDS/BLOCK + TAD XFUNCT +K7700, SMA CLA /IS IT READ OR WRITE? + JMP TREAD + SDRC /CHECK FOR WRITE LOCKOUT + AND TC300 + CLL /SETUP TO RETRY IF WRITE LOCK + SZA CLA + JMP I CTRY3 /IF LOCKED OUT, ERROR + JMS R4LINE /SKIP A WORD +C7600, 7600 /CLA + TAD C1400 + TAD XUNIT + SDLC /TURN ON WRITE HEAD + CLA CMA + JMS W4LINE /7777 IN REV. CHECKSUM + CLA CMA + DCA CSUM /AND ALSO TAPE CHECKSUM +WRTLP, TAD I XBUFF + JMS W4LINE + ISZ XBUFF /INCREMENT BUFF. ADD. +K77, 77 + ISZ WORDS /DONE A BLOCK? + JMP WRTLP + JMS W4LINE /A 129 TH WORD OF 0 + JMS GCHK /GET 6 BIT CHECKSUM + JMS W4LINE /WRITE IT TO TAPE + JMS W4LINE /LET CHECK SUM FINISH + JMP I CRWCOM /SEE IF WE ARE FINISHED + +TREAD, JMS R4LINE + JMS R4LINE /SKIP CONTROL WORDS + JMS R4LINE + AND K77 /CHECKSUM + TAD K7700 + DCA CSUM +RDLP, JMS R4LINE + JMS EFUN /ADD WORD TO CHECKSUM + DCA I XBUFF + ISZ XBUFF +TC300, 300 + ISZ WORDS /DONE BLOCK? + JMP RDLP + JMS R4LINE + JMS EFUN /CHECK SUM 129 TH WORD + JMS R4LINE + AND K7700 /READ CHECKSUM + JMS EFUN + JMS GCHK /COMPARE TAPE AND OUR CHECKSUM + JMP I CRWCOM + +W4LINE, 0 /ADD TO CHECKSUM AND WRITE A 12 BIT + JMS EFUN /WORD + SDSQ + JMP .-1 /SKIP ON QUAD LINE FLAG + SDLD + CLA /AC IS NOT CLEARED AFTER SDLD + JMP I W4LINE + +R4LINE, 0 /WAIT FOR QUAD FLAG AND READ + SDSQ + JMP .-1 + SDRD + JMP I R4LINE + +EFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM + CMA + DCA ETMP /ACTUALLY CHECKSUMS ON DECTAPE ARE + TAD ETMP /EQUIVALENCE OF ALL WORDS IN A RCORD + AND CSUM /6 BITS AT A TIME. SINCE EQUIVALENCE + CIA /IS ASSOCIATIVE WE DO IT 12 AT A TIME + CLL RAL /AND CONDENSE LATER. + TAD ETMP /IDENTITIES USED ARE: + TAD CSUM /A+B=(A.XOR.B)+2*(A.AND.B) + DCA CSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B) + TAD ETMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B)) + CMA + JMP I EFUN + + GCHK, 0 /FORM 6 BIT CHECKSUM + CLA + TAD CSUM + CLL CMA RTL + RTL + RTL + JMS EFUN + CLA CLL CML + TAD CSUM + AND K7700 + JMP I GCHK + +INIT2, 0 /TIS INITIALIZES LOCS IN PAGE 2 +INIT3, TAD CTRY3 + SNA + JMP I INIT2 /0 ENDS LIST + TAD INIT2 + DCA CTRY3 /UPDATE THE LIST + ISZ .-1 + ISZ INIT3 + JMP INIT3 + +CTRY3, TRY3-BASE2 +CRWCOM, TRWCOM-BASE2 +XBUFF, 0 /0 MUST TERMINATE IT!! +CM32, -32 +C1400, 1400 + +SELECT, 0 /THIS ROUTINE CHECKS FOR SELECT + TAD XUNIT /AND ^C TYPED + SDLC + SDRC /GET STATUS AND SEE IF SELECT ERROR ON + AND C100 + SNA CLA + ISZ SELECT /NOPE .TAKE NORMAL OUT + KSF /SEE IF FLAG IS UP + JMP I SELECT /NO..EXIT + TAD C7600 + KRS + TAD (-7603 /IS IT A ^C? + SZA CLA + JMP I SELECT /NO..EXIT + JMP I C7600 + +C100, 100 + +XFUNCT=INIT2 +CSUM=XFUNCT+1 +WORDS=CSUM+1 +ETMP=WORDS+1 +XUNIT=ETMP+1 +$$$$$$$ + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/TD8EB.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/TD8EB.PA new file mode 100644 index 0000000..ac199fb --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/TD8EB.PA @@ -0,0 +1,365 @@ +/4 TD8E HANDLER FOR BUILD..TD8E-B +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + *0 + -2 +DEVICE TD8B;DEVICE DTA2;4210;4011;ZBLOCK 2 +DEVICE TD8B;DEVICE DTA3;4210;4015;ZBLOCK 2 + + SDSS=6761 /SKIP ON SINGLE LINE FLAG + SDST=6762 /SKIP ON TIME ERROR + SDSQ=6763 /SKIP ON QUAD LINE FLAG + SDLC=6764 /LOAD TAPE COMMAND REGISTER + SDLD=6765 /LOAD DATA REGISTER + SDRC=6766 /READ COMMAND REGISTER + SDRD=6767 /READ DATA REGISTER + + TDVERSION="D&77 + +/V3 CHANGES: + +/1. VERSION # IS NOW 1 +/2. PARITY ^C IS NOW LEGAL +/3. ^C CHECK NO LONGER ADVANCES READER + +/MAINTENANCE RELEASE CHANGES: + +/4. FIXED ^C BUG +/5. MADE CODE IMPROVEMENTS +/6. FIXED RETRY BUG + + + + *200 + +NXINIT, 7600 /CLEAR AC HERE!!! + JMS I CINIT2 +BASE2, DCA JINIT + JMP JINIT +CRDQAD, R4LINE-BASE +CINIT2, INIT2-BASE +CSELCT, SELECT-BASE +CXUNIT, XUNIT-BASE +BUFF, 4000 /MUST BE NEGATIVE INITIALLY + + +DTA0, TDVERSION /ENTRY FOR UNIT 0 + CLA CLL + JMP DTA1X +UNIT, 0 /FILLER WORD +DTA1, TDVERSION /ENTRY FOR UNIT 1 + CLA CLL CML + TAD DTA1 + DCA DTA0 /PICK UP ARGS AT DTA0 +DTA1X, RAR + DCA UNIT /UNIT # FROM LINK + RDF + TAD C6203 + DCA LEAVE /SET UP EXIT FROM HANDLER +JINIT, JMP INIT + TAD I DTA0 + DCA FUNCT /SAVE FUNCTION WORD + TAD FUNCT + CLL RAL +C200, AND CM200 /GET A PAGE COUNT + DCA PGCT + TAD FUNCT +C374, AND C70 /ISOLATE FIELD OF TRANSFER + TAD C6203 + DCA XFIELD + ISZ DTA0 /POINT TO BUFFER + TAD I DTA0 + DCA BUFF + ISZ DTA0 /POINT TO RECORD + TAD I DTA0 + CLL RAL /CONVERT TO DECTAPE BLOCKS + DCA TBLOCK + ISZ DTA0 /POINT TO ERROR RET. +C6203, CIF CDF 0 + + /THE RETURN FROM INIT ZEROES IT + CLA CLL CMA RTL + DCA ERCNT /3 ERROR TRIES + TAD UNIT + DCA I CXUNIT + JMS I CSELCT /CHECK FOR SELEC ERROR + JMP .-1 /LOOPS IF NO ^C AND SELECT ERROR + TAD FUNCT + CLL RAR + JMP GO /OK.. START THE SEARCH +TRWCOM, SDST /TIME OR CHECK SUM ERROR? + SZA CLA + JMP TRY3 /YES TRY UP TO 3 TIMES + TAD PGCT /NO.. IS PAGE COUNT EXHAUSTED? + TAD CM200 + SNA + JMP EXIT /YES.. DONE THIS TRANSFER + DCA PGCT /NEW PAGE COUNT + ISZ TBLOCK + TAD BUFF + TAD C200 /GET NEW BUFFER ADDRESS + DCA BUFF + CLL CML /FORCE FORWARD MOTION +GO, CLA CML RTR /PUT IN DIRECTION BIT + TAD C1000 + TAD UNIT + SDLC /INITIATE THE MOTION + JMS I CRDQAD /WAIT FOR 8 LINES TO PASS + JMS I CRDQAD +M20, 7760 /DON'T CARE IF IT DOES SKIP!!! +TSRCH, SDSS /WAIT FOR BLOCK MARK OR END ZONE + JMP .-1 + SDRC + CLL RTL /DIRECTION TO LINK, DATA TO AC 4-9 + AND C374 /ISOLATE M.T BITS + TAD M110 /IS IT END ZONE? + SNA + JMP ENDZ /YES..DO SOMETHING REASONABLE + TAD M20 /HOW ABOUT BLOCK MARK? + SZA CLA + JMP TSRCH /NEITHER..KEEP LOOKING + SDRD /WHAT IS THIS BLOCK'S #? + SZL /IF IN REVERSE, LOOK FOR 3 BEFORE + TAD TC3 /THE ACTUAL TARGET BLOCK + CMA + TAD TBLOCK + CMA + SNA /IS THIS THE BLOCK? + JMP TFOUND /YES..HAVE CORRECT ONE +M110, SZL SNA CLA /ARE WE HEADED PROPERLY? + JMP TSRCH /YES.. KEEP LOOKING +ENDZ, SDRC /IF WE ARE IN END ZONE FORWARD, WE LOSE + CLL RTL + JMP GO /EXECUTE TURN AROUND AND SEARCH + TRY3, CLA CLL /V3C + ISZ ERCNT /TRIED 3 TIMES? + JMP GO + JMP FATAL +EXIT, ISZ DTA0 /NORMAL RETURN + CLL CML +FATAL, TAD UNIT /STOP TAPE FIRST + SDLC + CLA CML RAR /EITHER 0 OR 4000 IN AC +LEAVE, HLT /GETS CIF CDF N + JMP I DTA0 + +INIT, JMS . /FIND OUT WHERE WE GOT LOADED +BASE, TAD CRDQAD + SPA /NEGATIVE ENDS LIST + JMP NXINIT + TAD INIT + DCA CRDQAD + ISZ .-1 + ISZ BASE + JMP BASE + +PGCT, 0 +FUNCT, 0 +C1000, 1000 + + *367 +TFOUND, SZL CLA /ARE WE IN RIGHT DIRECTION + JMP GO /NOT YET + TAD FUNCT + CLL RAL /R/W TO LINK + CLA +C70, 70 +TC3, 3 + TAD BUFF +XFIELD, HLT /CONTROL 'TRICKLES THROUGH + +TBLOCK=DTA1 +ERCNT=INIT+1 +CM200=NXINIT +DTA2=DTA0 +DTA3=DTA1 +DTA4=DTA0 +DTA5=DTA1 +DTA6=DTA0 +DTA7=DTA1 + *400 + CIF 0 /WE ARE IN FIELD 0 + DCA XBUFF + RAR + DCA XFUNCT /READ/WRITE TO FUNCTION +RGRD, SDSS + JMP .-1 /LOOK FOR REVERSE GUARD PATTERN + SDRC + AND K77 + TAD CM32 + SZA CLA /IF NOT REV. GUARD, KEEP LOOKING + JMP RGRD + TAD C7600 + DCA WORDS /128 WORDS/BLOCK + TAD XFUNCT +K7700, SMA CLA /IS IT READ OR WRITE? + JMP TREAD + SDRC /CHECK FOR WRITE LOCKOUT + AND TC300 + CLL /SETUP TO RETRY IF WRITE LOCK + SZA CLA + JMP I CTRY3 /IF LOCKED OUT, ERROR + JMS R4LINE /SKIP A WORD +C7600, 7600 /CLA + TAD C1400 + TAD XUNIT + SDLC /TURN ON WRITE HEAD + CLA CMA + JMS W4LINE /7777 IN REV. CHECKSUM + CLA CMA + DCA CSUM /AND ALSO TAPE CHECKSUM +WRTLP, TAD I XBUFF + JMS W4LINE + ISZ XBUFF /INCREMENT BUFF. ADD. +K77, 77 + ISZ WORDS /DONE A BLOCK? + JMP WRTLP + JMS W4LINE /A 129 TH WORD OF 0 + JMS GCHK /GET 6 BIT CHECKSUM + JMS W4LINE /WRITE IT TO TAPE + JMS W4LINE /LET CHECK SUM FINISH + JMP I CRWCOM /SEE IF WE ARE FINISHED + +TREAD, JMS R4LINE + JMS R4LINE /SKIP CONTROL WORDS + JMS R4LINE + AND K77 /CHECKSUM + TAD K7700 + DCA CSUM +RDLP, JMS R4LINE + JMS EFUN /ADD WORD TO CHECKSUM + DCA I XBUFF + ISZ XBUFF +TC300, 300 + ISZ WORDS /DONE BLOCK? + JMP RDLP + JMS R4LINE + JMS EFUN /CHECK SUM 129 TH WORD + JMS R4LINE + AND K7700 /READ CHECKSUM + JMS EFUN + JMS GCHK /COMPARE TAPE AND OUR CHECKSUM + JMP I CRWCOM + +W4LINE, 0 /ADD TO CHECKSUM AND WRITE A 12 BIT + JMS EFUN /WORD + SDSQ + JMP .-1 /SKIP ON QUAD LINE FLAG + SDLD + CLA /AC IS NOT CLEARED AFTER SDLD + JMP I W4LINE + +R4LINE, 0 /WAIT FOR QUAD FLAG AND READ + SDSQ + JMP .-1 + SDRD + JMP I R4LINE + +EFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM + CMA + DCA ETMP /ACTUALLY CHECKSUMS ON DECTAPE ARE + TAD ETMP /EQUIVALENCE OF ALL WORDS IN A RCORD + AND CSUM /6 BITS AT A TIME. SINCE EQUIVALENCE + CIA /IS ASSOCIATIVE WE DO IT 12 AT A TIME + CLL RAL /AND CONDENSE LATER. + TAD ETMP /IDENTITIES USED ARE: + TAD CSUM /A+B=(A.XOR.B)+2*(A.AND.B) + DCA CSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B) + TAD ETMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B)) + CMA + JMP I EFUN + + GCHK, 0 /FORM 6 BIT CHECKSUM + CLA + TAD CSUM + CLL CMA RTL + RTL + RTL + JMS EFUN + CLA CLL CML + TAD CSUM + AND K7700 + JMP I GCHK + +INIT2, 0 /TIS INITIALIZES LOCS IN PAGE 2 +INIT3, TAD CTRY3 + SNA + JMP I INIT2 /0 ENDS LIST + TAD INIT2 + DCA CTRY3 /UPDATE THE LIST + ISZ .-1 + ISZ INIT3 + JMP INIT3 + +CTRY3, TRY3-BASE2 +CRWCOM, TRWCOM-BASE2 +XBUFF, 0 /0 MUST TERMINATE IT!! +CM32, -32 +C1400, 1400 + +SELECT, 0 /THIS ROUTINE CHECKS FOR SELECT + TAD XUNIT /AND ^C TYPED + SDLC + SDRC /GET STATUS AND SEE IF SELECT ERROR ON + AND C100 + SNA CLA + ISZ SELECT /NOPE .TAKE NORMAL OUT + KSF /SEE IF FLAG IS UP + JMP I SELECT /NO..EXIT + TAD C7600 + KRS + TAD (-7603 /IS IT ^C? + SZA CLA + JMP I SELECT /NO..EXIT + JMP I C7600 + +C100, 100 + +XFUNCT=INIT2 +CSUM=XFUNCT+1 +WORDS=CSUM+1 +ETMP=WORDS+1 +XUNIT=ETMP+1 +$$$$$$$ + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/TD8EC.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/TD8EC.PA new file mode 100644 index 0000000..c143c29 --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/TD8EC.PA @@ -0,0 +1,364 @@ +/4 TD8E HANDLER FOR BUILD..TD8E-C +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + *0 + -2 +DEVICE TD8C;DEVICE DTA4;4210;4012;ZBLOCK 2 +DEVICE TD8C;DEVICE DTA5;4210;4016;ZBLOCK 2 + + SDSS=6751 /SKIP ON SINGLE LINE FLAG + SDST=6752 /SKIP ON TIME ERROR + SDSQ=6753 /SKIP ON QUAD LINE FLAG + SDLC=6754 /LOAD TAPE COMMAND REGISTER + SDLD=6755 /LOAD DATA REGISTER + SDRC=6756 /READ COMMAND REGISTER + SDRD=6757 /READ DATA REGISTER + + TDVERSION="D&77 + +/V3 CHANGES: + +/1. VERSION # IS NOW 1 +/2. PARITY ^C IS NOW LEGAL +/3. INITIALIZATION BUG FIXED +/4. ^C CHECK NO LONGER ADVANCES READER +/MAINTENANCE RELEASE CHANGES: + +/5. FIXED ^C BUG +/6. MADE CODING IMPROVEMENTS +/7. FIXED RETRY BUG + + + + *200 + +NXINIT, 7600 /CLEAR AC HERE!!! + JMS I CINIT2 /PART OF INITIALIZATION..DO THE PART +BASE2, DCA JINIT /ON SECOND PAGE AND THEN TO JINIT + JMP JINIT +CRDQAD, R4LINE-BASE +CINIT2, INIT2-BASE +CSELCT, SELECT-BASE +CXUNIT, XUNIT-BASE + +BUFF, 4000 /V3 +PGCT, 0 + +DTA0, TDVERSION /ENTRY FOR UNIT 0 + CLA CLL + JMP DTA1X +UNIT, 0 /FILLER WORD +DTA1, TDVERSION /ENTRY FOR UNIT 1 + CLA CLL CML + TAD DTA1 + DCA DTA0 /PICK UP ARGS AT DTA0 +DTA1X, RAR + DCA UNIT /UNIT # FROM LINK + RDF + TAD C6203 + DCA LEAVE /SET UP EXIT FROM HANDLER +JINIT, JMP INIT + TAD I DTA0 + DCA FUNCT /SAVE FUNCTION WORD + TAD FUNCT + CLL RAL +C200, AND CM200 /GET A PAGE COUNT + DCA PGCT + TAD FUNCT +C374, AND C70 /ISOLATE FIELD OF TRANSFER + TAD C6203 + DCA XFIELD + ISZ DTA0 /POINT TO BUFFER + TAD I DTA0 + DCA BUFF + ISZ DTA0 /POINT TO RECORD + TAD I DTA0 + CLL RAL /CONVERT TO DECTAPE BLOCKS + DCA TBLOCK + ISZ DTA0 /POINT TO ERROR RET. +C6203, CIF CDF 0 + + CLA CLL CMA RTL + DCA ERCNT /3 ERROR TRIES + TAD UNIT + DCA I CXUNIT + JMS I CSELCT /CHECK FOR SELEC ERROR + JMP .-1 /LOOPS IF NO ^C AND SELECT ERROR + TAD FUNCT + CLL RAR + JMP GO /OK.. START THE SEARCH +TRWCOM, SDST /TIME OR CHECK SUM ERROR? + SZA CLA + JMP TRY3 /YES TRY UP TO 3 TIMES + TAD PGCT /NO.. IS PAGE COUNT EXHAUSTED? + TAD CM200 + SNA + JMP EXIT /YES.. DONE THIS TRANSFER + DCA PGCT /NEW PAGE COUNT + ISZ TBLOCK + TAD BUFF + TAD C200 /GET NEW BUFFER ADDRESS + DCA BUFF + CLL CML /FORCE FORWARD MOTION +GO, CLA CML RTR /PUT IN DIRECTION BIT + TAD C1000 + TAD UNIT + SDLC /INITIATE THE MOTION + JMS I CRDQAD /WAIT FOR 8 LINES TO PASS + JMS I CRDQAD +M20, 7760 /DON'T CARE IF IT DOES SKIP!!! +TSRCH, SDSS /WAIT FOR BLOCK MARK OR END ZONE + JMP .-1 + SDRC + CLL RTL /DIRECTION TO LINK, DATA TO AC 4-9 + AND C374 /ISOLATE M.T BITS + TAD M110 /IS IT END ZONE? + SNA + JMP ENDZ /YES..DO SOMETHING REASONABLE + TAD M20 /HOW ABOUT BLOCK MARK? + SZA CLA + JMP TSRCH /NEITHER..KEEP LOOKING + SDRD /WHAT IS THIS BLOCK'S #? + SZL /IF IN REVERSE, LOOK FOR 3 BEFORE + TAD TC3 /THE ACTUAL TARGET BLOCK + CMA + TAD TBLOCK + CMA + SNA /IS THIS THE BLOCK? + JMP TFOUND /YES..HAVE CORRECT ONE +M110, SZL SNA CLA /ARE WE HEADED PROPERLY? + JMP TSRCH /YES.. KEEP LOOKING +ENDZ, SDRC /IF WE ARE IN END ZONE FORWARD, WE LOSE + CLL RTL + JMP GO /EXECUTE TURN AROUND AND SEARCH + TRY3, CLA CLL /V3C + ISZ ERCNT /TRIED 3 TIMES? + JMP GO + JMP FATAL +EXIT, ISZ DTA0 /NORMAL RETURN + CLL CML +FATAL, TAD UNIT /STOP TAPE FIRST + SDLC + CLA CML RAR /EITHER 0 OR 4000 IN AC +LEAVE, HLT /GETS CIF CDF N + JMP I DTA0 + +INIT, JMS . /FIND OUT WHERE WE GOT LOADED +BASE, TAD CRDQAD + SPA /NEGATIVE ENDS LIST + JMP NXINIT + TAD INIT + DCA CRDQAD + ISZ .-1 + ISZ BASE + JMP BASE + +FUNCT, 0 +C1000, 1000 + + *367 +TFOUND, SZL CLA /ARE WE IN RIGHT DIRECTION + JMP GO /NOT YET + TAD FUNCT + CLL RAL /R/W TO LINK + CLA +C70, 70 +TC3, 3 + TAD BUFF +XFIELD, HLT /CONTROL 'TRICKLES THROUGH + +TBLOCK=DTA1 +ERCNT=INIT+1 +CM200=NXINIT +DTA2=DTA0 +DTA3=DTA1 +DTA4=DTA0 +DTA5=DTA1 +DTA6=DTA0 +DTA7=DTA1 + *400 + CIF 0 /WE ARE IN FIELD 0 + DCA XBUFF + RAR + DCA XFUNCT /READ/WRITE TO FUNCTION +RGRD, SDSS + JMP .-1 /LOOK FOR REVERSE GUARD PATTERN + SDRC + AND K77 + TAD CM32 + SZA CLA /IF NOT REV. GUARD, KEEP LOOKING + JMP RGRD + TAD C7600 + DCA WORDS /128 WORDS/BLOCK + TAD XFUNCT +K7700, SMA CLA /IS IT READ OR WRITE? + JMP TREAD + SDRC /CHECK FOR WRITE LOCKOUT + AND TC300 + CLL /SETUP TO RETRY IF WRITE LOCK + SZA CLA + JMP I CTRY3 /IF LOCKED OUT, ERROR + JMS R4LINE /SKIP A WORD +C7600, 7600 /CLA + TAD C1400 + TAD XUNIT + SDLC /TURN ON WRITE HEAD + CLA CMA + JMS W4LINE /7777 IN REV. CHECKSUM + CLA CMA + DCA CSUM /AND ALSO TAPE CHECKSUM +WRTLP, TAD I XBUFF + JMS W4LINE + ISZ XBUFF /INCREMENT BUFF. ADD. +K77, 77 + ISZ WORDS /DONE A BLOCK? + JMP WRTLP + JMS W4LINE /A 129 TH WORD OF 0 + JMS GCHK /GET 6 BIT CHECKSUM + JMS W4LINE /WRITE IT TO TAPE + JMS W4LINE /LET CHECK SUM FINISH + JMP I CRWCOM /SEE IF WE ARE FINISHED + +TREAD, JMS R4LINE + JMS R4LINE /SKIP CONTROL WORDS + JMS R4LINE + AND K77 /CHECKSUM + TAD K7700 + DCA CSUM +RDLP, JMS R4LINE + JMS EFUN /ADD WORD TO CHECKSUM + DCA I XBUFF + ISZ XBUFF +TC300, 300 + ISZ WORDS /DONE BLOCK? + JMP RDLP + JMS R4LINE + JMS EFUN /CHECK SUM 129 TH WORD + JMS R4LINE + AND K7700 /READ CHECKSUM + JMS EFUN + JMS GCHK /COMPARE TAPE AND OUR CHECKSUM + JMP I CRWCOM + +W4LINE, 0 /ADD TO CHECKSUM AND WRITE A 12 BIT + JMS EFUN /WORD + SDSQ + JMP .-1 /SKIP ON QUAD LINE FLAG + SDLD + CLA /AC IS NOT CLEARED AFTER SDLD + JMP I W4LINE + +R4LINE, 0 /WAIT FOR QUAD FLAG AND READ + SDSQ + JMP .-1 + SDRD + JMP I R4LINE + +EFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM + CMA + DCA ETMP /ACTUALLY CHECKSUMS ON DECTAPE ARE + TAD ETMP /EQUIVALENCE OF ALL WORDS IN A RCORD + AND CSUM /6 BITS AT A TIME. SINCE EQUIVALENCE + CIA /IS ASSOCIATIVE WE DO IT 12 AT A TIME + CLL RAL /AND CONDENSE LATER. + TAD ETMP /IDENTITIES USED ARE: + TAD CSUM /A+B=(A.XOR.B)+2*(A.AND.B) + DCA CSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B) + TAD ETMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B)) + CMA + JMP I EFUN + + GCHK, 0 /FORM 6 BIT CHECKSUM + CLA + TAD CSUM + CLL CMA RTL + RTL + RTL + JMS EFUN + CLA CLL CML + TAD CSUM + AND K7700 + JMP I GCHK + +INIT2, 0 /TIS INITIALIZES LOCS IN PAGE 2 +INIT3, TAD CTRY3 + SNA + JMP I INIT2 /0 ENDS LIST + TAD INIT2 + DCA CTRY3 /UPDATE THE LIST + ISZ .-1 + ISZ INIT3 + JMP INIT3 + +CTRY3, TRY3-BASE2 +CRWCOM, TRWCOM-BASE2 +XBUFF, 0 /0 MUST TERMINATE IT!! +CM32, -32 +C1400, 1400 + +SELECT, 0 /THIS ROUTINE CHECKS FOR SELECT + TAD XUNIT /AND ^C TYPED + SDLC + SDRC /GET STATUS AND SEE IF SELECT ERROR ON + AND C100 + SNA CLA + ISZ SELECT /NOPE .TAKE NORMAL OUT + KSF /SEE IF FLAG IS UP + JMP I SELECT /NO..EXIT + TAD C7600 + KRS + TAD (-7603 /IS IT ^C? + SZA CLA + JMP I SELECT /NO..EXIT + JMP I C7600 + +C100, 100 + +XFUNCT=INIT2 +CSUM=XFUNCT+1 +WORDS=CSUM+1 +ETMP=WORDS+1 +XUNIT=ETMP+1 +$$$$$$$ + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/TD8ED.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/TD8ED.PA new file mode 100644 index 0000000..13fb1c9 --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape1/TD8ED.PA @@ -0,0 +1,366 @@ +/4 TD8E HANDLER FOR BUILD..TD8E-D +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1975,1977 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + *0 + -2 +DEVICE TD8D;DEVICE DTA6;4210;4013;ZBLOCK 2 +DEVICE TD8D;DEVICE DTA7;4210;4017;ZBLOCK 2 + + SDSS=6741 /SKIP ON SINGLE LINE FLAG + SDST=6742 /SKIP ON TIME ERROR + SDSQ=6743 /SKIP ON QUAD LINE FLAG + SDLC=6744 /LOAD TAPE COMMAND REGISTER + SDLD=6745 /LOAD DATA REGISTER + SDRC=6746 /READ COMMAND REGISTER + SDRD=6747 /READ DATA REGISTER + + TDVERSION="D&77 + +/V3 CHANGES: + +/1. VERSION # IS NOW 1 +/2. PARITY ^C IS NOW LEGAL +/3. INITIALIZATION BUG FIXED +/4. ^C CHECK NO LONGER ADVANCES READER + +/MAINTENANCE RELEASE CHANGES: + +/5. FIXED ^C BUG +/6. MADE CODE IMPROVEMENTS +/7. FIXED RETRY BUG + + + + + *200 + +NXINIT, 7600 /CLEAR AC HERE!!! + JMS I CINIT2 /PART OF INITIALIZATION..DO THE PART +BASE2, DCA JINIT /ON SECOND PAGE AND THEN TO JINIT + JMP JINIT +CRDQAD, R4LINE-BASE +CINIT2, INIT2-BASE +CSELCT, SELECT-BASE +CXUNIT, XUNIT-BASE + +BUFF, 4000 /V3 +PGCT, 0 +FUNCT, 0 + +DTA0, TDVERSION /ENTRY FOR UNIT 0 + CLA CLL + JMP DTA1X +UNIT, 0 /FILLER WORD +DTA1, TDVERSION /ENTRY FOR UNIT 1 + CLA CLL CML + TAD DTA1 + DCA DTA0 /PICK UP ARGS AT DTA0 +DTA1X, RAR + DCA UNIT /UNIT # FROM LINK + RDF + TAD C6203 + DCA LEAVE /SET UP EXIT FROM HANDLER +JINIT, JMP INIT + TAD I DTA0 + DCA FUNCT /SAVE FUNCTION WORD + TAD FUNCT + CLL RAL +C200, AND CM200 /GET A PAGE COUNT + DCA PGCT + TAD FUNCT +C374, AND C70 /ISOLATE FIELD OF TRANSFER + TAD C6203 + DCA XFIELD + ISZ DTA0 /POINT TO BUFFER + TAD I DTA0 + DCA BUFF + ISZ DTA0 /POINT TO RECORD + TAD I DTA0 + CLL RAL /CONVERT TO DECTAPE BLOCKS + DCA TBLOCK + ISZ DTA0 /POINT TO ERROR RET. +C6203, CIF CDF 0 + + CLA CLL CMA RTL + DCA ERCNT /3 ERROR TRIES + TAD UNIT + DCA I CXUNIT + JMS I CSELCT /CHECK FOR SELEC ERROR + JMP .-1 /LOOPS IF NO ^C AND SELECT ERROR + TAD FUNCT + CLL RAR + JMP GO /OK.. START THE SEARCH +TRWCOM, SDST /TIME OR CHECK SUM ERROR? + SZA CLA + JMP TRY3 /YES TRY UP TO 3 TIMES + TAD PGCT /NO.. IS PAGE COUNT EXHAUSTED? + TAD CM200 + SNA + JMP EXIT /YES.. DONE THIS TRANSFER + DCA PGCT /NEW PAGE COUNT + ISZ TBLOCK + TAD BUFF + TAD C200 /GET NEW BUFFER ADDRESS + DCA BUFF + CLL CML /FORCE FORWARD MOTION +GO, CLA CML RTR /PUT IN DIRECTION BIT + TAD C1000 + TAD UNIT + SDLC /INITIATE THE MOTION + JMS I CRDQAD /WAIT FOR 8 LINES TO PASS + JMS I CRDQAD +M20, 7760 /DON'T CARE IF IT DOES SKIP!!! +TSRCH, SDSS /WAIT FOR BLOCK MARK OR END ZONE + JMP .-1 + SDRC + CLL RTL /DIRECTION TO LINK, DATA TO AC 4-9 + AND C374 /ISOLATE M.T BITS + TAD M110 /IS IT END ZONE? + SNA + JMP ENDZ /YES..DO SOMETHING REASONABLE + TAD M20 /HOW ABOUT BLOCK MARK? + SZA CLA + JMP TSRCH /NEITHER..KEEP LOOKING + SDRD /WHAT IS THIS BLOCK'S #? + SZL /IF IN REVERSE, LOOK FOR 3 BEFORE + TAD TC3 /THE ACTUAL TARGET BLOCK + CMA + TAD TBLOCK + CMA + SNA /IS THIS THE BLOCK? + JMP TFOUND /YES..HAVE CORRECT ONE +M110, SZL SNA CLA /ARE WE HEADED PROPERLY? + JMP TSRCH /YES.. KEEP LOOKING +ENDZ, SDRC /IF WE ARE IN END ZONE FORWARD, WE LOSE + CLL RTL + JMP GO /EXECUTE TURN AROUND AND SEARCH + TRY3, CLA CLL /V3C + ISZ ERCNT /TRIED 3 TIMES? + JMP GO + JMP FATAL +EXIT, ISZ DTA0 /NORMAL RETURN + CLL CML +FATAL, TAD UNIT /STOP TAPE FIRST + SDLC + CLA CML RAR /EITHER 0 OR 4000 IN AC +LEAVE, HLT /GETS CIF CDF N + JMP I DTA0 + +INIT, JMS . /FIND OUT WHERE WE GOT LOADED +BASE, TAD CRDQAD + SPA /NEGATIVE ENDS LIST + JMP NXINIT + TAD INIT + DCA CRDQAD + ISZ .-1 + ISZ BASE + JMP BASE + +C1000, 1000 + + *367 +TFOUND, SZL CLA /ARE WE IN RIGHT DIRECTION + JMP GO /NOT YET + TAD FUNCT + CLL RAL /R/W TO LINK + CLA +C70, 70 +TC3, 3 + TAD BUFF +XFIELD, HLT /CONTROL 'TRICKLES THROUGH + +TBLOCK=DTA1 +ERCNT=INIT+1 +CM200=NXINIT +DTA2=DTA0 +DTA3=DTA1 +DTA4=DTA0 +DTA5=DTA1 +DTA6=DTA0 +DTA7=DTA1 + *400 + CIF 0 /WE ARE IN FIELD 0 + DCA XBUFF + RAR + DCA XFUNCT /READ/WRITE TO FUNCTION +RGRD, SDSS + JMP .-1 /LOOK FOR REVERSE GUARD PATTERN + SDRC + AND K77 + TAD CM32 + SZA CLA /IF NOT REV. GUARD, KEEP LOOKING + JMP RGRD + TAD C7600 + DCA WORDS /128 WORDS/BLOCK + TAD XFUNCT +K7700, SMA CLA /IS IT READ OR WRITE? + JMP TREAD + SDRC /CHECK FOR WRITE LOCKOUT + AND TC300 + CLL /SETUP TO RETRY IF WRITE LOCK + SZA CLA + JMP I CTRY3 /IF LOCKED OUT, ERROR + JMS R4LINE /SKIP A WORD +C7600, 7600 /CLA + TAD C1400 + TAD XUNIT + SDLC /TURN ON WRITE HEAD + CLA CMA + JMS W4LINE /7777 IN REV. CHECKSUM + CLA CMA + DCA CSUM /AND ALSO TAPE CHECKSUM +WRTLP, TAD I XBUFF + JMS W4LINE + ISZ XBUFF /INCREMENT BUFF. ADD. +K77, 77 + ISZ WORDS /DONE A BLOCK? + JMP WRTLP + JMS W4LINE /A 129 TH WORD OF 0 + JMS GCHK /GET 6 BIT CHECKSUM + JMS W4LINE /WRITE IT TO TAPE + JMS W4LINE /LET CHECK SUM FINISH + JMP I CRWCOM /SEE IF WE ARE FINISHED + +TREAD, JMS R4LINE + JMS R4LINE /SKIP CONTROL WORDS + JMS R4LINE + AND K77 /CHECKSUM + TAD K7700 + DCA CSUM +RDLP, JMS R4LINE + JMS EFUN /ADD WORD TO CHECKSUM + DCA I XBUFF + ISZ XBUFF +TC300, 300 + ISZ WORDS /DONE BLOCK? + JMP RDLP + JMS R4LINE + JMS EFUN /CHECK SUM 129 TH WORD + JMS R4LINE + AND K7700 /READ CHECKSUM + JMS EFUN + JMS GCHK /COMPARE TAPE AND OUR CHECKSUM + JMP I CRWCOM + +W4LINE, 0 /ADD TO CHECKSUM AND WRITE A 12 BIT + JMS EFUN /WORD + SDSQ + JMP .-1 /SKIP ON QUAD LINE FLAG + SDLD + CLA /AC IS NOT CLEARED AFTER SDLD + JMP I W4LINE + +R4LINE, 0 /WAIT FOR QUAD FLAG AND READ + SDSQ + JMP .-1 + SDRD + JMP I R4LINE + +EFUN, 0 /COMPUTE EQUIVALENCE CHECKSUM + CMA + DCA ETMP /ACTUALLY CHECKSUMS ON DECTAPE ARE + TAD ETMP /EQUIVALENCE OF ALL WORDS IN A RCORD + AND CSUM /6 BITS AT A TIME. SINCE EQUIVALENCE + CIA /IS ASSOCIATIVE WE DO IT 12 AT A TIME + CLL RAL /AND CONDENSE LATER. + TAD ETMP /IDENTITIES USED ARE: + TAD CSUM /A+B=(A.XOR.B)+2*(A.AND.B) + DCA CSUM /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B) + TAD ETMP /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B)) + CMA + JMP I EFUN + + GCHK, 0 /FORM 6 BIT CHECKSUM + CLA + TAD CSUM + CLL CMA RTL + RTL + RTL + JMS EFUN + CLA CLL CML + TAD CSUM + AND K7700 + JMP I GCHK + +INIT2, 0 /TIS INITIALIZES LOCS IN PAGE 2 +INIT3, TAD CTRY3 + SNA + JMP I INIT2 /0 ENDS LIST + TAD INIT2 + DCA CTRY3 /UPDATE THE LIST + ISZ .-1 + ISZ INIT3 + JMP INIT3 + +CTRY3, TRY3-BASE2 +CRWCOM, TRWCOM-BASE2 +XBUFF, 0 /0 MUST TERMINATE IT!! +CM32, -32 +C1400, 1400 + +SELECT, 0 /THIS ROUTINE CHECKS FOR SELECT + TAD XUNIT /AND ^C TYPED + SDLC + SDRC /GET STATUS AND SEE IF SELECT ERROR ON + AND C100 + SNA CLA + ISZ SELECT /NOPE .TAKE NORMAL OUT + KSF /SEE IF FLAG IS UP + JMP I SELECT /NO..EXIT + TAD C7600 + KRS + TAD (-7603 /IS IT ^C? + SZA CLA + JMP I SELECT /NO..EXIT + JMP I C7600 + +C100, 100 + +XFUNCT=INIT2 +CSUM=XFUNCT+1 +WORDS=CSUM+1 +ETMP=WORDS+1 +XUNIT=ETMP+1 +$$$$$$$ + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape2/BAT.PA b/sw/os8/v3d/sources/system/dectapes/dectape2/BAT.PA new file mode 100644 index 0000000..5c0086a --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape2/BAT.PA @@ -0,0 +1,198 @@ +/1 BATCH INPUT STREAM HANDLER +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + *0 + -1 /NUMBER OF DEVICES + DEVICE BAT /DEVICE TYPE NAME + DEVICE BAT /DEVICE NAME + 2220 /READ ONLY, CODE=22 + 0 /ONE PAGE + ZBLOCK 2 + +BATIN= 5400 + BATVERSION="B&77 + + + *200 +BAT, BATVERSION + CLA /PROTECTION + RDF /GET USER'S FIELD + TAD BATCDF /MAKE CDF CIF + DCA BATXIT /SAVE FOR EXIT + TAD BATISZ /RESET SUCCESS ISZ + DCA BATXIT-1 + TAD I BAT + AND BA7700 + CIA + DCA BATWC /SAVE WORD COUNT (DIVIDED BY 2) + TAD I BAT + AND BA0070 + TAD BATCDF /CREATE CDF TO BUFFER FIELD + TAD (-2 + DCA BATBUF +BATISZ, ISZ BAT + TAD I BAT + DCA BATCA /GET ADDRESS OF BUFFER + ISZ BAT + ISZ BAT /IGNORE BLOCK NUMBER + TAD BATWC /WAS COMMAND WRITE OR BUFFER LENGTH ZERO? +BA7700, SMA CLA + JMP BATER1 /YES - ERROR +BATCDF, CDF CIF 0 + TAD I BA7777 /IS BATCH RUNNING? + RAL + SMA CLA + JMP BATER2 /NO - ERROR + TAD I BA7777 + AND BA0070 + TAD BATCDF /CREATE CDF TO BATCH FIELD + DCA BATCAL /CREATE CDF CIF TO BATCH FIELD + + + +BATLP, JMS BATGET /GET CHAR + DCA I BATCA /SAVE IN BUFFER + JMS BATGET /GET NEXT CHAR + DCA BATTMP /SAVE IT FOR PACKING + JMS BATGET /GET NEXT CHAR + RTL + RTL + DCA BATTM2 /SAVE IT + TAD BATTM2 + AND BA7400 /ADD FIRST HALF + TAD I BATCA /TO FIRST CHAR + DCA I BATCA /SAVE THEM IN BUFFER + ISZ BATCA /UPDATE POINTER +BA7400, 7400 /PROTECT THE ISZ + TAD BATTM2 /GET SECOND HALF OF CHAR + RTL + RTL + AND BA7400 + TAD BATTMP /ADD TO SECOND CHAR + DCA I BATCA /SAVE IN BUFFER + ISZ BATCA /UPDATE POINTER +BA0070, 0070 /PROTECT THE ISZ + ISZ BATWC /DONE? + JMP BATLP /NO - LOOP + + ISZ BAT /SUCCESS RETURN (ON EOF THIS BECOMES CLA IAC) +BATXIT, HLT /CDF CIF TO USER FIELD + JMP I BAT /RETURN + +BATWC, 0 /WORD COUNT (DIVIDED BY 2) +BATCA, 0 /POINTER INTO BUFFER +BATTM2, +BATCHR, 0 /CHAR RETURNED BY BATGET +BATTMP, 0 +BA7777, 7777 + + +BATER1, +BATER2, CLA STL RAR + JMP BATXIT + /THIS ROUTINE GETS THE NEXT CHARACTER TO BE PUT INTO THE BUFFER +BATGET, 0 + 0 /IF LAST CHAR WAS THIS IS "JMP BATLF" +BATCAL, HLT /CIF CDF BATCH FIELD (ON EOF THIS IS "JMP BATBUF") + TAD I BATVFY + TAD (-2214 /VERIFY MAGIC LOCATION IN BATCH + SZA /AGAINST EQUALLY MAGIC CONTENTS + CDF CIF 0 + SZA CLA + JMP BATER2 /BATCH IS DESTROYED! + CDF /WE ARE IN FIELD ZERO + JMS I BATINN /CALL THE BATCH INPUT ROUTINE + JMP BATEOF /NO SKIP = END OF FILE + DCA BATCHR /SAVE CHARACTER RETURNED + TAD BATCHR + TAD BMCR /CARRIAGE RETURN? + SNA + JMP BATCR /YES + TAD BCRMLF /LINE FEED? + SNA + JMP BATCAL /YES - IGNORE IT + TAD BLFMDO /DOLLAR SIGN? + SNA CLA + JMP BATDO /YES +BATGEX, DCA BCRFLG /NO SPECIAL CHAR + TAD BATCHR /RETURN WITH CHAR IN AC +BATBUF, HLT /CDF USER BUFFER + JMP I BATGET /RETURN + +BLFJMP, JMP BATLF +BATCR, TAD BLFJMP /SET NEXT CALL TO RETURN + DCA BATGET+1 + CLA CMA /SET TO INDICATE + JMP BATGEX + +BATLF, DCA BATGET+1 /ZAP THE JMP TO HERE + TAD BLF /RETURN +BATGEJ, JMP BATBUF + +BATDO, TAD BCRFLG /IS THE "$" FIRST ON THIS LINE? + SNA CLA + JMP BATGEX /NO - NOTHING SPECIAL + TAD I BA7777 /YES - SET FLAG SO THAT + RTR /THE BATCH INPUT ROUTINE + STL RTL /WILL PUT THE DOLLAR-SIGN BACK + DCA I BA7777 + /RETURN CURRENT CHARACTER AGAIN +BATEOF, TAD BATCTZ /RETURN CTRL-Z THIS TIME + DCA BATCHR + DCA BATXIT-1 /SET HANDLER TO RETURN TO ERROR RETURN + TAD BATGEJ /SET BATGET TO RETURN ZEROES + DCA BATCAL + JMP BATCR+2 /AND FLAG NEW LINE FOR NEXT CALL + +BATINN, BATIN /ENTRY ADDRESS OF BATCH INPUT ROUTINE +BATVFY, BATIN+200 +BLF, 212 +BMCR, -215 +BCRMLF, 215-212 +BLFMDO, 212-"$ +BCRFLG, -1 +BATCTZ, 32 /CTRL-Z + +$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape2/DF32NS.PA b/sw/os8/v3d/sources/system/dectapes/dectape2/DF32NS.PA new file mode 100644 index 0000000..0c0501e --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape2/DF32NS.PA @@ -0,0 +1,163 @@ +/1 DF32 NON SYSTEM HANDLER +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + +/ SR + + RF08=0 /CHANGE TO 1 FOR RF08 HANDLER + +/THE NUMBER OF PLATTERS MUST EITHER BE SET AT ASSEMBLY TIME, +/OR MUST BE CHANGED VIA THE ALTER COMMAND IN BUILD + + *0 + + -1 + IFNZRO RF08 < + DEVICE RF;DEVICE RF;4064;RF&177;ZBLOCK 2 + > + IFZERO RF08 < + DEVICE DF;DEVICE DF;4124;DF&177;ZBLOCK 2 + > + + SCA=7751 + SWC=7750 + + RFVERSION="A&77 + *200 + +SYSER, CLA CLL CML RAR /4000 + ISZ SYSCNT /TRY AGAIN? + SKP CLA + JMP SFIELD /WHY BOTHER + CLA CLL CMA RTL + TAD RF + DCA RF /RESET PARAMETERS AND TRY AGAIN + JMP RETRY +SCIF, CIF 0 +SYSCNT, 0 +S6603, 6603 +S70, 70 +S7400, 7400 + IFZERO RF08 + IFNZRO RF08 +T1, 0 +T2, 0 + ZBLOCK 224-. + IFNZRO .-224 /ENTRY PT MUST BE RELATIVE 24 +DF, +RF, RFVERSION + CLA CLL CMA RTL /-3 + DCA SYSCNT /# TRYS ON ERROR +RETRY, TAD I RF /HANDLER RUNS IN USER'S DATA FIELD + RAL + CLA RTL + TAD S6603 + DCA SFUN /EITHER A READ OR WRITE + TAD I RF + AND S70 + DCA SFIELD /GET FIELD OF BUFFER + TAD I RF + RAL + AND S7600 + CIA + DCA T1 /SET UP WORD COUNT + CLA CMA + ISZ RF + TAD I RF + DCA T2 /BUFFER ADDRESS-1 + ISZ RF + RDF + TAD (CDF 0 + DCA RESRDF + CDF 0 + TAD T1 + DCA I (SWC + TAD T2 + DCA I (SCA +RESRDF, HLT /RESTORE USER'S DATA FIELD + IFZERO RF08 < + TAD I RF + RTL + AND S3700 + > + TAD SFIELD + 6615 /LOAD DISK EXTENDED MEMORY +S7600, 7600 + IFNZRO RF08 < + TAD I RF + RTR + RTR + AND S377 + 6643 /LOAD HIGH ORDER + > + TAD I RF + RTR + RTR + RAR + AND S7400 +SFUN, HLT /BECOMES DISK IOT.(READ OR WRITE) + RDF + TAD SCIF + DCA SFIELD + IFZERO RF08 <6622> + IFNZRO RF08 <6623> + JMP .-1 + KRS + AND (177 + TAD (-3 + SNA CLA + KSF + JMP .+3 + CIF CDF 0 /RETURN TO OS/8 IF USER TYPED ^C + JMP I S7600 + ISZ RF + 6621 /SKIP ON ERROR + IFNZRO RF08 + JMP SYSER + ISZ RF +SFIELD, HLT /RETURN TO PROPER FIELD + 6601 /CLEAR TROUBLESOME FLAG + JMP I RF + $ + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape2/DF32SY.PA b/sw/os8/v3d/sources/system/dectapes/dectape2/DF32SY.PA new file mode 100644 index 0000000..a84dbbc --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape2/DF32SY.PA @@ -0,0 +1,183 @@ +/2 DF32 SYSTEM HANDLER +/ +/ +/ +/ +/ +/ +/ +/ +/ +/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ +/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE +/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT +/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY +/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT. +/ +/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER +/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED +/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH +/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. +/ +/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE +/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY +/DIGITAL. +/ +/ +/ +/ +/ +/ +/ +/ +/ +/ + /MAINTENANCE RELEASE CHANGES: + +/1. TOOK OUT SOFSET + +DF32=1 + RF08=0 + VERSION="B&77 + + *0 + -1 + DEVICE DF32;DEVICE SYS;4124;2007;0;177 + + STARTB-ENDB-1 + + NOPUNC + *6604 + ENPUNC + +STARTB, NOP /FOR "SWAP" +B6653, 6653 +B7647, 7647 +B7577, 7577 +B200, 200 +B7605, 7605 +B7751, 7751 + ZBLOCK 6622-. + TAD I B6653 + CDF 10 + DCA I B7647 + CDF 0 + ISZ B6653 + ISZ B7647 + JMP .-6 /MOVE FIELD 1 RESIDENT UP + IFNZRO RF08 <6643> + 6615 + 7600 + TAD B7577 + DCA I B7751 + TAD B200 + 6603 /NOW READ IN FIELD 0 RESIDENT FROM RECORD 1/2 + + IFNZRO RF08 <6623> + IFNZRO DF32 <6622> + JMP .-1 + 6621 + IFNZRO RF08 + HLT /ERROR READING SYSTEM IN +ENDB, JMP I B7605 + /BOOTSTRAP FOR DISK MONITOR IS AS FOLLOWS: + + / LOCATION CONTENTS + / 7750 7600 + / 7751 6603 + / 7752 6622 + / 7753 5352 + / 7754 5752 + *200 + + NOPUNCH + *7600 + ENPUNCH + + ZBLOCK 7 +SHNDLR, VERSION + CLA CLL CMA RTL /-3 + DCA SYSCNT /# TRYS ON ERROR + TAD I SHNDLR + RAL + CLA RTL + TAD S6603 + DCA SFUN /EITHER A READ OR WRITE + TAD I SHNDLR + AND S70 + DCA SFIELD /GET FIELD OF BUFFER + TAD I SHNDLR + RAL + AND S7600 + CIA + DCA SWC /SET UP WORD COUNT + CLA CMA + ISZ SHNDLR + TAD I SHNDLR + DCA SCA /BUFFER ADDRESS-1 + ISZ SHNDLR + IFNZRO DF32 < + TAD I SHNDLR + RTL + AND S3700> + TAD SFIELD + 6615 /LOAD DISK EXTENDED MEMORY +S7600, 7600 + IFNZRO RF08 < + TAD I SHNDLR + RTR + RTR + AND S377 + 6643 /LOAD HIGH ORDER> + TAD I SHNDLR + RTR + RTR + RAR + AND S7400 +SFUN, HLT /BECOMES DISK IOT.(READ OR WRITE) + RDF + TAD SCIF + DCA SFIELD + IFNZRO DF32 <6622> + IFNZRO RF08 <6623> + JMP .-1 + ISZ SHNDLR + 6621 /SKIP ON ERROR + IFNZRO RF08 + JMP SYSER + ISZ SHNDLR +SFIELD, HLT /RETURN TO PROPER FIELD + 6601 /CLEAR TROUBLESOME FLAG + JMP I SHNDLR + ZBLOCK 2 +SYSER, CLA CLL CML RAR /4000 + ISZ SYSCNT /TRY AGAIN? + SKP CLA + JMP SFIELD /WHY BOTHER + CLA CLL CMA RTL + TAD SHNDLR + DCA SHNDLR /RESET PARAMETERS AND TRY AGAIN + IFNZRO RF08 ; SKP; HLT> + JMP SHNDLR+3 +SCIF, CIF 0 +SYSCNT, 0 + IFNZRO DF32 ; SKP; HLT> +S6603, 6603 +S70, 70 +S7400, 7400 + IFNZRO DF32 + IFNZRO RF08 + SCA=7751 + SWC=7750 + $ + diff --git a/sw/os8/v3d/sources/system/dectapes/dectape2/FORT.PA b/sw/os8/v3d/sources/system/dectapes/dectape2/FORT.PA new file mode 100644 index 0000000..fde72a0 --- /dev/null +++ b/sw/os8/v3d/sources/system/dectapes/dectape2/FORT.PA @@ -0,0 +1,4535 @@ +/OS8 FORTRAN II COMPILER V5 +/ +/ +/ +/ +/ +/ +/ +// +/ +/ +/ +/ +/COPYRIGHT (C) 1971,1974,1975 +/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. +/ +/ +/ +/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A +/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- +/SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER +/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE +/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO +/AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE +/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. +/ +/ +/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT +/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL +/EQUIPMRNT COROPATION. +/ +/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS +/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. +/ +/ +/ +/ +/ +/ + / +/ SYMBOL TABLE FOR FORTRAN COMPILER (8K- PDP-8) +/ FOR USE WITH DISK/DECTAPE MONITOR SYSTEM +/ CHANGE LOCATION 'XFINI' TO A 'JMP I LFINI' THEN +/ASSEMBLE AND SAVE +/ .PAL FORT.PA +/ .PAL FPATCH.PA +/ +/ .LO FORT.BN$FPATCH.BN$ +/ +/ .SA SYS FORT +/ +/ + + FIELD 0 + *200 +INBUF, TEXT /PDP-8 FORTRAN DEC-08-A2B1-5A/ + + *1000 +BEGIN, PLS /INITIALIZATION ROUTINE + TLS + RFC + CDF 00 + TAD CM1300 /SET SYMBOL TABLE TO ZEROS (6300-7577 FIELD 1) + DCA INDX + TAD BSYMP + DCA TPTT +LP, DCA I TPTT + ISZ INDX + JMP LP + TAD CM60 + DCA INDX + TAD BTTAB + DCA TPTT + DCA I TPTT /ZERO OUT TEMPORARY TABLES IN FIELD 0 + ISZ INDX + JMP .-2 + CDF 10 + TAD MIN104 /ZERO EVERYTHING FROM ZERO TO 107 + DCA INDX + TAD CP6 + DCA TPTT +LPP, DCA I TPTT + ISZ INDX + JMP LPP + TAD TPT /MOVE DATA FROM TABLE TO FIELD 0 + DCA TPTT +REP, CDF 00 + TAD I TPTT + SNA /END OF FIELD 0 INITIALIZATION? + JMP DN /YES + DCA LOC + TAD I TPTT + CDF 10 + DCA I LOC + JMP REP +DN, TAD I TPTT /MOVE DATA FROM TABLE TO FIELD 1 + SNA /END FIELD 1 INITIALIZATION + JMP DNN /YES + DCA LOC + TAD I TPTT + DCA I LOC + JMP DN +DNN, CIF 10 + JMP I STRT +LOC, 0 +INDX, 0 +MIN104, L7-ASSIGN +CP6, L7-1 +CM1300, -1300 +CM60, -60 +BTTAB, ITTAB-1 +BSYMP, BSYM-1 /BOTTOM OF TEMPORARY SYMBOL TABLE +STRT, FORST /STARTING POINT AFTER INITIALIZATION +TPTT=10 +TPT, TABLE-1 +TABLE, +PUNCH + LTTYPE +15 + DOEND +45 + FTTAB +51 + ITTAB +47 + TSYM-3 +50 + TSYM +55 + -25 +56 + BSYM +57 + BSYM +71 + 5777 +74 + 3000 +MIKE4 + 3377 +POINTZ + 3377 +BASE + INBUF +BASE2 + INBUF+100 +SCOUNT + 0 +SCOUNT+1 + 0 +SCOUNT+2 + 0 +QONE + 0 +QONE+1 + 0 +QONE+2 + 0 +QONE+3 + 0 +QONE+4 + 0 +QONE+5 + 0 +QONE+6 + 0 +0 /THIS TERMINATES FIELD ZERO INITIALIZATION +2375 + 4000 +2376 + 4000 +2377 + 4000 +0 + + / ERROR MESSAGE TABLE AND TEXT + +ELIST, -ERR1-1; EMSG1 /ILLEGAL CONTINUATION + -ERR2-1; IE /ILLEGAL ARITHMETIC EXPRESSION + -ERR3-1; IE + -ERR6-1; IE + -ERR9-1; EMSG3 + -ERR10-1; EMSG4 + -ERR12-1; EMSG4 + -ERR14-1; EMSG4 + -ERR15-1; EMSG3 + -ERR16-1; EMSG5 + -ERR17-1; EMSG6 + -ERR18-1; SE /SYNTAX ERROR + -ERR28-1; SE + -ERR29-1; SE + -ERR30-1; EMSG8 /ILLEGAL VARIABLE + -ERR31-1; SE + -ERR35-1; SE + -ERR36-1; EMSG36 + -ERR37-1; CE + -ERR38-1; EMSG9 /ILLEGAL DO NESTING + -ERR39-1; SE + -ERR40-1; IE + -ERR41-1; EMSG10 /EXPRESSION TOO BIG + -ERR42-1; IE + -ERR43-1; EMSG11 /MIXED MODE + -ERR44-1; EMSG9 + -ERR47-1; SF /SUBR. OR FUNCT. STMT. NOT FIRST + -ERR48-1; SE + -ERR50-1; SE + -ERR51-1; SE + -ERR52-1;IE + -ERR53-1; EMSG12 /ILLEGAL SUBSCRIPT + -ERR54-1; EMSG13 /ILLEGAL EQUIVALENCING + -ERR59-1; SE + -ERR60-1; EMSG3 + 0; EMSG14 /COMPILER MALFUNCTION + +EMSG1, TEXT /ILLEGAL CONTINUATION/ +IE, TEXT /ILLEGAL ARITHMETIC EXPRESSION/ +EMSG3, TEXT /ILLEGAL STATEMENT/ +EMSG4, TEXT /ILLEGAL CONSTANT/ +EMSG5, TEXT /ILLEGAL STATEMENT NUMBER/ +EMSG6, TEXT /SYMBOL TABLE EXCEEDED/ +SE, TEXT /SYNTAX ERROR/ +EMSG8, TEXT /ILLEGAL VARIABLE/ +EMSG9, TEXT /ILLEGAL OR EXCESSIVE DO NESTING/ +EMSG10, TEXT /ARITHMETIC EXPRESSION TOO COMPLEX/ +EMSG11, TEXT /MIXED MODE EXPRESSION/ +EMSG12, TEXT /EXCESSIVE SUBSCRIPTS/ +EMSG13, TEXT /ILLEGAL EQUIVALENCING/ +EMSG14, TEXT /COMPILER MALFUNCTION/ +CE, TEXT /UNBALANCED QUOTES/ +SF, TEXT /SUBR. OR FUNCT. STMT. NOT FIRST/ +EMSG36, TEXT /ARRAY TOO LARGE/ + ITTAB=710 +FTTAB=ITTAB+30 +DOEND=2377 +BSYM=6300 +TSYM=7600 + +/ THE STATEMENT TYPE TABLE FOLLOWS + *2600 +STYPE, 7361 /-DO + 0000 + LDO + 6672 /-IF + 0000 + LIF + 7061 /-GO + 5361 /-TO + LGOTO + 7477 /-CA + 6364 /-LL + CAL + 5573 /-RE + 5353 /-TU + LRET + 7461 /-CO + 6154 /-NT + LCONT + 5454 /-ST + 6060 /-OP + LSTOP + 5777 /-PA + 5255 /-US + LPAUSE + 5573 /-RE + 7674 /-AD + LREAD + 5056 /-WR + 6654 /-IT + LWRIT + 7161 /-FO + 5563 /-RM + LFRMAT + 7262 /-EN + 7400 /-D + LLAST + 7461 /-CO + 6263 /-MM + LCOMON + 7367 /-DI + 6273 /-ME + LDIMEN + 7257 /-EQ + 5267 /-UI + + EQUI + -0611 /-FI + -1611 /-NI + LFIN +XXSUBR, 5453 /-SU + 7556 /-BR + LSUB + 7153 /-FU + 6175 /-NC + LFUNC + 0000 /THIS IS THE END OF LIST +AREA1, 0 +AREA2, 0 + +/ THE PRECEDENCE TABLE FOLLOWS, NON-ZERO PREC. OPERATORS APPEAR + -45 / PREC('%') = 7 NOTE: '%' REPLACES '**' + 700 + -52 / PREC('*') = 5 + 500 + -57 / PREC('/') = 5 + 500 + -53 / PREC('+') = 4 + 400 + -55 / PREC('-') = 4 + 400 + -75 / PREC('=') = 1 + 100 + -74 / PREC('<') = 1 NOTE: '<' IMPLIES SUBSCRIPTED ASSIGNMENT + 100 + 1 /THIS IS THE END OF THE TABLE +THOU, -1750 + -144 + -12 + -1 + +/ THE PERMANENT SYMBOL TABLE BEGINS HERE + *6000 + 1501 /MAIN + 1116 + 0001 + 0601 /FAD + 0400 + 0001 + 2324 /STO + 1700 + 0001 + 0623 /FSB + 0200 + 0001 + 0615 /FMP + 2000 + 0001 + 0604 /FDV + 2600 + 0001 + 1520 /MPY + 3100 + 0001 + 0411 /DIV + 2600 + 0001 + 2205 /READ + 0104 + 0001 + 2722 /WRITE + 1124 + 0501 + 1117 /IOH + 1000 + 0001 + 5060 /(0 + 0000 + 0001 + 1215 /JMP + 2000 + 0001 + 1617 /NOP + 2000 + 0001 + 0516 /ENTRY + 2422 + 3101 + 0501 /EAP + 2000 + 0001 + 2001 /PAUSE + 2523 + 0501 +OPTADI, 2401 /TAD I + 0440 + 1101 +OPTAD, 2401 /TAD + 0400 + 0001 +OPDCA, 0403 /DCA + 0100 + 0001 +OPJMPI, 1215 /JMP I + 2040 + 1101 + 2205 /RETRN + 2422 + 1601 + 0320 /CPAGE + 0107 + 0501 +OPSNA, 2316 /SNA + 0100 + 0001 + 2320 /SPC + 0300 + 0001 + 0301 /CALL + 1414 + 0001 + 0313 /CKIO + 1117 + 0001 + 1014 /HLT + 2400 + 0001 +OPCLA, 0314 /CLA + 0100 + 0001 + 0614 /FLOT + 1724 + 0001 + 1106 /IFAD + 0104 + 0001 + 0311 /CIA + 0100 + 0001 + 0310 /CHS + 2300 + 0001 + 0611 /FIX + 3000 + 0001 + 1123 /ISTO + 2417 + 0001 + 2001 /PAGE + 0705 + 0001 +BLCK, 0214 /BLOCK + 1703 + 1301 + 0516 /END + 0400 + 0001 + 1401 /LAP + 2000 + 0001 + 0317 /COMMN + 1515 + 1601 + 1123 /ISZ + 3200 + 0001 + 2325 /SUBSC + 0223 + 0301 +DUMMY, 0425 /DUMMY + 1515 + 3101 + 0122 /ARG + 0700 + 0001 + 0314 /CLEAR + 0501 + 2201 + 1111 /IIPOW + 2017 + 2701 + 0611 /FIPOW + 2017 + 2701 + 1106 /IFPOW + 2017 + 2701 + 0606 /FFPOW + 2017 + 2701 + 0403 /DCA I + 0140 + 1101 + 0103 /ACH + 1000 + 0001 +OPEN, 1720 /OPEN + 0516 + 0001 + 0522 /ERROR + 2217 + 2201 + 1116 /INC + 0300 + 0001 +FORTR, 0617 /FORTR + 2224 + 2201 +OPCMA, 0315 /CMA + 0100 + 0001 +OPIAC, 1101 /IAC + 0300 + 0001 +EXIT, 0530 /EXIT + 1124 + 0001 + FIELD 1 + *0 +FIRSTF, 1 + *7 +L7, 0 +L10, 0 +L11, 0 +L12, 0 /LAST LINE'S CONTENTS FOR OPTOMIZATION + 0 +L14, 0 +L15, 2377 /POINTER INTO DOEND LIST +L16, 0 +L17, 0 +L20, 0 /FLAG, NON-ZERO IF '=' SEEN +L21, 0 +L22, 0 /SUBSCRIPT NESTING LEVEL +L23, 0 /USED BY "DUMARG" AND "IOHAR" PATCH +L24, 0 /LINE POINTER +L25, 0 /HIGHEST SUBSCRIPT TEMP USED +L26, 0 /USED FOR DIMENSION INFORMATION + 0 /UNUSED +L30, 0 /FOLLOWING EIGHT LOCS ARE USED BY ENTITY +L31, 0 +L32, 0 +L33, 0 +L34, 0 +L35, 0 +L36, 0 +L37, 0 +L40, 0 /CONTAINS THE CURRENT TRIPLE NUMBER +L41, 0 /THIS IS THE POINTER INTO THE PUSH DOWN LIST +L42, 0 /THESE TWO LOCATIONS ARE USED BY THE TRIPLE PROCESSOR +L43, 0 / +L44, 0 /CONTAINS ONE FOR RIGHT OF EQUALS, ZERO FOR LEFT +L45, FTTAB /CONTAINS LARFEST FLOATING POINT TEMPORARY NUMBER USED +L46, 0 /CONTAINS NUMBER OF THE TRIPLE CURRENTLY IN THE AC +L47, 7575 /CONTAINS THREE LESS THAN START OF FCON TABLE +L50, 7600 /CONTAINS START OF DIMENSION TABLE +L51, ITTAB /CONTAINS LARGEST INTEGER TEMPORARY NUMBER USED +L52, 0 /CONTAINS ONE IF RETURN FROM GENER IS DESIRED FOR BALANCE +L53, 0 /CONTAINS THE LAST CREATED LABEL +L54, 0 /CONTAINS THE LABEL FOR THE CURRENT STATEMENT +L55, -25 /CONTAINS THE MAXIMUM ALLOWABLE NUMBER OF UNENDED DOS +L56, 6300 /CONTAINS BEGINNING OF SYMBOL TABLE +L57, 6300 /CONTAINS END OF SYMBOL TABLE +L60, 0 /"INDIRECT =" FLAG FOR S.S LEFT OF EQUALS SIGN +L61, 0 /NON-ZERO IF LAST STMT READ IS A COMMENT +L62, 0 /NEXT FOUR LOCATIONS USED BY GENER AND ENTITY +L63, 0 /CONTAINS THE CURRENT OPERATOR +L64, 0 /POINTS TO THE LAST OPERATOR IN THE STACK +L65, 0 /CONTAINS THE PRECEDENCE OF THE CURRENT OPERATOR +BPAREN, 0 /PARENTHESIS COUNTER +L67, 0 /ONE FOR FUNCTION AND ZERO FOR SUBROUTINE +L70, 0 /CONTAINS POINTER TO SUBPROGRAM NAME +L71, 5777 /BEGINNING OF PUSHDOWN LIST +L72, 0 /SET TO ONE IF SUBSCRIPT IS ENCOUNTERED +L73, 0 / +L74, 3000 /BEGINNING OF ERASABLE LOCATIONS USED FOR PARAMETERS +L75, 0 /SET TO ONE SUPPRESS /OUTPUT FROM COMPILER +L76, 0 / +L77, 0 /CONTAINS ADDRESS OF LAST ENTRY INTO FCON OR SYMBOL TABLE + /THE FOLLOWING THREE LOCS ARE USED BY THE + /LITERAL COLLECTER +COUNT2, 0 /NUMBER OF DIGITS TO RIGHT OF DECIMAL POINT +ESIGN, 0 /0 MEANS POSITIVE EXPONENT, 1 MEANS NEGATIVE +FPSW, 0 /0 MEANS INTEGER CONSTANT, 1 MEANS FLOATING POINT +MIKE4,MA, 3377 +MIKE8,TOTAL, 0 +INTA, 0 +INTB,MIKE7, 0 +SNUM,MB, 0 +POINTZ, 3377 +CHK, 0 +IMPDO, 0 /"IMPLIED DO-LOOP IN PROGRESS" FLAG +KOUNT, 0 +ASSIGN, LASIGN /ROUTINE TO PROCESS ASSIGNMENT STATEMENTS +PUTCH, LPUTCH /ROUTINE TO PUT A CHARACTER BACK IN THE INPUT BUFFER +PROP, LPROP /PRINTS OPCODES +PRCRL, LPRCRL /PRINTS CREATED LABELS +PRINT, LPRINT /PRINTS ONE ASCII CHAR +P2, LP2 /PRINT TWO PACKED ASCII CHARS +GETCH, LGETCH /GETS ONE CHARACTER OUT OF THE INPUT BUFFER +LUNCH, LLUNCH /PRINTS ERROR COMMENTS +MODE, LMODE /DETERMINES THE MODE OF THE ARGUMENT +LOOK, LLOOK /CHECKS FOR THE REST OF THE INPUT STATEMENT +ZZZ, LZZZ /PRINTS OUT STATEMENT LABELS +ENTITY, LENTT /GETS THE NEXT LOGICAL INPUT PARAMETER +SYMTAB, LSYMTB /ENTERS SYMBOLS INTO THE SYMBOL TABLE +DUMARG, LDMARG /SEES IF PARAMETER IS A DUMMY ARG OR SUBSCRIPT +PRSYM, LPRSYM /PRINTS SYMBOLS +CREATE, LCREAT /CREATES LABELS +PROTAC, LPRTAC /PRINTS CONTENTS OF AC IN OCTAL +PLAB, LPLAB /PRINTS LABELS +PIFF, LPIFF /PUTS OUT AN IFF FOR THE CONTENTS OF THE AC +TRIPL, LTRIPL /PROCESSES THE TRIPLES GENERATED FROM AN EXPRESSION +GENER, LGENER /GENERATES THE TRIPLES +LCHNG, CHNG /TEST FOR DUMMY ARG AND REPLACE +CLAB, LCLAB /HANGS A CREATED LABEL ON THE NEXT LINE +STORE, LSTORE /STORES THE CONTENTS OF THE AC +FPROP, LFPROP /PUT OUT CALLS TO F.P. ROUTINES +ZER, LZER +DUM, LDUM /PROCESSES OCCURRANCES OF DUMMY ARGUMENTS IN LISTS +DIM, LDIM /LOOKS UP DIMENSION INFORMATION ON VARIABLES +PUNCH, LTTYPE /ADDRESS OF CURRENT OUTPUT ROUTINE +C2, 2 +C3, 3 + C40, 40 +C7240, 5440 /THIS WAS COLON-SPACE NOW ITS COMMA-SPACE +C77, 77 +CM40, -40 +CM4046, -4046 +CM50, -50 +CM51, -51 +CM54, -54 +CM2, -2 +CM3, -3 +CHECK, LCHECK +SMODE, LSMODE +BSS, LBSS +ARG, LARG +C54, 54 +BASE, INBUF +BASE2, INBUF+100 +C4000, 4000 +GNB, LGNB + *177 +START, CLA /COME HERE AT BEGINNING OF EACH STMT + DCA FIRSTF +START1, TAD IMPDO + SZA CLA + JMP ERR1 /IF IMPDO<>0 THEN WE MUST HAVE SCREWED UP ON + /CONTINUATIONS (I THINK) + ISZ CHK /IS THERE A STMT IN THE BUFFER? + JMP .+3 + JMS I SWAP /YES, SWITCH BUFFER POINTERS + JMP .+3 + TAD BASE + JMS I RCD /NO, READ THE NEXT LINE +TEST, TAD L15 + TAD CM3 + DCA L16 /SET UP XR FOR DO TERMINATION TEST + TAD L54 + CIA + TAD I L16 + SZA CLA /ARE WE TERMINATING A DO? + JMP ATRY + JMS LDNEXT /TERMINATE DO LOOP + JMP TEST /SEE IF THERE IS ANY MORE... +ATRY, TAD L61 + SZA CLA /A COMMENT? + JMP CMNT + TAD CHK + SZA CLA /ILLEGAL CONTINUATION? +ERR1, JMS I LUNCH + JMS I STMT /GET THE STMT NR... + TAD L32 + SNA + JMP .+4 /NO STMT NUMBER + CIA + TAD L12 + SZA CLA /CAN WE OMIT A TERMINAL JMP? + JMS I PRINT + DCA L24 +FLST, JMS LIST /PUNCH SOURCE STMT + JMS I WIPE /ZERO THE SUBSCRIPT TEMP. TABLE + TAD L32 + DCA L54 + TAD CM2 + DCA L64 + SKP +ACA, DCA I BAREA1 + JMS I GETCH + JMP ALPH + NOP + JMS I PUTCH /PUT CHARACTER BACK +ALPH, RTL CLL + RTL + RTL + DCA L65 + JMS I GETCH + JMP ALPH2 + NOP + JMS I PUTCH /PUT CHARACTER BACK +ALPH2, TAD L65 + ISZ L64 + JMP ACA + DCA I BAREA2 + DCA CHK + TAD SSTYP /COMPARE THESE CHARS WITH DISPATCH TABLE + DCA L17 +TRY, TAD I L17 + SNA /END OF THE TABLE? + JMP I ASSIGN /YES, MUST BE ARITHMETIC STMT + TAD I BAREA1 + SZA CLA + JMP NOHIT2 + TAD I BAREA2 + TAD I L17 + SZA CLA + JMP NOHIT1 + TAD I L17 /FOUND A MATCH, GO TO PROPER HANDLER... + DCA L30 + JMP I L30 +NOHIT2, ISZ L17 +NOHIT1, ISZ L17 + JMP TRY /DOESN'T MATCH, TRY AGAIN + +LDNEXT, 0 + TAD L15 /RESET THE DO END POINTER + TAD CM3 + DCA L15 + TAD L15 + IAC + DCA L16 + CMA + TAD L55 + DCA L55 + JMS I PROP /PUNCH 'JMP